vm2gol-v2-libreoffice-basic

Json.bas

rem -*- mode: basic -*-

Option Explicit

rem --------------------------------

function parse_json(json)
  dim parse_result
  parse_result = _parse_json(json)
  parse_json = parse_result(0)
end function

function _parse_json(json)
  dim retval, pos, c, rest
  dim str
  dim DQ, LF
  DQ = chr(34)
  LF = chr(10)

  dim xs
  xs = list_new(4)

  pos = 1
  do while pos < len(json)
    rest = substring(json, pos)
    c = get_char(rest, 0)
    
    if c = "[" then
      dim list_elem
      dim size
      retval = _parse_json(substring(rest, 1))
      list_elem = retval(0)
      size = retval(1)
      list_add(xs, list_elem)
      pos = pos + size
    elseif c = "]" then
      exit do
    elseif c = " " or c = "," or c = LF then
      pos = pos + 1
    elseif c = DQ then
      str = consume_str(rest)
      list_add(xs, str)
      pos = pos + len(str) + 2
    elseif is_number(c) then
      str = consume_int(rest)
      list_add(xs, CInt(str))
      pos = pos + len(str)
    else
      pos = pos + 1
    end if
    
  loop

  _parse_json = Array(xs, pos)
end function


function consume_int(rest)
  dim pos

  pos = 0
  do while pos < len(rest)
    if not is_number(get_char(rest, pos)) then
      exit do
    end if
    pos = pos + 1
  loop
  
  consume_int = left(rest, pos)
end function


function consume_str(rest)
  dim pos, c
  dim DQ
  DQ = chr(34)
  pos = 1

  do while pos < len(rest)
    c = get_char(rest, pos)
    if c = DQ then
      exit do
    end if
    pos = pos + 1
  loop

  dim s1
  s1 = left(rest, pos)
  consume_str = substring(s1, 1)
end function


function is_number(c)
  dim retval as boolean
  is_number = ( _
       c = "0" _
    or c = "1" _
    or c = "2" _
    or c = "3" _
    or c = "4" _
    or c = "5" _
    or c = "6" _
    or c = "7" _
    or c = "8" _
    or c = "9" _
    or c = "-" _
  )
end function


function indent(n)
  indent = Space(4 * n)
end function


function _list_to_json(xs, lv)
  dim s, retval as string
  dim i, val
  dim DQ, LF
  DQ = chr(34)
  LF = chr(10)

  s = indent(lv) & "["
  s = s & LF

  i = -1
  do while i + 1 < xs.len
    i = i + 1
    val = list_get(xs, i)
    s = s

    if list_is_list2(val) then
      s = s & _list_to_json(val, lv + 1)
    else
      select case TypeName(val)
      case "Integer"
        s = s & indent(lv + 1) & val
      case "Double"
        s = s & indent(lv + 1) & val
      case "String"
        s = s & indent(lv + 1) & DQ & val & DQ rem TODO escape
      case else
              s = s & indent(lv) & "TODO unsupported type: " & TypeName(val)
      end select
    end if

    if i < xs.len - 1 then
      s = s & ", "
    end if

    s = s & LF
  loop

  s = s & indent(lv) & "]"

  _list_to_json = s
end function


function list_to_json(xs)
  list_to_json = _list_to_json(xs, 0)
end function

rem --------------------------------

function substring(str, index)
  substring = right(str, len(str) - index)
end function


function get_char(str, index)
  get_char = right(left(str, index + 1), 1)
end function