suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Major code revision for the json library.

Browse Source 
* Modernize, improve, reformat, reorganize, etc.

* Use 'null as the default translation for json `null'.  Add keyword
  `#:null' arguments to control it, and a `json-null' parameter to
  change the default.  (Note that there is no ambiguity: symbols are
  used in hash keys, and JSON restricts them to always be strings, so
  `null' can never be a hash key.)

* Properly decode double \u-escape sequences (as UTF-16 surrogate
  pairs).

* Add a keyword option to do more string encoding of all non-ASCII
  characters.

* Rename `json->jsexpr' (and other way) to `string->jsexpr'.  This is
  because (a) after using it for a while I still can't remember which
  side is which and a `string' in the name makes it clear, (b) it
  follows the similar `xexpr' functions.
This commit is contained in:
Eli Barzilay 2012-03-12 06:15:49 -04:00
parent a4ba7c8ebc
commit 540213236a
3 changed files with 324 additions and 299 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

163
collects/json/json.scrbl
View File

@ -1,89 +1,120 @@
#lang scribble/doc
#lang scribble/manual
@require[scribble/manual
scribble/base
scribble/eval
scribble/bnf
scheme/runtime-path]
@(require (for-label racket/base json))
@require[(for-syntax scheme/base)]
@(define website @link["http://json.org"]{JSON web site})
@(define rfc @link["http://www.ietf.org/rfc/rfc4627.txt"]{JSON RFC})
@require[(for-label scheme/base json)]
@; @(begin (require scribble/eval)
@; (define ev (make-base-eval))
@; (ev '(require json)))
@define-runtime-path[home (build-path 'same)]
@title{JSON}
@define[the-eval
(let ([the-eval (make-base-eval)])
(parameterize ([current-directory home])
(the-eval `(require (file ,(path->string (build-path home "main.ss"))))))
the-eval)]
@title[#:tag "top"]{@bold{JSON}}
by Dave Herman (@tt{dherman at ccs dot neu dot edu})
This library provides utilities for marshalling and unmarshalling data in the JSON data exchange format.
See the @link["http://www.json.org"]{JSON web site} and the @link["http://www.ietf.org/rfc/rfc4627.txt?number=4627"]{JSON RFC}
for more information about JSON.
@author["Eli Barzilay" "Dave Herman"]
@defmodule[json]
@section[#:tag "jsexprs"]{JS-Expressions}
This library provides utilities for parsing and producing data in the
JSON data exchange format to/from Racket values. See the @website and
the @rfc for more information about JSON.
This library defines a subset of Scheme values that can be represented as JSON strings.
A @deftech{JS-Expression}, or @deftech{jsexpr}, is one of:
@section{JS-Expressions}
@itemlist[
@item{@schemevalfont{#\null}}
@item{@scheme[boolean?]}
@item{@scheme[string?]}
@item{@scheme[(or integer? inexact-real?)]}
@item{@scheme[(listof jsexpr?)]}
@item{@scheme[(hasheqof symbol? jsexpr?)]}
]
@defproc[(jsexpr? [x any] [#:null jsnull any? (json-null)])
boolean?]{
Performs a deep check to determine whether @racket[x] is a @tech{jsexpr}.
@defproc[(jsexpr? [x any]) boolean?]{
Performs a deep check to determine whether @scheme[x] is a @tech{jsexpr}.}
This library defines a subset of Racket values that can be represented
as JSON strings, and this predicates checks for such values. A
@deftech{JS-Expression}, or @deftech{jsexpr}, is one of:
@defproc[(read-json [in input-port? (current-input-port)]) jsexpr?]{
Reads an immutable @tech{jsexpr} from a JSON-encoded input port @scheme[in].}
@itemize[
@item{the value of @racket[jsnull], @racket['null] by default}
@item{@racket[boolean?]}
@item{@racket[string?]}
@item{@racket[(or exact-integer? inexact-real?)]}
@item{@racket[(listof jsexpr?)]}
@item{@racket[(hasheqof symbol? jsexpr?)]}]}
@defproc[(write-json [x jsexpr?] [out output-port? (current-output-port)]) any]{
Writes the @tech{jsexpr} @scheme[x], encoded as JSON, to output port @scheme[out].}
@defparam[json-null jsnull any?]{
This parameter determines the default Racket value that corresponds to
a JSON ``@tt{null}''. By default, it is the @racket['null] symbol.
In some cases a different value may better fit your needs, therefore
all functions in this library accept a @racket[#:null] keyword
argument for the value that is used to represent a JSON ``@tt{null}'',
and this argument defaults to @racket[(json-null)].}
@defproc[(jsexpr->json [x jsexpr?]) string?]{
Generates a JSON source string for the @tech{jsexpr} @scheme[x].}
@section{Generating JSON Text from JS-Expressions}
@defproc[(json->jsexpr [s string?]) jsexpr?]{
Parses the JSON string @scheme[s] as an immutable @tech{jsexpr}.}
@defproc[(write-json [x jsexpr?] [out output-port? (current-output-port)]
[#:null jsnull any? (json-null)]
[#:encode encode (or/c 'control 'all) 'control])
any]{
Writes the @racket[x] @tech{jsexpr}, encoded as JSON, to the
@racket[outp] output port.
@;examples[#:eval the-eval 42]
By default, only ASCII control characters are encoded as
``@tt{\uHHHH}''. If @racket[encode] is given as @racket['all], then
in addition to ASCII control characters, non-ASCII characters are
encoded as well. This can be useful if you need to transport the text
via channels that might not support UTF-8. Note that characters in
the range of @tt{U+10000} and above are encoded as two @tt{\uHHHH}
escapes, see Section 2.5 of the @|rfc|.}
@section[#:tag "rationale"]{A word about design}
@defproc[(jsexpr->string [x jsexpr?]
[#:null jsnull any? (json-null)]
[#:encode encode (or/c 'control 'all) 'control])
string?]{
Generates a JSON source string for the @tech{jsexpr} @racket[x].}
Because JSON distinguishes syntactically between @tt{null}, array literals, and object literals,
this library uses non-overlapping datatypes for the three corresponding variants of @tech{jsexpr}.
@section{Parsing JSON Text into JS-Expressions}
Since the Scheme null value @scheme['()] overlaps with lists, there is no natural choice for the
@tech{jsexpr} represented as @tt{null}. We prefer @schemevalfont{#\null} as the least objectionable
option from Scheme's host of singleton datatypes (note that the @void-const and @undefined-const
constants do not have @scheme[read]able and @scheme[write]able representations, which makes them
less convenient choices).
@defproc[(read-json [in input-port? (current-input-port)]
[#:null jsnull any? (json-null)])
jsexpr?]{
Reads a @tech{jsexpr} from a JSON-encoded input port @racket[in] as a
Racket (immutable) value.}
The @link["http://www.ietf.org/rfc/rfc4627.txt?number=4627"]{JSON RFC} only states that object
literal expressions "SHOULD" contain unique keys, but does not proscribe them entirely. Looking at
existing practice, it appears that popular JSON libraries parse object literals with duplicate keys
by simply picking one of the key-value pairs and discarding the others with the same key. This
behavior is naturally paralleled by PLT Scheme hash tables, making them a natural analog.
@defproc[(string->jsexpr [str string?] [#:null jsnull any? (json-null)])
jsexpr?]{
Parses the JSON string @racket[str] as an immutable @tech{jsexpr}.}
Finally, the @link["http://www.ietf.org/rfc/rfc4627.txt?number=4627"]{JSON RFC} is almost completely
silent about the order of key-value pairs. While the RFC only specifies the syntax of JSON, which of
course always must represent object literals as an ordered collection, the introduction states:
@section{A word about design}
@nested[#:style 'inset]{An object is an unordered collection of zero or more name/value
pairs, where a name is a string and a value is a string, number,
boolean, null, object, or array.}
JSON syntactically distinguishes ``@tt{null}'', array literals, and
object literals, and therefore there is a question of what Racket value
should represent a JSON ``@tt{null}''. This library uses the Racket
@racket['null] symbol by default. Note that this is unambiguous, since
Racket symbols are used only as object keys, which are required to be
strings in JSON.
In practice, JSON libraries discard the order of object literals in parsed JSON text and make no
guarantees about the order of generated object literals. This again makes hash tables a good choice
for representing as JSON object literals.
Several other options have been used by various libaries. For example,
Dave Herman's PLaneT library (which has been the basis for this library)
uses the @racket[#\nul] character, other libraries for Racket and other
Lisps use @racket[(void)], @tt{NIL} (some use it also for JSON
``@tt{false}''), and more. The approach taken by this library is to use
a keyword argument for all functions, with a parameter that determines
its default, making it easy to use any value that fits your needs.
The @rfc only states that object literal expressions ``SHOULD'' contain
unique keys, but does not proscribe them entirely. Looking at existing
practice, it appears that popular JSON libraries parse object literals
with duplicate keys by simply picking one of the key-value pairs and
discarding the others with the same key. This behavior is naturally
paralleled by Racket hash tables, making them a natural analog.
Finally, the @rfc is almost completely silent about the order of
key-value pairs. While the RFC only specifies the syntax of JSON, which
of course always must represent object literals as an ordered
collection, the introduction states:
@nested[#:style 'inset]{
An object is an unordered collection of zero or more name/value pairs,
where a name is a string and a value is a string, number, boolean,
null, object, or array.}
In practice, JSON libraries discard the order of object literals in
parsed JSON text and make no guarantees about the order of generated
object literals. This again makes hash tables a good choice for
representing as JSON object literals.

383
collects/json/main.rkt
View File

@ -1,226 +1,189 @@
#lang racket/base
#| Based on the PLaneT package by Dave Herman,
#| Roughly based on the PLaneT package by Dave Herman,
Originally released under MIT license.
|#
(require (only-in scheme/base [read scheme:read] [write scheme:write]))
(provide read-json write-json jsexpr->json json->jsexpr jsexpr?)
;; ----------------------------------------------------------------------------
;; Customization
(define (write-json json [port (current-output-port)])
(cond
[(hash? json)
(display "{" port)
(for ([(key value) json]
[i (in-naturals)])
(when (> i 0)
(display ", " port))
(fprintf port "\"~a\"" key)
(display ": " port)
(write-json value port))
(display "}" port)]
[(list? json)
(display "[" port)
(for ([(value i) (in-indexed json)])
(when (> i 0)
(display ", " port))
(write-json value port))
(display "]" port)]
[(or (string? json) (and (number? json) (or (integer? json) (inexact? json))))
(scheme:write json port)]
[(boolean? json) (scheme:write (if json 'true 'false) port)]
[(null-jsexpr? json) (scheme:write 'null port)]
[else (error 'json "bad json value: ~v" json)]))
;; The default translation for a JSON `null' value
(provide json-null)
(define json-null (make-parameter 'null))
(define (read-json [port (current-input-port)])
(skip-whitespace port)
(case (peek-char port)
[(#\{) (read/hash port)]
[(#\[) (read/list port)]
[(#\") (read/string port)]
[(#\t) (read/true port)]
[(#\f) (read/false port)]
[(#\n) (read/null port)]
[else (read/number port)]))
;; ----------------------------------------------------------------------------
;; Predicate
(define (expect ch . expected)
(unless (memq ch expected)
(error 'read "expected: ~v, got: ~a" expected ch))
ch)
(provide jsexpr?)
(define (jsexpr? x #:null [jsnull (json-null)])
(let loop ([x x])
(or (exact-integer? x)
(inexact-real? x)
(boolean? x)
(string? x)
(eq? x jsnull)
(and (list? x) (andmap loop x))
(and (hash? x) (for/and ([(k v) (in-hash x)])
(and (symbol? k) (loop v)))))))
(define (expect-string port expected)
(list->string (for/list ([ch expected])
(expect (read-char port) ch))))
;; ----------------------------------------------------------------------------
;; Generation: Racket -> JSON
(define (skip-whitespace port)
(let ([ch (peek-char port)])
(when (char-whitespace? ch)
(read-char port)
(skip-whitespace port))))
(provide write-json)
(define (write-json x [o (current-output-port)]
#:null [jsnull (json-null)] #:encode [enc 'control])
(define (escape m)
(define ch (string-ref m 0))
(define r
(assoc ch '([#\backspace . "\\b"] [#\newline . "\\n"] [#\return . "\\r"]
[#\page . "\\f"] [#\tab . "\\t"]
[#\\ . "\\\\"] [#\" . "\\\""])))
(define (u-esc n)
(define str (number->string n 16))
(define pad (case (string-length str)
[(1) "000"] [(2) "00"] [(3) "0"] [else ""]))
(string-append "\\u" pad str))
(if r
(cdr r)
(let ([n (char->integer ch)])
(if (n . < . #x10000)
(u-esc n)
;; use the (utf-16 surrogate pair) double \u-encoding
(let ([n (- n #x10000)])
(string-append (u-esc (+ #xD800 (arithmetic-shift n -10)))
(u-esc (+ #xDC00 (bitwise-and n #x3FF)))))))))
(define rx-to-encode
(case enc
[(control) #rx"[\0-\37\\\"\177]"]
[(all) #rx"[\0-\37\\\"\177-\U10FFFF]"]
[else (raise-type-error 'write-json "encoding symbol" enc)]))
(define (write-json-string str)
(write-bytes #"\"" o)
(write-string (regexp-replace* rx-to-encode str escape) o)
(write-bytes #"\"" o))
(let loop ([x x])
(cond [(or (exact-integer? x) (inexact-real? x)) (write x o)]
[(eq? x #f) (write-bytes #"false" o)]
[(eq? x #t) (write-bytes #"true" o)]
[(eq? x jsnull) (write-bytes #"null" o)]
[(string? x) (write-json-string x)]
[(list? x)
(write-bytes #"[" o)
(when (pair? x)
(loop (car x))
(for ([x (in-list (cdr x))]) (write-bytes #"," o) (loop x)))
(write-bytes #"]" o)]
[(hash? x)
(write-bytes #"{" o)
(define first? #t)
(for ([(k v) (in-hash x)])
(unless (symbol? k)
(raise-type-error 'write-json "bad JSON key value" k))
(if first? (set! first? #f) (write-bytes #"," o))
(write (symbol->string k) o) ; no `printf' => proper escapes
(write-bytes #":" o)
(loop v))
(write-bytes #"}" o)]
[else (raise-type-error 'write-json "bad JSON value" x)]))
(void))
(define (in-port-until port reader done?)
(make-do-sequence (lambda ()
(values reader
(lambda (port) port)
port
(lambda (port)
(not (done? port)))
(lambda values #t)
(lambda (port . values) #t)))))
;; ----------------------------------------------------------------------------
;; Parsing: JSON -> Racket
(define (read/hash port)
(expect (read-char port) #\{)
(skip-whitespace port)
(begin0 (for/hasheq ([(key value)
(in-port-until port
(lambda (port)
(let ([key (read/string port)])
(unless (string? key)
(error 'read "expected: string, got: ~v" key))
(skip-whitespace port)
(expect (read-char port) #\:)
(skip-whitespace port)
(let ([value (read-json port)])
(skip-whitespace port)
(expect (peek-char port) #\, #\})
(values (string->symbol key) value))))
(lambda (port)
(eq? (peek-char port) #\})))])
(when (eq? (peek-char port) #\,)
(read-char port))
(skip-whitespace port)
(values key value))
(expect (read-char port) #\})))
(require syntax/readerr)
(define (read/list port)
(expect (read-char port) #\[)
(begin0 (for/list ([value
(in-port-until port
(lambda (port)
(skip-whitespace port)
(begin0 (read-json port)
(skip-whitespace port)
(expect (peek-char port) #\, #\])))
(lambda (port)
(eq? (peek-char port) #\])))])
(when (eq? (peek-char port) #\,)
(read-char port))
value)
(expect (read-char port) #\])))
(provide read-json)
(define (read-json [i (current-input-port)] #:null [jsnull (json-null)])
;; Follows the specification (eg, at json.org) -- no extensions.
;;
(define (err fmt . args)
(define-values [l c p] (port-next-location i))
(raise-read-error (format "read-json: ~a" (apply format fmt args))
(object-name i) l c p #f))
(define (skip-whitespace) (regexp-match? #px#"^\\s*" i))
;;
;; Reading a string *could* have been nearly trivial using the racket
;; reader, except that it won't handle a "\/"...
(define (read-string)
(let loop ([l* '()])
;; note: use a string regexp to extract utf-8-able text
(define m (cdr (or (regexp-try-match #rx"^(.*?)(\"|\\\\(.))" i)
(err "unterminated string"))))
(define l (if ((bytes-length (car m)) . > . 0) (cons (car m) l*) l*))
(define esc (caddr m))
(cond
[(not esc) (bytes->string/utf-8 (apply bytes-append (reverse l)))]
[(assoc esc '([#"b" . #"\b"] [#"n" . #"\n"] [#"r" . #"\r"]
[#"f" . #"\f"] [#"t" . #"\t"]
[#"\\" . #"\\"] [#"\"" . #"\""] [#"/" . #"/"]))
=> (λ (m) (loop (cons (cdr m) l)))]
[(equal? esc #"u")
(let* ([e (or (regexp-try-match #px#"^[a-fA-F0-9]{4}" i)
(err "bad string \\u escape"))]
[e (string->number (bytes->string/utf-8 (car e)) 16)])
(define e*
(if (<= #xD800 e #xDFFF)
;; it's the first part of a UTF-16 surrogate pair
(let* ([e2 (or (regexp-try-match #px#"^\\\\u([a-fA-F0-9]{4})" i)
(err "bad string \\u escape, ~a"
"missing second half of a UTF16 pair"))]
[e2 (string->number (bytes->string/utf-8 (cadr e2)) 16)])
(if (<= #xDC00 e2 #xDFFF)
(+ (arithmetic-shift (- e #xD800) 10) (- e2 #xDC00) #x10000)
(err "bad string \\u escape, ~a"
"bad second half of a UTF16 pair")))
e)) ; single \u escape
(loop (cons (string->bytes/utf-8 (string (integer->char e*))) l)))]
[else (err "bad string escape: \"~a\"" esc)])))
;;
(define (read-list what end-rx read-one)
(skip-whitespace)
(if (regexp-try-match end-rx i)
'()
(let loop ([l (list (read-one))])
(skip-whitespace)
(cond [(regexp-try-match end-rx i) (reverse l)]
[(regexp-try-match #rx#"^," i) (loop (cons (read-one) l))]
[else (err "error while parsing a json ~a" what)]))))
;;
(define (read-hash)
(define (read-pair)
(define k (read-json))
(unless (string? k) (err "non-string value used for json object key"))
(skip-whitespace)
(unless (regexp-try-match #rx#"^:" i)
(err "error while parsing a json object pair"))
(list (string->symbol k) (read-json)))
(apply hasheq (apply append (read-list 'object #rx#"^}" read-pair))))
;;
(define (read-json)
(skip-whitespace)
(cond
[(regexp-try-match #px#"^true\\b" i) #t]
[(regexp-try-match #px#"^false\\b" i) #f]
[(regexp-try-match #px#"^null\\b" i) jsnull]
[(regexp-try-match
#rx#"^-?(?:0|[1-9][0-9]*)(?:\\.[0-9]+)?(?:[eE][+-]?[0-9]+)?" i)
=> (λ (bs) (string->number (bytes->string/utf-8 (car bs))))]
[(regexp-try-match #rx#"^[\"[{]" i)
=> (λ (m)
(let ([m (car m)])
(cond [(equal? m #"\"") (read-string)]
[(equal? m #"[") (read-list 'array #rx#"^\\]" read-json)]
[(equal? m #"{") (read-hash)])))]
[else (err "bad input")]))
;;
(read-json))
(define (read/string port)
(expect (read-char port) #\")
(begin0 (list->string
(for/list ([ch (in-port-until port
(lambda (port)
(let ([ch (read-char port)])
(when (eof-object? ch)
(error 'read "unexpected EOF"))
(if (eq? ch #\\)
(let ([esc (read-char port)])
(when (eof-object? ch)
(error 'read "unexpected EOF"))
(case esc
[(#\b) #\backspace]
[(#\n) #\newline]
[(#\r) #\return]
[(#\f) #\page]
[(#\t) #\tab]
[(#\\) #\\]
[(#\") #\"]
[(#\/) #\/]
[(#\u) (unescape (read-string 4 port))]
[else esc]))
ch)))
(lambda (port)
(eq? (peek-char port) #\")))])
ch))
(expect (read-char port) #\")))
;; ----------------------------------------------------------------------------
;; Convenience functions
(define (unescape str)
(unless (regexp-match #px"[a-fA-F0-9]{4}" str)
(error 'read "bad unicode escape sequence: \"\\u~a\"" str))
(integer->char (string->number str 16)))
(provide jsexpr->string)
(define (jsexpr->string x #:null [jsnull (json-null)] #:encode [enc 'control])
(define o (open-output-string))
(write-json x o #:null jsnull #:encode enc)
(get-output-string o))
(define (read/true port)
(expect-string port "true")
#t)
(define (read/false port)
(expect-string port "false")
#f)
(define (read/null port)
(expect-string port "null")
null-jsexpr)
(define (read/digits port)
(let ([digits (for/list ([digit (in-port-until port
read-char
(lambda (port)
(let ([ch (peek-char port)])
(or (eof-object? ch)
(not (char-numeric? ch))))))])
digit)])
(when (and (null? digits) (eof-object? (peek-char port)))
(error 'read "unexpected EOF"))
(when (null? digits)
(error 'read "expected: digits, got: ~a" (peek-char port)))
digits))
(define (read/exponent port)
(let ([sign (case (peek-char port)
[(#\- #\+) (list (read-char port))]
[else '()])])
(append sign (read/digits port))))
(define (read/number port)
(let* ([sign (if (eq? (peek-char port) #\-) (list (read-char port)) '())]
[digits (read/digits port)]
[frac (if (eq? (peek-char port) #\.)
(list* (read-char port) (read/digits port))
'())]
[exp (if (memq (peek-char port) '(#\e #\E))
(list* (read-char port) (read/exponent port))
'())])
(string->number
(list->string
(append sign digits frac exp)))))
(define (jsexpr? x)
(or (integer? x)
(and (number? x) (inexact? x))
(null-jsexpr? x)
(boolean? x)
(string? x)
(null? x)
(array-jsexpr? x)
(object-jsexpr? x)))
(define (array-jsexpr? x)
(or (null? x)
(and (pair? x)
(jsexpr? (car x))
(array-jsexpr? (cdr x)))))
(define (object-jsexpr? x)
(let/ec return
(and (hash? x)
(for ([(key value) x])
(unless (and (symbol? key) (jsexpr? value))
(return #f)))
#t)))
(define (null-jsexpr? x)
(eqv? x #\null))
(define null-jsexpr #\null)
(define (jsexpr->json x)
(let ([out (open-output-string)])
(write-json x out)
(get-output-string out)))
(define (json->jsexpr s)
(let ([in (open-input-string s)])
(read-json in)))
(provide string->jsexpr)
(define (string->jsexpr str #:null [jsnull (json-null)])
(read-json (open-input-string str) #:null jsnull))

77
collects/json/tests/json.rkt
View File

@ -17,13 +17,13 @@
(not (jsexpr? 'true))
(jsexpr? #t)
(jsexpr? #f)
(jsexpr? #\null) ; TODO
(jsexpr? 'null)
(jsexpr? "")
(jsexpr? "abc")
(jsexpr? "abc\n\\")
(jsexpr? '())
(jsexpr? '(1 2 3))
(jsexpr? '(1 "2" (3) #t #f #\null))
(jsexpr? '(1 "2" (3) #t #f null))
(jsexpr? '((((())))))
(not (jsexpr? '(1 2 . 3)))
(not (jsexpr? '#(1 2 3)))
@ -35,35 +35,66 @@
(not (jsexpr? '#hasheq([1 . 1])))
(not (jsexpr? '#hasheq(["x" . 1])))
(not (jsexpr? '#hasheq(['() . 1])))
))
)
;; other `null' values
(parameterize ([json-null #\null])
(test (not (jsexpr? '(1 "2" (3) #t #f null)))
(jsexpr? '(1 "2" (3) #t #f #\null))
)))
(define (print-tests)
(for ([x (list 0 1 -1 12345 0.0 1.0 #t #f #\null "" "abc" "abc\n\\"
'() '(1 2 3) '(1 "2" (3) #t #f #\null) '((((()))))
(for ([x (list 0 1 -1 12345 0.0 1.0 #t #f (λ(n) n) "" "abc" "abc\n\\"
'() '(1 2 3) (λ(n) `(1 "2" (3) #t #f ,n)) '((((()))))
'#hasheq()
'#hasheq([x . 1])
'#hasheq([x . 1] [y . 2])
;; '#hasheq([|x\y| . 1] [y . 2]) ; TODO
'#hasheq([|x\y| . 1] [y . 2])
;; string escapes
"λ" "\U1D11E" ; goes as a plain character in normal encoding
"\0" "\1" "\2" "\3" "\37" "\177" ; encoded as json \u escapes
"\b" "\n" "\r" "\f" "\t" ; same escapes in both
"\a" "\v" "\e" ; does not use racket escapes
)])
(test (json->jsexpr (jsexpr->json x)) => x)))
(define (N x null) (if (procedure? x) (x null) x))
(test
;; default
(string->jsexpr (jsexpr->string (N x 'null)))
=> (N x 'null)
;; different null
(string->jsexpr (jsexpr->string (N x #\null) #:null #\null) #:null #\null)
=> (N x #\null)
;; encode all non-ascii
(string->jsexpr (jsexpr->string (N x 'null) #:encode 'all))
=> (N x 'null)))
;; also test some specific expected encodings
(test (jsexpr->string "\0\1\2\3") => "\"\\u0000\\u0001\\u0002\\u0003\""
(jsexpr->string "\b\n\r\f\t\\\"") => "\"\\b\\n\\r\\f\\t\\\\\\\"\""
(jsexpr->string "\37\40\177") => "\"\\u001f \\u007f\""
(jsexpr->string "λ∀𝄞") => "\"λ∀𝄞\""
(jsexpr->string "λ∀𝄞" #:encode 'all)
=> "\"\\u03bb\\u2200\\ud834\\udd1e\""))
(define (parse-tests)
(test (json->jsexpr @T{ 1 }) => 1
;; (json->jsexpr @T{ +1 }) => 1 ; TODO
(json->jsexpr @T{ -1 }) => -1
(json->jsexpr @T{ 1.0 }) => 1.0
;; (json->jsexpr @T{ +1.0 }) => +1.0 ; TODO
(json->jsexpr @T{ -1.0 }) => -1.0
(json->jsexpr @T{ true }) => #t
(json->jsexpr @T{ false }) => #f
(json->jsexpr @T{ null }) => #\null ; TODO
(json->jsexpr @T{ [] }) => '()
(json->jsexpr @T{ [1,[2],3] }) => '(1 (2) 3)
(json->jsexpr @T{ [ 1 , [ 2 ] , 3 ] }) => '(1 (2) 3)
(json->jsexpr @T{ [true, false, null] }) => '(#t #f #\null)
(json->jsexpr @T{ {} }) => '#hasheq()
(json->jsexpr @T{ {"x":1} }) => '#hasheq([x . 1])
(json->jsexpr @T{ {"x":1,"y":2} }) => '#hasheq([x . 1] [y . 2])
(test (string->jsexpr @T{ 1 }) => 1
(string->jsexpr @T{ -1 }) => -1 ; note: `+' is forbidden
(string->jsexpr @T{ 1.0 }) => 1.0
(string->jsexpr @T{ -1.0 }) => -1.0
(string->jsexpr @T{ true }) => #t
(string->jsexpr @T{ false }) => #f
(string->jsexpr @T{ null }) => 'null
(string->jsexpr @T{ "" }) => ""
(string->jsexpr @T{ "abc" }) => "abc"
(string->jsexpr @T{ [] }) => '()
(string->jsexpr @T{ [1,[2],3] }) => '(1 (2) 3)
(string->jsexpr @T{ [ 1 , [ 2 ] , 3 ] }) => '(1 (2) 3)
(string->jsexpr @T{ [true, false, null] }) => '(#t #f null)
(string->jsexpr @T{ {} }) => '#hasheq()
(string->jsexpr @T{ {"x":1} }) => '#hasheq([x . 1])
(string->jsexpr @T{ {"x":1,"y":2} }) => '#hasheq([x . 1] [y . 2])
;; string escapes
(string->jsexpr @T{ " \b\n\r\f\t\\\"\/ " }) => " \b\n\r\f\t\\\"/ "
(string->jsexpr @T{ "\uD834\uDD1E" }) => "\U1D11E"
(string->jsexpr @T{ "\ud834\udd1e" }) => "\U1d11e"
))
(test do (pred-tests)