(import medea)
(use test)

(test-group "custom parsers"
  (parameterize
      ((json-parsers (append `((object . ,(lambda (object)
                                            (cons 'object object)))
                               (member . ,(lambda (name value)
                                            (list (string->symbol name) value)))
                               (array . ,(lambda (array)
                                           (cons 'array array))))
                             (json-parsers))))

    (test-read "sxml" '(object (foo (array 1 2 3))
                               (bar (object (baz "hey there"))))
               "{ \"foo\": [1,2,3], \"bar\" : { \"baz\": \"hey there\" } }"))

  (parameterize ((json-parsers (alist-cons 'string string-upcase (json-parsers))))
    (test-read "string parser customization"
               '#("HEY" ((there . "SAY WHAT")))
               "[\"hey\", { \"there\": \"say WhaT\" }]")))


(test-group "custom unparsers"
  (parameterize
      ((json-unparsers (alist-cons symbol? 
                                   (lambda (o) 
                                     (write-json (format ":~A" (symbol->string o))))
                                   (json-unparsers))))
    (test-write "symbols" "[\":foo\",\":bar\"]" '#(foo bar)))


  (parameterize
      ((json-unparsers (append (list (cons (lambda (o)
                                             (and (pair? o) (eq? 'object (car o))))
                                           (lambda (o)
                                             (write-json (map (lambda (m) (apply cons m)) (cdr o)))))
                                     (cons (lambda (o)
                                             (and (pair? o) (eq? 'array (car o))))
                                           (lambda (o)
                                             (write-json (list->vector (cdr o))))))
                               (json-unparsers))))
    (test-write "sxml" "{\"foo\":[123,\"hey\"]}" '(object (foo (array 123 "hey"))))))