diff --git a/collects/json/json.scrbl b/collects/json/json.scrbl index b39025b7ab..7c66bf8d3f 100644 --- a/collects/json/json.scrbl +++ b/collects/json/json.scrbl @@ -49,6 +49,7 @@ the @rfc for more information about JSON. @defproc[(write-json [x jsexpr?] [out output-port? (current-output-port)] [#:null jsnull any? (json-null)] + [#:function name symbol? 'write-json] [#:encode encode (or/c 'control 'all) 'control]) any]{ 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 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|.} + escapes, see Section 2.5 of the @|rfc|. + + @racket[name] is used when reporting errors.} @defproc[(jsexpr->string [x jsexpr?] [#:null jsnull any? (json-null)] @@ -78,11 +81,14 @@ the @rfc for more information about JSON. @section{Parsing JSON Text into JS-Expressions} @defproc[(read-json [in input-port? (current-input-port)] + [#:function name symbol? 'read-json] [#:null jsnull any? (json-null)]) (or/c jsexpr? eof-object?)]{ Reads a @tech{jsexpr} from a JSON-encoded input port @racket[in] as a 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)]) jsexpr?]{ diff --git a/collects/json/main.rkt b/collects/json/main.rkt index e4f9bad741..673ab9a001 100644 --- a/collects/json/main.rkt +++ b/collects/json/main.rkt @@ -30,7 +30,7 @@ ;; Generation: Racket -> 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]) (define (escape m) (define ch (string-ref m 0)) @@ -56,7 +56,7 @@ (case enc [(control) #rx"[\0-\37\\\"\177]"] [(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) (write-bytes #"\"" o) (write-string (regexp-replace* rx-to-encode str escape) o) @@ -78,13 +78,13 @@ (define first? #t) (for ([(k v) (in-hash x)]) (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)) (write (symbol->string k) o) ; no `printf' => proper escapes (write-bytes #":" o) (loop v)) (write-bytes #"}" o)] - [else (raise-type-error 'write-json "legal JSON value" x)])) + [else (raise-type-error name "legal JSON value" x)])) (void)) ;; ---------------------------------------------------------------------------- @@ -93,12 +93,13 @@ (require syntax/readerr) (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. ;; (define (err fmt . args) (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)) (define (skip-whitespace) (regexp-match? #px#"^\\s*" i)) ;; @@ -182,17 +183,17 @@ (provide jsexpr->string jsexpr->bytes) (define (jsexpr->string x #:null [jsnull (json-null)] #:encode [enc 'control]) (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)) (define (jsexpr->bytes x #:null [jsnull (json-null)] #:encode [enc 'control]) (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)) (provide string->jsexpr bytes->jsexpr) (define (string->jsexpr str #:null [jsnull (json-null)]) (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)]) (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))