Fix function names in JSON error messages.

This commit is contained in:
Sam Tobin-Hochstadt 2013-06-11 11:27:48 -04:00
parent 633c89de82
commit f25971ada1
2 changed files with 19 additions and 12 deletions

View File

@ -49,6 +49,7 @@ the @rfc for more information about JSON.
@defproc[(write-json [x jsexpr?] [out output-port? (current-output-port)] @defproc[(write-json [x jsexpr?] [out output-port? (current-output-port)]
[#:null jsnull any? (json-null)] [#:null jsnull any? (json-null)]
[#:function name symbol? 'write-json]
[#:encode encode (or/c 'control 'all) 'control]) [#:encode encode (or/c 'control 'all) 'control])
any]{ any]{
Writes the @racket[x] @tech{jsexpr}, encoded as JSON, to the Writes the @racket[x] @tech{jsexpr}, encoded as JSON, to the
@ -60,7 +61,9 @@ the @rfc for more information about JSON.
encoded as well. This can be useful if you need to transport the text 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 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} the range of @tt{U+10000} and above are encoded as two @tt{\uHHHH}
escapes, see Section 2.5 of the @|rfc|.} escapes, see Section 2.5 of the @|rfc|.
@racket[name] is used when reporting errors.}
@defproc[(jsexpr->string [x jsexpr?] @defproc[(jsexpr->string [x jsexpr?]
[#:null jsnull any? (json-null)] [#:null jsnull any? (json-null)]
@ -78,11 +81,14 @@ the @rfc for more information about JSON.
@section{Parsing JSON Text into JS-Expressions} @section{Parsing JSON Text into JS-Expressions}
@defproc[(read-json [in input-port? (current-input-port)] @defproc[(read-json [in input-port? (current-input-port)]
[#:function name symbol? 'read-json]
[#:null jsnull any? (json-null)]) [#:null jsnull any? (json-null)])
(or/c jsexpr? eof-object?)]{ (or/c jsexpr? eof-object?)]{
Reads a @tech{jsexpr} from a JSON-encoded input port @racket[in] as a Reads a @tech{jsexpr} from a JSON-encoded input port @racket[in] as a
Racket (immutable) value, or produces @racket[eof] if only whitespace Racket (immutable) value, or produces @racket[eof] if only whitespace
remains.} remains.
@racket[name] is used when reporting errors.}
@defproc[(string->jsexpr [str string?] [#:null jsnull any? (json-null)]) @defproc[(string->jsexpr [str string?] [#:null jsnull any? (json-null)])
jsexpr?]{ jsexpr?]{

View File

@ -30,7 +30,7 @@
;; Generation: Racket -> JSON ;; Generation: Racket -> JSON
(provide write-json) (provide write-json)
(define (write-json x [o (current-output-port)] (define (write-json x [o (current-output-port)] #:function [name 'write-json]
#:null [jsnull (json-null)] #:encode [enc 'control]) #:null [jsnull (json-null)] #:encode [enc 'control])
(define (escape m) (define (escape m)
(define ch (string-ref m 0)) (define ch (string-ref m 0))
@ -56,7 +56,7 @@
(case enc (case enc
[(control) #rx"[\0-\37\\\"\177]"] [(control) #rx"[\0-\37\\\"\177]"]
[(all) #rx"[\0-\37\\\"\177-\U10FFFF]"] [(all) #rx"[\0-\37\\\"\177-\U10FFFF]"]
[else (raise-type-error 'write-json "encoding symbol" enc)])) [else (raise-type-error name "encoding symbol" enc)]))
(define (write-json-string str) (define (write-json-string str)
(write-bytes #"\"" o) (write-bytes #"\"" o)
(write-string (regexp-replace* rx-to-encode str escape) o) (write-string (regexp-replace* rx-to-encode str escape) o)
@ -78,13 +78,13 @@
(define first? #t) (define first? #t)
(for ([(k v) (in-hash x)]) (for ([(k v) (in-hash x)])
(unless (symbol? k) (unless (symbol? k)
(raise-type-error 'write-json "legal JSON key value" k)) (raise-type-error name "legal JSON key value" k))
(if first? (set! first? #f) (write-bytes #"," o)) (if first? (set! first? #f) (write-bytes #"," o))
(write (symbol->string k) o) ; no `printf' => proper escapes (write (symbol->string k) o) ; no `printf' => proper escapes
(write-bytes #":" o) (write-bytes #":" o)
(loop v)) (loop v))
(write-bytes #"}" o)] (write-bytes #"}" o)]
[else (raise-type-error 'write-json "legal JSON value" x)])) [else (raise-type-error name "legal JSON value" x)]))
(void)) (void))
;; ---------------------------------------------------------------------------- ;; ----------------------------------------------------------------------------
@ -93,12 +93,13 @@
(require syntax/readerr) (require syntax/readerr)
(provide read-json) (provide read-json)
(define (read-json [i (current-input-port)] #:null [jsnull (json-null)]) (define (read-json [i (current-input-port)] #:null [jsnull (json-null)]
#:function [name 'read-json])
;; Follows the specification (eg, at json.org) -- no extensions. ;; Follows the specification (eg, at json.org) -- no extensions.
;; ;;
(define (err fmt . args) (define (err fmt . args)
(define-values [l c p] (port-next-location i)) (define-values [l c p] (port-next-location i))
(raise-read-error (format "read-json: ~a" (apply format fmt args)) (raise-read-error (format "~a: ~a" name (apply format fmt args))
(object-name i) l c p #f)) (object-name i) l c p #f))
(define (skip-whitespace) (regexp-match? #px#"^\\s*" i)) (define (skip-whitespace) (regexp-match? #px#"^\\s*" i))
;; ;;
@ -182,17 +183,17 @@
(provide jsexpr->string jsexpr->bytes) (provide jsexpr->string jsexpr->bytes)
(define (jsexpr->string x #:null [jsnull (json-null)] #:encode [enc 'control]) (define (jsexpr->string x #:null [jsnull (json-null)] #:encode [enc 'control])
(define o (open-output-string)) (define o (open-output-string))
(write-json x o #:null jsnull #:encode enc) (write-json x o #:null jsnull #:encode enc #:function 'jsexpr->string)
(get-output-string o)) (get-output-string o))
(define (jsexpr->bytes x #:null [jsnull (json-null)] #:encode [enc 'control]) (define (jsexpr->bytes x #:null [jsnull (json-null)] #:encode [enc 'control])
(define o (open-output-bytes)) (define o (open-output-bytes))
(write-json x o #:null jsnull #:encode enc) (write-json x o #:null jsnull #:encode enc #:function 'jsexpr->bytes)
(get-output-bytes o)) (get-output-bytes o))
(provide string->jsexpr bytes->jsexpr) (provide string->jsexpr bytes->jsexpr)
(define (string->jsexpr str #:null [jsnull (json-null)]) (define (string->jsexpr str #:null [jsnull (json-null)])
(unless (string? str) (raise-type-error 'string->jsexpr "string" str)) (unless (string? str) (raise-type-error 'string->jsexpr "string" str))
(read-json (open-input-string str) #:null jsnull)) (read-json (open-input-string str) #:null jsnull #:function string->jsexpr))
(define (bytes->jsexpr str #:null [jsnull (json-null)]) (define (bytes->jsexpr str #:null [jsnull (json-null)])
(unless (bytes? str) (raise-type-error 'bytes->jsexpr "bytes" str)) (unless (bytes? str) (raise-type-error 'bytes->jsexpr "bytes" str))
(read-json (open-input-bytes str) #:null jsnull)) (read-json (open-input-bytes str) #:null jsnull #:function bytes->jsexpr))