;; json.sal -- utilities to read/write JSON
;;
;; Roger B. Dannenberg
;; September 2022

;; require vectors.lsp:
if ! fboundp(quote(vector-from-array)) then load "vectors"

;; API FOR WRITING -- see code comments with functions for more info
;;
;; json-write-start() -- open an output file for writing json
;; insert calls between json-write-start() and json-write-finish() to write
;;   the content
;; json-write-finish() -- finish writing and close the output file
;; to write an array:
;;   json-start-array() -- start writing an array
;;   for each element:
;;     json-before-write-elem() -- call before each array element
;;     ways to write the element:
;;       format(*jof*, x) -- write string or number x
;;       or recursively write an array or dictionary
;;     you can also write a number or string element in one call:
;;       json-write-array-elem() -- write a simple number or
;;           string array element; this calls json-before-write-elem()
;;   json-finish-array() -- finish writing an array
;; alternative to write an array of all numbers and strings:
;;   json-write-array() -- write a whole array of numbers and strings
;; to write a dictionary
;;   json-start-dict() -- start writing a dictionary
;;   for each key value pair:
;;     json-write-dict-attr() -- write the attribute of an dictionary entry
;;     json-start-dict-value() -- call before writing a dictionary value
;;     ways to write the element:
;;       format(*jof*, x) -- write string or number x
;;       or recursively write an array or dictionary
;;     you can also write a whole key/value element with number or string value:
;;       json-write-dict-elem() -- write a whole simple dictionary entry
;;   json-finish-dict() -- finish writing a dictionary
;; OR, you can write an entire data structure (see json-read for
;;   representation description):
;; json-write-data() -- write structured data to a file

;; API FOR READING -- see comments with functions for more info
;;
;; json-read() -- read a file into a representation of the data
;; json-field(dict, key, default: quote(error)) -- access a dict entry by
;;         name. If not found, call error (default) or return a default value.
;;
;; Lisp representation is obvious for numbers and strings. Arrays
;; are represented by arrays. Dictionaries are represented by
;; association lists: a list of conses, where the car is the key
;; (a string) and the cdr is the value.


variable *jindent* = 0, *jof*, ;; "json output file"
         spaces = "                                ",
         *jindent-amount* = 1,
         *jneeds-comma* = { nil }, ;; this is a stack since we do not have PROGV
         *jif* ;; json input file

;; to begin writing a json file:
function json-write-start(filepath)
  set *jof* = open(filepath, direction: :output)


;; at end of writing json file:
function json-write-finish()
  begin
    exec terpri(*jof*)
    exec close(*jof*)
  end


;; to write an array, start with this; then call json-write-array-elem()
;; for each element and json-finish-array() to finish.
function json-start-array()
  begin
    exec format(*jof*, "[")
    exec json-indent()
  end
  

;; to write an array element that is an array or dict, start with this
function json-before-write-elem()
  exec format(*jof*, "~A\n~A", #?(first(*jneeds-comma*), ",", ""),
                     subseq(spaces, 0, *jindent*))


;; to write a simple number or string array element, call this
function json-write-array-elem(x)
  begin
    exec json-before-write-elem()
    exec format(*jof*, "~S", x)
    exec rplaca(*jneeds-comma*, #t)
  end


;; after writing array element-by-element, call this
function json-finish-array()
  begin
    exec json-unindent()
    exec format(*jof*, "\n~A]", subseq(spaces, 0, *jindent*))
    exec rplaca(*jneeds-comma*, #t)
  end


;; to write a whole array of numbers and strings, call this with a list or array
function json-write-array(data)
  begin
    exec json-start-array()
    exec json-write-array-helper(data)
  end


;; to start writing a dictionary, call this
function json-start-dict()
  begin
    exec format(*jof*, "{")
    exec json-indent()
  end


;; to write an attribute with an array or dict value, call this first
function json-write-dict-attr(x)
  begin
    exec json-before-write-elem()
    exec format(*jof*, "~S: ", x)
  end


;; to follow json-write-dict-attr() with an array, start wtih this; then
;; call json-write-array-elem() for each element and json-finish-array()
;; to finish.
function json-start-dict-value()
  begin
    exec format(*jof*, "{")
    exec json-indent()
  end


;; to write a number or string dict entry
function json-write-dict-elem(x, y)
  begin
    exec json-write-dict-attr(x)
    exec format(*jof*, "~S", y)
    exec rplaca(*jneeds-comma*, #t)
  end


;; call this after writing all dictionary entries
function json-finish-dict()
  begin
    exec json-unindent()
    exec format(*jof*, "\n~A}", subseq(spaces, 0, *jindent*))
    exec rplaca(*jneeds-comma*, #t)
  end


;; write data returned by json-read() or at least in that format
;;   assumes json-write-start() was called and after you will call
;;   json-write-finish()
function json-write-data(data)
  begin
    if listp(data) then
      begin
        exec json-start-dict()
        loop for elem in data
          exec json-write-dict-attr(first(elem)) ;; assume string or number
          exec json-write-data(rest(elem))
        end
        exec json-finish-dict()
      end
    else if arrayp(data) then
      begin
        exec json-start-array()
        loop for i from 0 below length(data)
          exec json-before-write-elem()
          exec json-write-data(data[i])
        end
        exec json-finish-array()
      end
    else if stringp(data) | numberp(data) then
      exec format(*jof*, "~S", data)
    else
      print "WARNING: unexpected type in json-write-data", data
  end
        

;; ------------- helper functions for indentation ---------------
function json-indent()
  begin
    set *jindent* += *jindent-amount*,
        *jneeds-comma* @= #f
    if *jindent-amount* > length(spaces) then
      set spaces = strcat(spaces, spaces)
  end


function json-unindent()
  set *jindent* -= *jindent-amount*,
      *jneeds-comma* = rest(*jneeds-comma*)


;; ------------- helper functions for writing arrays ---------------
function json-write-array-helper(data)
  begin
    if arrayp(data) then set data = vector-from-array(data)
    loop for d in data exec json-write-array-elem(d) end
    exec json-finish-array()
  end


;; ------------ READING JSON -----------------

;; json-read returns an internal representation of the first value
;; in the file (normally, the whole file)
function json-read(filename)
  begin with rslt
    set *jif* = open(filename)
    set rslt = json-read-value()
    exec close(*jif*)
    return rslt
  end


function json-field(dict, key, default: quote(error))
  begin with entry = assoc(key, dict, test: quote(equal)) 
    if entry then return rest(entry)
    else if default = quote(error) then
      exec error("json-field did not find key", key)
    else return default
  end

;; ------------- helper functions for reading json ---------------
function json-read-value()
  begin with ch = peek-char(#t, *jif*) ;; read next non-space character
    ;; read characters until we find something:
    ;; quote -> read a string
    ;; [ -> read an array
    ;; { -> read a dictionary
    ;; digit or minus or decimal point -> read a number
    ;; whitespace -> keep reading
    ;; other -> print an error and return nil
    if ! ch then return nil
    if digit-char-p(ch) | ch = #\. | ch = #\- then return read(*jif*)
    if ch = #\" then return read(*jif*)
    if ch = #\[ then return json-read-array()
    if ch = #\{ then return json-read-dict()
    print "ERROR: json-read found unexpected character", ch
    return nil
  end
    
function json-read-array()
  begin
    with ch = read-char(*jif*), ;; skip the "["
         rslt = nil, need-comma = #f  
    loop
      while t
      set ch = peek-char(#t, *jif*)
      ; display "json-read-array top of loop after peek", ch, need-comma
      if ch = #\] then
        begin
          set ch = read-char(*jif*)  ;; skip over the "]"
          return array-from-vector(reverse(rslt))
        end
      if need-comma then
        begin
          if ch != #\, then
            begin
              print "ERROR: json-read expected comma but got", ch
              return nil
            end
          set ch = read-char(*jif*) ;; skip over the comma
        end
      set rslt @= json-read-value(),
          need-comma = #t
      ; display "json-read-array", rslt
    end
  end


function json-read-dict()
  begin
    with ch = read-char(*jif*), ;; skip the "{"
         rslt = nil, key, val, need-comma = #f  
    loop
      while t
      set ch = peek-char(#t, *jif*)
      if ch = #\} then
        begin
          set ch = read-char(*jif*)
          return reverse(rslt) ;; keep fields in same order as read
        end
      if need-comma then
        begin
          if ch != #\, then
            begin
              print "ERROR: json-read expected comma but got", ch
              return nil
            end
          set ch = read-char(*jif*) ;; skip over the comma
        end
      set key = json-read-value()
      ;; key should be a string
      if type-of(key) != quote(string) then
        print "WARNING: json dictionary key", key, "is not a string"
      set ch = peek-char(#t, *jif*)
      if ch != #\: then
        begin
          print "ERROR: json-read expected comma but got", ch
          return nil
        end
      set ch = read-char(*jif*) ;; skip over colon
      set val = json-read-value(),
          need-comma = #t
      set rslt @= cons(key, val)
    end
  end
  