(def json-true ()
  (mliteral "true" t))

(def json-false ()
  (mliteral "false" nil))

(def json-null ()
  (mliteral "null" nil))

(def json-value ()
  (alt (json-true)
       (json-false)
       (json-null)))

(def json-number-char (c)
  (find c ".-+eE1234567890"))

(def json-number ()
  (coerce (string (many1 (match json-number-char))) 'num))

(ptest "1234" (json-number) 1234)
(ptest "1e7"  (json-number) 1e7)

(def hexdigit (c)
  (and (isa c 'char)
       (or (<= #\a c #\f) (<= #\A c #\F) (<= #\0 c #\9))))

(def fourhex ()
  (must
   "four hex digits required after \\u"  
   (coerce (int (string (n-of 4 (match hexdigit))) 16) 'char)))

(ptest
 "0041"
 (fourhex)
 #\u0041)

(def json-backslash-char (c)
  (case c
    #\" #\"
    #\\ #\\
    #\/ #\/
    #\b #\backspace
    #\f #\page
    #\n #\newline
    #\r #\return
    #\t #\tab
    (err "invalid backslash char" c)))

(def json-backslash-escape ()
  (match #\\)
  (alt (do (match #\u) (fourhex))
       (munch json-backslash-char)))

(ptest "\\n"     (json-backslash-escape) #\newline)
(ptest "\\u0041" (json-backslash-escape) #\A)

(def json-string ()
  (match #\")
  (must "missing closing quote in JSON string"
    (do1 (string (many (alt (json-backslash-escape)
                            (match [isnt _ #\"]))))
         (match #\"))))

(ptest "123"     (json-string) '<<parse-fail>>)
(ptest "\"\""    (json-string) "")
(ptest "\"abc\"" (json-string) "abc")
(ptest "\"ab\\ncd\"" (json-string) "ab\ncd")
(ptest-err
 "\"abc"
 (json-string)
 "missing closing quote in JSON string")

(def json-array ()
  (match #\[)
  (do1 (comma-separated (json-value)
         "a comma in a JSON array must be followed by an object")
       (must "missing closing ] in JSON array"
             (match #\]))))

(def json-value ()
  (alt (json-true)
       (json-false)
       (json-null)
       (json-number)
       (json-string)
       (json-array)))

(ptest "[]"          (json-array) nil)
(ptest "[1,2,3]"     (json-array) '(1 2 3))
(ptest "[1,[2,3],4]" (json-array) '(1 (2 3) 4))
(ptest "  [ 1 , 2 ] " (json-array) '(1 2))
(ptest-err
 "[1,]"
 (json-array)
 "a comma in a JSON array must be followed by an object")
(ptest-err
 "[1,2"
 (json-array)
 "missing closing ] in JSON array")

(def json-object-kv ()
  (let key (do (skipwhite) (json-string))
    (must "a JSON object key string must be followed by a colon"
          (skipwhite) (match #\:))
    (let value (must "a colon in a JSON object must be followed by a value"
                     (json-value))
      (list key value))))

(ptest "\"a\":1" (json-object-kv) '("a" 1))

(def json-object ()
  (match #\{)
  (do1 (listtab
        (comma-separated
         (json-object-kv)
         "a comma in a JSON object must be followed by a key"))
       (must "a JSON object must be terminated with a closing }"
             (skipwhite) (match #\}))))

(ptest "{\"a\":1}" (tablist (json-object)) '(("a" 1)))

(def json-value ()
  (alt (json-true)
       (json-false)
       (json-null)
       (json-number)
       (json-string)
       (json-array)
       (json-object)))

(def fromjson (s)
  (parses s (skipwhite) (json-value)))