!> A small RFC 4180 CSV reader.
!>
!> Fortran ships no CSV parser and the batch endpoint needs a real one: a value
!> such as `Rua Um, Dois` arrives double-quoted with `""` escaping, and
!> splitting on commas would silently shift every column after it.
!>
!> Accepts LF and CRLF line endings, a leading UTF-8 byte-order mark, and
!> quoted fields containing commas, quotes and newlines.
module cepis_csv
    use cepis_strings, only: string_buffer
    implicit none
    private

    !> One field of one row.
    type, public :: csv_field
        character(len=:), allocatable :: text
    end type csv_field

    !> One row of fields.
    type, public :: csv_row
        type(csv_field), allocatable :: fields(:)
    end type csv_row

    !> A parsed table. `rows(1)` is the header row when the file has one.
    type, public :: csv_table
        type(csv_row), allocatable :: rows(:)
    contains
        !> How many rows, header included. Zero for an empty document.
        procedure :: height
        !> Index of the header column named `name`, or zero when absent.
        procedure :: column
        !> The value at `row`, column `name`. The empty string when either the
        !> row or the column is missing.
        procedure :: cell
    end type csv_table

    public :: csv_parse

contains

    pure function height(self) result(n)
        class(csv_table), intent(in) :: self
        integer :: n

        n = 0
        if (allocated(self%rows)) n = size(self%rows)
    end function height

    pure function column(self, name) result(index)
        class(csv_table), intent(in) :: self
        character(len=*), intent(in) :: name
        integer :: index, i

        index = 0
        if (self%height() < 1) return
        if (.not. allocated(self%rows(1)%fields)) return
        do i = 1, size(self%rows(1)%fields)
            if (self%rows(1)%fields(i)%text == name) then
                index = i
                return
            end if
        end do
    end function column

    pure function cell(self, row, name) result(text)
        class(csv_table), intent(in) :: self
        integer, intent(in) :: row
        character(len=*), intent(in) :: name
        character(len=:), allocatable :: text
        integer :: col

        text = ''
        if (row < 1 .or. row > self%height()) return
        col = self%column(name)
        if (col == 0) return
        if (.not. allocated(self%rows(row)%fields)) return
        if (col > size(self%rows(row)%fields)) return
        text = self%rows(row)%fields(col)%text
    end function cell

    !> Parse `text` into a table. `ok` is `.false.` only for an unterminated
    !> quoted field, the one malformation that cannot be read past safely.
    subroutine csv_parse(text, table, ok, message)
        character(len=*), intent(in) :: text
        type(csv_table), intent(out) :: table
        logical, intent(out) :: ok
        character(len=:), allocatable, intent(out) :: message
        type(csv_row), allocatable :: rows(:), bigger(:)
        type(csv_row) :: current
        integer :: pos, count

        ok = .true.
        message = ''
        allocate (rows(16))
        count = 0

        pos = 1
        if (len(text) >= 3) then
            if (iachar(text(1:1)) == 239 .and. iachar(text(2:2)) == 187 .and. &
                iachar(text(3:3)) == 191) pos = 4
        end if

        do while (pos <= len(text))
            call parse_row(text, pos, current, ok, message)
            if (.not. ok) return
            if (count >= size(rows)) then
                allocate (bigger(2*size(rows)))
                bigger(1:count) = rows(1:count)
                call move_alloc(bigger, rows)
            end if
            count = count + 1
            rows(count) = current
        end do

        allocate (table%rows(count))
        if (count > 0) table%rows = rows(1:count)
    end subroutine csv_parse

    subroutine parse_row(text, pos, row, ok, message)
        character(len=*), intent(in) :: text
        integer, intent(inout) :: pos
        type(csv_row), intent(out) :: row
        logical, intent(out) :: ok
        character(len=:), allocatable, intent(out) :: message
        type(csv_field), allocatable :: fields(:), bigger(:)
        character(len=:), allocatable :: value
        integer :: count

        ok = .true.
        message = ''
        allocate (fields(16))
        count = 0

        do
            call parse_field(text, pos, value, ok, message)
            if (.not. ok) return
            if (count >= size(fields)) then
                allocate (bigger(2*size(fields)))
                bigger(1:count) = fields(1:count)
                call move_alloc(bigger, fields)
            end if
            count = count + 1
            fields(count)%text = value

            if (pos > len(text)) exit
            if (text(pos:pos) == ',') then
                pos = pos + 1
                cycle
            end if
            if (text(pos:pos) == char(13)) pos = pos + 1
            if (pos <= len(text)) then
                if (text(pos:pos) == char(10)) pos = pos + 1
            end if
            exit
        end do

        allocate (row%fields(count))
        row%fields = fields(1:count)
    end subroutine parse_row

    subroutine parse_field(text, pos, value, ok, message)
        character(len=*), intent(in) :: text
        integer, intent(inout) :: pos
        character(len=:), allocatable, intent(out) :: value
        logical, intent(out) :: ok
        character(len=:), allocatable, intent(out) :: message
        type(string_buffer) :: out
        integer :: first

        ok = .true.
        message = ''
        value = ''

        if (pos > len(text)) return

        if (text(pos:pos) /= '"') then
            first = pos
            do while (pos <= len(text))
                if (text(pos:pos) == ',' .or. text(pos:pos) == char(10) .or. &
                    text(pos:pos) == char(13)) exit
                pos = pos + 1
            end do
            if (pos > first) value = text(first:pos - 1)
            return
        end if

        pos = pos + 1
        do
            if (pos > len(text)) then
                ok = .false.
                message = 'unterminated quoted field'
                return
            end if
            if (text(pos:pos) == '"') then
                if (pos + 1 <= len(text)) then
                    if (text(pos + 1:pos + 1) == '"') then
                        call out%append('"')
                        pos = pos + 2
                        cycle
                    end if
                end if
                pos = pos + 1
                exit
            end if
            call out%append(text(pos:pos))
            pos = pos + 1
        end do

        value = out%text()

        do while (pos <= len(text))
            if (text(pos:pos) == ',' .or. text(pos:pos) == char(10) .or. &
                text(pos:pos) == char(13)) exit
            pos = pos + 1
        end do
    end subroutine parse_field

end module cepis_csv