fortplot_spec_json_data.f90 Source File

module fortplot_spec_json_data
    !! JSON data parsing: values arrays, row parsing, field scanning.
    !!
    !! Handles parsing of Vega-Lite data objects including row-oriented
    !! JSON arrays with mixed numeric/string column types.

    use, intrinsic :: iso_fortran_env, only: wp => real64
    use fortplot_spec_types, only: data_t, field_plot_t, layer_t, spec_t
    use fortplot_spec_json_reader, only: skip_ws, expect_char, &
                                          read_string, read_real, &
                                          read_int, read_bool, skip_value
    use fortplot_spec_json_field_plot, only: parse_field_plot
    use fortplot_spec_json_arrays, only: parse_data_array, inspect_data_value
    use fortplot_spec_json_flatten, only: parse_transforms
    use, intrinsic :: ieee_arithmetic, only: ieee_value, ieee_quiet_nan
    use fortplot_spec_json_channels, only: parse_mark, parse_encoding

    implicit none
    private

    public :: parse_data
    public :: parse_values_array
    public :: parse_field_plot
    public :: parse_layers
    public :: parse_one_layer
    public :: scan_row_fields
    public :: parse_row
    public :: find_column

contains

    subroutine parse_data(json, pos, d, status)
        !! Parse data object: {"values": [{...}, ...]}
        character(len=*), intent(in) :: json
        integer, intent(inout) :: pos
        type(data_t), intent(out) :: d
        integer, intent(out) :: status
        character(len=:), allocatable :: key

        status = 0
        if (.not. expect_char(json, pos, '{')) then
            status = 60
            return
        end if

        do
            call skip_ws(json, pos)
            if (pos > len(json)) then
                status = 77
                return
            end if
            if (json(pos:pos) == ',') pos = pos + 1
            call skip_ws(json, pos)
            if (pos > len(json)) then
                status = 77
                return
            end if
            if (json(pos:pos) == '}') then
                pos = pos + 1
                return
            end if

            call read_string(json, pos, key, status)
            if (status /= 0) return
            call skip_ws(json, pos)
            if (.not. expect_char(json, pos, ':')) then
                status = 61
                return
            end if
            call skip_ws(json, pos)

            if (key == 'values') then
                call parse_values_array(json, pos, d, status)
            else
                call skip_value(json, pos)
            end if

            if (status /= 0) return
        end do
    end subroutine parse_data

    subroutine parse_values_array(json, pos, d, status)
        !! Parse row-oriented data: [{"x":1,"y":2}, ...]
        !! Two-pass: first count rows and discover columns,
        !! then parse values.
        character(len=*), intent(in) :: json
        integer, intent(inout) :: pos
        type(data_t), intent(out) :: d
        integer, intent(out) :: status

        integer :: save_pos, nrows, ncols, row
        character(len=64) :: field_names(32)
        logical :: field_is_string(32), field_is_array(32)
        integer :: nfields

        status = 0
        nfields = 0

        if (.not. expect_char(json, pos, '[')) then
            status = 70
            return
        end if

        call skip_ws(json, pos)
        if (pos > len(json)) then
            status = 77
            return
        end if
        if (json(pos:pos) == ']') then
            pos = pos + 1
            d%nrows = 0
            return
        end if

        save_pos = pos
        nrows = 0
        do
            call skip_ws(json, pos)
            if (pos > len(json)) then
                status = 77
                return
            end if
            if (json(pos:pos) == ']') exit

            if (nrows > 0) then
                if (.not. expect_char(json, pos, ',')) then
                    status = 71
                    return
                end if
                call skip_ws(json, pos)
            end if

            nrows = nrows + 1
            call scan_row_fields(json, pos, field_names, &
                                 field_is_string, nfields, status, field_is_array)
            if (status /= 0) return
        end do

        ncols = nfields
        if (ncols == 0 .or. nrows == 0) then
            if (.not. expect_char(json, pos, ']')) then
                status = 72
                return
            end if
            d%nrows = 0
            return
        end if

        call initialize_columns(d, nrows, ncols, field_names, &
                                field_is_string, field_is_array)

        pos = save_pos
        do row = 1, nrows
            call skip_ws(json, pos)
            if (row > 1) then
                if (.not. expect_char(json, pos, ',')) then
                    status = 73
                    return
                end if
                call skip_ws(json, pos)
            end if
            call parse_row(json, pos, d, row, field_names, &
                           ncols, status)
            if (status /= 0) return
        end do

        call skip_ws(json, pos)
        if (.not. expect_char(json, pos, ']')) then
            status = 74
            return
        end if
    end subroutine parse_values_array

    subroutine initialize_columns(d, nrows, ncols, field_names, &
                                  field_is_string, field_is_array)
        type(data_t), intent(out) :: d
        integer, intent(in) :: nrows, ncols
        character(len=64), intent(in) :: field_names(:)
        logical, intent(in) :: field_is_string(:), field_is_array(:)
        integer :: col

        allocate (d%columns(ncols))
        do col = 1, ncols
            d%columns(col)%field = trim(field_names(col))
            d%columns(col)%is_string = field_is_string(col)
            d%columns(col)%is_array = field_is_array(col)
            if (field_is_array(col)) then
                allocate (d%columns(col)%arrays(nrows))
            else if (field_is_string(col)) then
                allocate (character(len=256) :: &
                          d%columns(col)%string_values(nrows))
                d%columns(col)%string_values = ''
                allocate (d%columns(col)%string_valid(nrows))
                d%columns(col)%string_valid = .false.
            else
                allocate (d%columns(col)%values(nrows))
                d%columns(col)%values = ieee_value(0.0_wp, ieee_quiet_nan)
            end if
        end do
        d%nrows = nrows

    end subroutine initialize_columns

    subroutine scan_row_fields(json, pos, field_names, &
                               field_is_string, nfields, status, field_is_array)
        !! Scan one row object to discover field names and types.
        !! Advances pos past the entire row object.
        character(len=*), intent(in) :: json
        integer, intent(inout) :: pos
        character(len=64), intent(inout) :: field_names(:)
        logical, intent(inout) :: field_is_string(:)
        integer, intent(inout) :: nfields
        integer, intent(out) :: status
        character(len=:), allocatable :: key
        integer :: i
        logical, optional, intent(inout) :: field_is_array(:)
        logical :: array_value, string_value
        logical :: found

        status = 0
        if (.not. expect_char(json, pos, '{')) then
            status = 80
            return
        end if

        do
            call skip_ws(json, pos)
            if (pos > len(json)) then
                status = 77
                return
            end if
            if (json(pos:pos) == ',') pos = pos + 1
            call skip_ws(json, pos)
            if (pos > len(json)) then
                status = 77
                return
            end if
            if (json(pos:pos) == '}') then
                pos = pos + 1
                return
            end if

            call read_string(json, pos, key, status)
            if (status /= 0) return
            call skip_ws(json, pos)
            if (.not. expect_char(json, pos, ':')) then
                status = 81
                return
            end if
            call skip_ws(json, pos)

            found = .false.
            do i = 1, nfields
                if (trim(field_names(i)) == key) then
                    found = .true.
                    exit
                end if
            end do

            call inspect_data_value(json, pos, array_value, string_value, status)
            if (status /= 0) return
            if (len(key) > len(field_names(1))) then
                status = 82
                return
            end if
            if (.not. found) then
                if (nfields >= size(field_names)) then
                    status = 82
                    return
                end if
                nfields = nfields + 1
                field_names(nfields) = key
                field_is_string(nfields) = string_value
                if (present(field_is_array)) field_is_array(nfields) = array_value
            else
                field_is_string(i) = field_is_string(i) .or. string_value
                if (present(field_is_array)) then
                    field_is_array(i) = field_is_array(i) .or. array_value
                end if
            end if

            call skip_value(json, pos)
        end do
    end subroutine scan_row_fields

    subroutine parse_row(json, pos, d, row, field_names, &
                         ncols, status)
        !! Parse one row object and store values into data columns
        character(len=*), intent(in) :: json
        integer, intent(inout) :: pos
        type(data_t), intent(inout) :: d
        integer, intent(in) :: row, ncols
        character(len=64), intent(in) :: field_names(:)
        integer, intent(out) :: status
        character(len=:), allocatable :: key, sval
        real(wp) :: rval
        integer :: col

        status = 0
        if (.not. expect_char(json, pos, '{')) then
            status = 90
            return
        end if

        do
            call skip_ws(json, pos)
            if (pos > len(json)) then
                status = 77
                return
            end if
            if (json(pos:pos) == ',') pos = pos + 1
            call skip_ws(json, pos)
            if (pos > len(json)) then
                status = 77
                return
            end if
            if (json(pos:pos) == '}') then
                pos = pos + 1
                return
            end if

            call read_string(json, pos, key, status)
            if (status /= 0) return
            call skip_ws(json, pos)
            if (.not. expect_char(json, pos, ':')) then
                status = 91
                return
            end if
            call skip_ws(json, pos)

            col = find_column(key, field_names, ncols)
            if (col > 0) then
                if (d%columns(col)%is_array) then
                    call parse_data_array(json, pos, d%columns(col)%arrays(row), status)
                    if (status /= 0) return
                else if (d%columns(col)%is_string .and. json(pos:pos) == '"') then
                    call read_string(json, pos, sval, status)
                    if (status /= 0) return
                    d%columns(col)%string_values(row) = sval
                    d%columns(col)%string_valid(row) = .true.
                else
                    call read_real(json, pos, rval, status)
                    if (status /= 0) return
                    if (.not. d%columns(col)%is_string) &
                        d%columns(col)%values(row) = rval
                end if
            else
                call skip_value(json, pos)
            end if
        end do
    end subroutine parse_row

    pure function find_column(key, field_names, ncols) result(idx)
        !! Find column index by field name
        character(len=*), intent(in) :: key
        character(len=64), intent(in) :: field_names(:)
        integer, intent(in) :: ncols
        integer :: idx, i

        idx = 0
        do i = 1, ncols
            if (trim(field_names(i)) == key) then
                idx = i
                return
            end if
        end do
    end function find_column


    subroutine parse_layers(json, pos, spec, status)
        !! Parse layer array
        character(len=*), intent(in) :: json
        integer, intent(inout) :: pos
        type(spec_t), intent(inout) :: spec
        integer, intent(out) :: status
        type(layer_t) :: tmp_layers(64)
        integer :: nlayers

        status = 0
        spec%is_layered = .true.
        nlayers = 0

        if (.not. expect_char(json, pos, '[')) then
            status = 100
            return
        end if

        do
            call skip_ws(json, pos)
            if (pos > len(json)) then
                status = 77
                return
            end if
            if (json(pos:pos) == ']') then
                pos = pos + 1
                exit
            end if
            if (nlayers > 0) then
                if (.not. expect_char(json, pos, ',')) then
                    status = 101
                    return
                end if
                call skip_ws(json, pos)
            end if

            if (nlayers >= size(tmp_layers)) then
                status = 102
                return
            end if
            nlayers = nlayers + 1
            call parse_one_layer(json, pos, tmp_layers(nlayers), &
                                 status)
            if (status /= 0) return
        end do

        spec%layer_count = nlayers
        if (nlayers > 0) then
            allocate (spec%layers(nlayers))
            spec%layers(1:nlayers) = tmp_layers(1:nlayers)
        end if
    end subroutine parse_layers

    subroutine parse_one_layer(json, pos, lay, status)
        !! Parse a single layer object
        character(len=*), intent(in) :: json
        integer, intent(inout) :: pos
        type(layer_t), intent(out) :: lay
        integer, intent(out) :: status
        character(len=:), allocatable :: key

        status = 0
        if (.not. expect_char(json, pos, '{')) then
            status = 110
            return
        end if

        do
            call skip_ws(json, pos)
            if (pos > len(json)) then
                status = 77
                return
            end if
            if (json(pos:pos) == ',') pos = pos + 1
            call skip_ws(json, pos)
            if (pos > len(json)) then
                status = 77
                return
            end if
            if (json(pos:pos) == '}') then
                pos = pos + 1
                return
            end if

            call read_string(json, pos, key, status)
            if (status /= 0) return
            call skip_ws(json, pos)
            if (.not. expect_char(json, pos, ':')) then
                status = 111
                return
            end if
            call skip_ws(json, pos)

            select case (key)
            case ('mark')
                call parse_mark(json, pos, lay%mark, status)
            case ('encoding')
                call parse_encoding(json, pos, lay%encoding, &
                                    status)
            case ('data')
                call parse_data(json, pos, lay%data, status)
                lay%has_data = .true.
            case ('fortplotField')
                call parse_field_plot(json, pos, lay%field, status)
            case ('transform')
                call parse_transforms(json, pos, lay%transforms, status)
            case default
                call skip_value(json, pos)
            end select

            if (status /= 0) return
        end do
    end subroutine parse_one_layer

end module fortplot_spec_json_data