module fortplot_spec_json
    !! JSON serialization for spec_t -> Vega-Lite JSON
    !! Produces valid Vega-Lite v5 JSON from Fortran spec_t types.
    !! Row-oriented output: data.values is an array of objects.

    use, intrinsic :: iso_fortran_env, only: wp => real64
    use fortplot_spec_types, only: spec_t, mark_t, encoding_t, &
                                   channel_t, data_t, data_column_t, scale_t, axis_t, &
                                   field_plot_t, layer_t
    use fortplot_spec_config_json, only: serialize_config, &
                                          serialize_padding
    use fortplot_spec_json_field_plot, only: serialize_field_plot
    implicit none
    private
    public :: spec_to_json, spec_to_json_file

    character(len=*), parameter :: VL_SCHEMA = &
                                   'https://vega.github.io/schema/vega-lite/v5.json'
    character(len=*), parameter :: NL = new_line('a')
    character(len=*), parameter :: Q = '"'

    public :: escape_json_string

contains

    pure function safe_str(s) result(r)
        !! Identity wrapper that copies through a `len=*` formal so the
        !! caller-side allocatable assignment path stays clear of the
        !! gfortran 16 -O0 miscompile reproduced in
        !! https://github.com/krystophny/gcc-dev/issues/167.
        character(len=*), intent(in) :: s
        character(len=:), allocatable :: r
        r = s
    end function safe_str

    pure function escape_json_string(s) result(escaped)
        !! Escape a string for safe JSON embedding.
        !! Handles: " -> \", \ -> \\, and control characters.
        character(len=*), intent(in) :: s
        character(len=:), allocatable :: escaped
        integer :: i
        character(len=1) :: ch

        escaped = ''
        do i = 1, len(s)
            ch = s(i:i)
            select case (ch)
            case ('"')
                escaped = escaped//'\"'
            case ('\')
                escaped = escaped//'\\'
            case (char(8))
                escaped = escaped//'\b'
            case (char(9))
                escaped = escaped//'\t'
            case (char(10))
                escaped = escaped//'\n'
            case (char(12))
                escaped = escaped//'\f'
            case (char(13))
                escaped = escaped//'\r'
            case default
                escaped = escaped//ch
            end select
        end do
    end function escape_json_string

    function spec_to_json(spec) result(json)
        !! Serialize spec_t to a Vega-Lite JSON string
        type(spec_t), intent(in) :: spec
        character(len=:), allocatable :: json
        character(len=:), allocatable :: header

        ! Build the schema header through a function-call boundary to dodge a
        ! gfortran 16 -O0 miscompile of certain mixed literal+parameter
        ! concatenations into a deferred-length allocatable LHS.
        ! See https://github.com/krystophny/gcc-dev/issues/167 for the MRE.
        header = safe_str('{' // NL // '  "$schema": ' // Q // VL_SCHEMA // Q)
        json = header

        if (allocated(spec%title)) then
            json = json//','//NL
            json = json//'  "title": '//Q// &
                   escape_json_string(spec%title)//Q
        end if

        if (spec%config%defined) then
            json = json//','//NL
            json = json//serialize_config(spec%config)
        end if

        if (spec%padding%defined) then
            json = json//','//NL
            json = json//serialize_padding(spec%padding)
        end if

        if (allocated(spec%autosize_type)) then
            json = json//','//NL
            json = json//'  "autosize": '//Q// &
                escape_json_string(spec%autosize_type)//Q
        end if

        json = json//','//NL
        json = json//'  "width": '//int_to_str(spec%width)
        json = json//','//NL
        json = json//'  "height": '//int_to_str(spec%height)

        if (spec%is_layered .and. spec%layer_count > 0) then
            json = json//','//NL
            json = json//serialize_data(spec%data, 2)
            json = json//','//NL
            json = json//serialize_encoding(spec%encoding, 2)
            if (spec%field%defined) then
                json = json//','//NL
                json = json//serialize_field_plot(spec%field, 2)
            end if
            json = json//','//NL
            json = json//serialize_layers(spec%layers, &
                                          spec%layer_count)
        else
            json = json//','//NL
            json = json//serialize_data(spec%data, 2)
            json = json//','//NL
            json = json//serialize_mark(spec%mark, 2)
            json = json//','//NL
            json = json//serialize_encoding(spec%encoding, 2)
            if (spec%field%defined) then
                json = json//','//NL
                json = json//serialize_field_plot(spec%field, 2)
            end if
        end if

        json = json//NL//'}'
    end function spec_to_json

    subroutine spec_to_json_file(spec, filename, status)
        !! Write spec_t as Vega-Lite JSON to a file
        type(spec_t), intent(in) :: spec
        character(len=*), intent(in) :: filename
        integer, intent(out) :: status

        character(len=:), allocatable :: json
        integer :: unit_num, ios

        status = 0
        json = spec_to_json(spec)

        open (newunit=unit_num, file=filename, status='replace', &
              action='write', iostat=ios)
        if (ios /= 0) then
            status = 1
            return
        end if

        write (unit_num, '(a)', iostat=ios) json
        if (ios /= 0) status = 1
        close (unit_num)
    end subroutine spec_to_json_file

    function serialize_mark(m, indent) result(json)
        !! Serialize mark_t to JSON
        type(mark_t), intent(in) :: m
        integer, intent(in) :: indent
        character(len=:), allocatable :: json
        character(len=:), allocatable :: pad
        logical :: has_props
        integer :: i

        pad = repeat(' ', indent)

        has_props = (m%size > 0.0_wp) .or. &
                    (m%opacity < 1.0_wp) .or. &
                    (m%stroke_width >= 0.0_wp) .or. &
                    allocated(m%stroke_dash) .or. &
                    allocated(m%stroke) .or. &
                    allocated(m%fill) .or. &
                    (.not. m%filled) .or. &
                    allocated(m%interpolate) .or. &
                    allocated(m%point)

        if (.not. has_props) then
            json = pad//'"mark": '//Q//m%type//Q
            return
        end if

        json = pad//'"mark": {'//NL
        json = json//pad//'  "type": '//Q//m%type//Q
        if (m%size > 0.0_wp) then
            json = json//','//NL
            json = json//pad//'  "size": '// &
                   real_to_str(m%size)
        end if
        if (m%opacity < 1.0_wp) then
            json = json//','//NL
            json = json//pad//'  "opacity": '// &
                   real_to_str(m%opacity)
        end if
        if (m%stroke_width >= 0.0_wp) then
            json = json//','//NL
            json = json//pad//'  "strokeWidth": '// &
                   real_to_str(m%stroke_width)
        end if
        if (allocated(m%stroke_dash)) then
            json = json//','//NL
            json = json//pad//'  "strokeDash": ['
            do i = 1, size(m%stroke_dash)
                if (i > 1) json = json//', '
                json = json//real_to_str(m%stroke_dash(i))
            end do
            json = json//']'
        end if
        if (allocated(m%stroke)) then
            json = json//','//NL
            json = json//pad//'  "stroke": '//Q// &
                   m%stroke//Q
        end if
        if (allocated(m%fill)) then
            json = json//','//NL
            json = json//pad//'  "fill": '//Q// &
                   m%fill//Q
        end if
        if (.not. m%filled) then
            json = json//','//NL
            json = json//pad//'  "filled": false'
        end if
        if (allocated(m%interpolate)) then
            json = json//','//NL
            json = json//pad//'  "interpolate": '//Q// &
                   m%interpolate//Q
        end if
        if (allocated(m%point)) then
            json = json//','//NL
            json = json//pad//'  "point": '//m%point
        end if
        json = json//NL//pad//'}'
    end function serialize_mark

    function serialize_encoding(enc, indent) result(json)
        !! Serialize encoding_t to JSON
        type(encoding_t), intent(in) :: enc
        integer, intent(in) :: indent
        character(len=:), allocatable :: json, pad
        logical :: first

        pad = repeat(' ', indent)
        json = pad//'"encoding": {'//NL
        first = .true.

        call append_channel(json, 'x', enc%x, indent + 2, first)
        call append_channel(json, 'y', enc%y, indent + 2, first)
        call append_channel(json, 'x2', enc%x2, indent + 2, first)
        call append_channel(json, 'y2', enc%y2, indent + 2, first)
        call append_channel(json, 'color', enc%color, &
                            indent + 2, first)
        call append_channel(json, 'size', enc%size, &
                            indent + 2, first)
        call append_channel(json, 'shape', enc%shape, &
                            indent + 2, first)
        call append_channel(json, 'opacity', enc%opacity, &
                            indent + 2, first)
        call append_channel(json, 'text', enc%text, &
                            indent + 2, first)

        json = json//NL//pad//'}'
    end function serialize_encoding

    subroutine append_channel(json, name, ch, indent, first)
        !! Append a channel to the JSON encoding block
        character(len=:), allocatable, intent(inout) :: json
        character(len=*), intent(in) :: name
        type(channel_t), intent(in) :: ch
        integer, intent(in) :: indent
        logical, intent(inout) :: first
        character(len=:), allocatable :: pad

        if (.not. ch%defined) return

        pad = repeat(' ', indent)
        if (.not. first) then
            json = json//','//NL
        end if
        first = .false.

        json = json//pad//Q//name//Q//': {'
        if (allocated(ch%field)) then
            json = json//NL//pad//'  "field": '// &
                   Q//ch%field//Q
            if (allocated(ch%type)) then
                json = json//','//NL
                json = json//pad//'  "type": '// &
                       Q//ch%type//Q
            end if
        else if (allocated(ch%value)) then
            json = json//NL//pad//'  "value": '//ch%value
        end if

        call append_scale(json, ch%scale, indent + 2)
        call append_axis(json, ch%axis, indent + 2)

        json = json//NL//pad//'}'
    end subroutine append_channel

    subroutine append_scale(json, sc, indent)
        !! Append scale properties to channel JSON
        character(len=:), allocatable, intent(inout) :: json
        type(scale_t), intent(in) :: sc
        integer, intent(in) :: indent
        character(len=:), allocatable :: pad
        logical :: has_content, first_prop

        has_content = allocated(sc%type) .or. sc%domain_set .or. &
                      sc%zero .or. &
                      (abs(sc%exponent - 1.0_wp) > 1.0d-10)
        if (.not. has_content) return

        pad = repeat(' ', indent)
        json = json//','//NL
        json = json//pad//'"scale": {'
        first_prop = .true.

        if (allocated(sc%type)) then
            json = json//NL//pad//'  "type": '// &
                   Q//sc%type//Q
            first_prop = .false.
        end if
        if (sc%domain_set) then
            if (.not. first_prop) json = json//','
            json = json//NL//pad//'  "domain": ['// &
                   real_to_str(sc%domain_min)//', '// &
                   real_to_str(sc%domain_max)//']'
            first_prop = .false.
        end if
        if (sc%zero) then
            if (.not. first_prop) json = json//','
            json = json//NL//pad//'  "zero": true'
            first_prop = .false.
        end if
        if (abs(sc%exponent - 1.0_wp) > 1.0d-10) then
            if (.not. first_prop) json = json//','
            json = json//NL//pad//'  "exponent": '// &
                   real_to_str(sc%exponent)
        end if
        json = json//NL//pad//'}'
    end subroutine append_scale

    subroutine append_axis(json, ax, indent)
        !! Append axis properties to channel JSON
        character(len=:), allocatable, intent(inout) :: json
        type(axis_t), intent(in) :: ax
        integer, intent(in) :: indent
        character(len=:), allocatable :: pad
        logical :: has_content

        has_content = ax%title_set .or. ax%grid .or. &
                      (abs(ax%label_angle) > 1.0d-10)
        if (.not. has_content) return

        pad = repeat(' ', indent)
        json = json//','//NL
        json = json//pad//'"axis": {'

        if (ax%title_set .and. allocated(ax%title)) then
            json = json//NL//pad//'  "title": '// &
                   Q//escape_json_string(ax%title)//Q
            if (ax%grid) json = json//','
        end if
        if (ax%grid) then
            json = json//NL//pad//'  "grid": true'
        end if
        if (abs(ax%label_angle) > 1.0d-10) then
            if (ax%title_set .or. ax%grid) json = json//','
            json = json//NL//pad//'  "labelAngle": '// &
                   real_to_str(ax%label_angle)
        end if
        json = json//NL//pad//'}'
    end subroutine append_axis

    function serialize_data(d, indent) result(json)
        !! Serialize data_t to JSON (row-oriented for Vega-Lite)
        type(data_t), intent(in) :: d
        integer, intent(in) :: indent
        character(len=:), allocatable :: json, pad, row_pad
        integer :: i, j, ncols
        logical :: first_field

        pad = repeat(' ', indent)
        row_pad = repeat(' ', indent + 4)

        if (.not. allocated(d%columns) .or. d%nrows == 0) then
            json = pad//'"data": {"values": []}'
            return
        end if

        ncols = size(d%columns)
        json = pad//'"data": {"values": ['//NL

        do i = 1, d%nrows
            if (i > 1) json = json//','//NL
            json = json//row_pad//'{'
            first_field = .true.
            do j = 1, ncols
                if (.not. first_field) json = json//', '
                first_field = .false.
                if (d%columns(j)%is_string) then
                    json = json//Q// &
                           escape_json_string( &
                           d%columns(j)%field)//Q// &
                           ': '//Q// &
                           escape_json_string(trim( &
                                              d%columns(j)%string_values(i)))//Q
                else
                    json = json//Q// &
                           escape_json_string( &
                           d%columns(j)%field)//Q// &
                           ': '//real_to_str( &
                           d%columns(j)%values(i))
                end if
            end do
            json = json//'}'
        end do

        json = json//NL//pad//'  ]}'
    end function serialize_data

    function serialize_layers(layers, nlayers) result(json)
        type(layer_t), intent(in) :: layers(:)
        integer, intent(in) :: nlayers
        character(len=:), allocatable :: json
        integer :: i

        json = '  "layer": ['//NL
        do i = 1, nlayers
            if (i > 1) json = json//','//NL
            json = json//'    {'//NL
            json = json//serialize_mark(layers(i)%mark, 6)
            json = json//','//NL
            json = json//serialize_encoding( &
                   layers(i)%encoding, 6)
            if (layers(i)%has_data) then
                json = json//','//NL
                json = json//serialize_data( &
                       layers(i)%data, 6)
            end if
            if (layers(i)%field%defined) then
                json = json//','//NL
                json = json//serialize_field_plot( &
                       layers(i)%field, 6)
            end if
            json = json//NL//'    }'
        end do
        json = json//NL//'  ]'
    end function serialize_layers

    pure function int_to_str(n) result(s)
        integer, intent(in) :: n
        character(len=:), allocatable :: s
        character(len=20) :: buf

        write (buf, '(i0)') n
        s = trim(buf)
    end function int_to_str

   pure function real_to_str(x) result(s)
        real(wp), intent(in) :: x
        character(len=:), allocatable :: s
        character(len=30) :: buf
        integer :: i
        logical :: is_integer

        if (x /= x) then
            s = 'null'
            return
        end if
        if (abs(x) > huge(x)) then
            s = 'null'
            return
        end if

        is_integer = .false.
        if (abs(x) <= real(huge(1), wp)) then
            is_integer = abs(x - nint(x)) < 1.0d-10
        end if

        if (is_integer) then
            write (buf, '(i0)') nint(x)
        else
            write (buf, '(es17.10)') x
            buf = adjustl(buf)
            i = len_trim(buf)
            do while (i > 1 .and. buf(i:i) == '0')
                if (buf(i - 1:i - 1) == '.') exit
                i = i - 1
            end do
            buf(i + 1:) = ' '
        end if
        s = trim(adjustl(buf))
    end function real_to_str

end module fortplot_spec_json
