(import medea)
(use test)
(use comparse)

(load-relative "python-test-pass1")

(define-syntax test-read
  (syntax-rules ()
    ((_ result json)
     (test-read json result json))
    ((_ description result json)
     (test description result (read-json json)))))

(test-group "objects"
  (test-read '() "{}")
  (test-read '((foo . 123) (qux . "hey")) "{ \"foo\" : 123, \"qux\": \"hey\" } "))

(test-group "arrays"
  (test-read '#() "[]")
  (test-read '#("foo") "[\"foo\"]")
  (test-read '#("one" 2 3 "four" 5)
             "[\"one\", 2,3, \"four\", 5]"))

(test-group "numbers"
  (test-read '#(0) "[0]")
  (test-read '#(-10) "[-10]")
  (test-read '#(222.5) "[222.5]")
  (test-read '#(10e2) "[10e2]")
  (test-read '#(2.3e2) "[2.3E+2]"))

(test-group "strings"
  (test-read '#("") "[\"\"]")
  (test-read '#("E9") "[\"\\u00459\"]")
  (test-read '#("Дҫ") "[\"\\u0414\\u04ab\"]")
  (test-read '#("Дҫ") "[\"Дҫ\"]")
  (test-read '#("\f") "[\"\\f\"]")
  (test-read '#("\"") "[\"\\\"\"]")
  (test-read #f "[\"\\x\"]"))

(test-group "literals"
  (test-read '#(#t) "[true]")
  (test-read '#(#f) "[false]")
  (test-read '#(null) "[null]"))

(test-group "whitespace"
  (test-read '() " {  \n  \t}")
  (test-read '#() " \r  []"))

(test-group "malformed"
  (test-read #f "{..}"))

(test-group "complex"

(test-read "example 1 from RFC 4627"
'((Image 
   (Width . 800)
   (Height . 600)
   (Title . "View from 15th Floor")
   (Thumbnail 
    (Url . "http://www.example.com/image/481989943")
    (Height . 125)
    (Width . "100"))
   (IDs . #(116 943 234 38793))))

#<<JSON
{
    "Image": {
        "Width":  800,
        "Height": 600,
        "Title":  "View from 15th Floor",
        "Thumbnail": {
            "Url":    "http://www.example.com/image/481989943",
            "Height": 125,
            "Width":  "100"
        },
        "IDs": [116, 943, 234, 38793]
    }
}
JSON
)

(test-read "example 2 from RFC 4627"
 '#(((precision . "zip")
     (Latitude . 37.7668)
     (Longitude . -122.3959)
     (Address . "")
     (City . "SAN FRANCISCO")
     (State . "CA")
     (Zip . "94107")
     (Country . "US"))
    ((precision . "zip")
     (Latitude . 37.371991)
     (Longitude . -122.02602)
     (Address . "")
     (City . "SUNNYVALE")
     (State . "CA")
     (Zip . "94085")
     (Country . "US")))

#<<JSON
[
   {
      "precision": "zip",
      "Latitude":  37.7668,
      "Longitude": -122.3959,
      "Address":   "",
      "City":      "SAN FRANCISCO",
      "State":     "CA",
      "Zip":       "94107",
      "Country":   "US"
   },
   {
      "precision": "zip",
      "Latitude":  37.371991,
      "Longitude": -122.026020,
      "Address":   "",
      "City":      "SUNNYVALE",
      "State":     "CA",
      "Zip":       "94085",
      "Country":   "US"
   }
]
JSON
)

(test-read
 "python test_pass1"
 '#("JSON Test Pattern pass1"
    ((|object with 1 member| . #("array with 1 element")))
    ()
    #()
    -42
    #t
    #f
    null
    ((integer . 1234567890)
     (real . -9876.543210)
     (e . 0.123456789e-12)
     (E . 1.234567890E+34)
     (|| .  23456789012E66)
     (zero . 0)
     (one . 1)
     (space . " ")
     (quote . "\"")
     (backslash . "\\")
     (controls . "\b\f\n\r\t")
     (slash . "/ & /")
     (alpha . "abcdefghijklmnopqrstuvwyz")
     (ALPHA . "ABCDEFGHIJKLMNOPQRSTUVWYZ")
     (digit . "0123456789")
     (special . "`1~!@#$%^&*()_+-={':[,]}|;.</>?")
     (hex . "\u0123\u4567\u89AB\uCDEF\uabcd\uef4A")
     (true . #t)
     (false . #f)
     (null . null)
     (array . #())
     (object)
     (address . "50 St. James Street")
     (url . "http://www.JSON.org/")
     (comment . "// /* <!-- --")
     (|# -- --> */| . " ")
     (| s p a c e d | . #(1 2 3 4 5 6 7))
     (compact . #(1 2 3 4 5 6 7))
     (jsontext . "{\"object with 1 member\":[\"array with 1 element\"]}")
     (quotes . "&#34; \u0022 %22 0x22 034 &#x22;")
     (|/\\\"\uCAFE\uBABE\uAB98\uFCDE\ubcda\uef4A\b\f\n\r\t`1~!@#$%^&*()_+-=[]{}\|;:',./<>?| . "A key can be any string"))
    0.5
    98.6
    99.44
    1066
    "rosebud")

 json-python-test-pass1)

(test "reading from current-input-port by default"
  '#("foo")
  (with-input-from-string "[\"foo\"]" read-json))

)

(test-group "consume trailing whitespace by default"
  (call-with-input-string "{} "
    (lambda (in)
      (receive (result remainder)
        (read-json in)
        (test result '())
        (test "" (parser-input->string remainder))))))

(test-group "don't consume trailing whitespace when passing consume-trailing-whitespace: #f"
  (call-with-input-string "{} "
    (lambda (in)
      (receive (result remainder)
        (read-json in consume-trailing-whitespace: #f)
        (test result '())
        (test " " (parser-input->string remainder))))))