#lang racket/base
;; For legal info, see file "info.rkt".

(require (planet neil/overeasy:2)
         "json-parsing.rkt")

(test-section 'json-parsing

  (define misc-json-str
    "{\"a\":\"b\",\"c\":{\"d\":\"e\",\"f\":[\"g\",\"h\",\"i\"]},\"j\":\"k\",\"A\":null,\"B\":true,\"C\":false,\"D\":42,\"E\":3.1459,\"F\":3.0e+3,\"G\":7e-2} InvalidToken")

  (test 'misc-to-sjson
        (json->sjson misc-json-str #:exhaust? #f)
        ;; Note: "#hasheq" here doesn't permit the "equal?" to work, but
        ;; "make-hasheq" seems to.  Perhaps because the former is mutable,
        ;; and the parser's is not at this time?
        (make-hasheq `((a . "b")
                       (c . ,(make-hasheq '((d . "e")
                                            (f . ("g" "h" "i")))))
                       (j . "k")
                       (A . #\null)
                       (B . #t)
                       (C . #f)
                       (D . 42)
                       (E . 3.1459)
                       (F . 3000.0)
                       (G . 0.07))))

  (test 'misc-to-sxml
        (json->sxml misc-json-str #:exhaust? #f)
        '(*TOP*
          (object
           (member (@ (name "a")) (string "b"))
           (member (@ (name "c"))
                   (object
                    (member (@ (name "d")) (string "e"))
                    (member (@ (name "f"))
                            (array (string "g")
                                   (string "h")
                                   (string "i")))))
           (member (@ (name "j")) (string "k"))
           (member (@ (name "A")) (null))
           (member (@ (name "B")) (true))
           (member (@ (name "C")) (false))
           (member (@ (name "D")) (number "42"))
           (member (@ (name "E")) (number "3.1459"))
           (member (@ (name "F")) (number "3000.0"))
           (member (@ (name "G")) (number "0.07")))))

  (test 'misc-to-xml
        (json->xml misc-json-str #:exhaust? #f)
        "<object><member name=\"a\"><string>b</string></member><member name=\"c\"><object><member name=\"d\"><string>e</string></member><member name=\"f\"><array><string>g</string><string>h</string><string>i</string></array></member></object></member><member name=\"j\"><string>k</string></member><member name=\"A\"><null/></member><member name=\"B\"><true/></member><member name=\"C\"><false/></member><member name=\"D\"><number>42</number></member><member name=\"E\"><number>3.1459</number></member><member name=\"F\"><number>3000.0</number></member><member name=\"G\"><number>0.07</number></member></object>")

  (test 'empty-string
        (let ((sxml (json->sxml "")))
          (if (eof-object? sxml) '*eof* sxml))
        '*eof*)

  (test 'space-string
        (let ((sxml (json->sxml "  ")))
          (if (eof-object? sxml) '*eof* sxml))
        '*eof*)

  (test 'read-eof
        (let* ((json  "  42  ")
               (in    (open-input-string json))
               (sxml1 (json->sxml in #:exhaust? #f))
               (sxml2 (json->sxml in #:exhaust? #f)))
          (values sxml1 (if (eof-object? sxml2) '*eof* sxml2)))
        (values '(*TOP* (number "42")) '*eof*))

  (test 'can-read-non-json-immediately-after-json
        (let* ((json "  [1]hello")
               (in   (open-input-string json))
               (sxml (json->sxml in #:exhaust? #f))
               (str  (read-string 100 in)))
          (values sxml str))
        (values '(*TOP* (array (number "1"))) "hello"))

  (test 'escapes-in-string
        (json->sjson " \"\\\"a\\\\\\/\\b\\f\\n\\r\\t\\u0000\\u0042\" ")
        "\"a\\/\b\f\n\r\t\u0000B")

  ;; TODO: Test "make-json-fold".

  ;; TODO: Test various error-checking.  Including extraneous stuff after
  ;; various tokens that it should error-catch on, like alpha right after
  ;; number.  See all uses of the error-signalling macro.

  ;; TODO: Add testing for various number formats.  We have already tested
  ;; interactively, but did not capture the tests.
  )