re-organized in preparation for additions
This commit is contained in:
parent
76418e9be8
commit
fdcbe249f9
|
@ -1,20 +1,50 @@
|
|||
#lang racket/base
|
||||
|
||||
#| Roughly based on the PLaneT package by Dave Herman,
|
||||
Originally released under MIT license.
|
||||
|#
|
||||
;; Roughly based on the PLaneT package by Dave Herman,
|
||||
;; Originally released under MIT license.
|
||||
|
||||
;; ----------------------------------------------------------------------------
|
||||
;; Customization
|
||||
;; edited: Matthias, organization in preparation for pretty-print
|
||||
|
||||
;; -----------------------------------------------------------------------------
|
||||
;; SERVICES
|
||||
|
||||
(provide
|
||||
;; Parameter
|
||||
json-null ;; Parameter
|
||||
|
||||
;; Any -> Boolean
|
||||
jsexpr?
|
||||
|
||||
#;
|
||||
(->* (Output-Port) ([#:null Any][#:encode (U 'control 'all)]))
|
||||
;; #:null (json-null)
|
||||
;; #:encode 'control
|
||||
write-json
|
||||
|
||||
#;
|
||||
(->* (Input-Port) ([#:null Any]))
|
||||
;; #null: (json-null)
|
||||
read-json
|
||||
|
||||
jsexpr->string
|
||||
jsexpr->bytes
|
||||
string->jsexpr
|
||||
bytes->jsexpr)
|
||||
|
||||
;; -----------------------------------------------------------------------------
|
||||
;; DEPENDENCIES
|
||||
|
||||
(require syntax/readerr)
|
||||
|
||||
;; -----------------------------------------------------------------------------
|
||||
;; CUSTOMIZATION
|
||||
|
||||
;; The default translation for a JSON `null' value
|
||||
(provide json-null)
|
||||
(define json-null (make-parameter 'null))
|
||||
|
||||
;; ----------------------------------------------------------------------------
|
||||
;; Predicate
|
||||
;; -----------------------------------------------------------------------------
|
||||
;; PREDICATE
|
||||
|
||||
(provide jsexpr?)
|
||||
(define (jsexpr? x #:null [jsnull (json-null)])
|
||||
(let loop ([x x])
|
||||
(or (exact-integer? x)
|
||||
|
@ -29,8 +59,12 @@
|
|||
(define (real-real? x) ; not nan or inf
|
||||
(and (inexact-real? x) (not (member x '(+nan.0 +inf.0 -inf.0)))))
|
||||
|
||||
;; ----------------------------------------------------------------------------
|
||||
;; Generation: Racket -> JSON
|
||||
;; -----------------------------------------------------------------------------
|
||||
;; GENERATION (from Racket to JSON)
|
||||
|
||||
(define (write-json x [o (current-output-port)]
|
||||
#:null [jsnull (json-null)] #:encode [enc 'control])
|
||||
(write-json* 'write-json x o jsnull enc))
|
||||
|
||||
(define (write-json* who x o jsnull enc)
|
||||
(define (escape m)
|
||||
|
@ -94,15 +128,11 @@
|
|||
[else (raise-type-error who "legal JSON value" x)]))
|
||||
(void))
|
||||
|
||||
(provide write-json)
|
||||
(define (write-json x [o (current-output-port)]
|
||||
#:null [jsnull (json-null)] #:encode [enc 'control])
|
||||
(write-json* 'write-json x o jsnull enc))
|
||||
;; -----------------------------------------------------------------------------
|
||||
;; PARSING (from JSON to Racket)
|
||||
|
||||
;; ----------------------------------------------------------------------------
|
||||
;; Parsing: JSON -> Racket
|
||||
|
||||
(require syntax/readerr)
|
||||
(define (read-json [i (current-input-port)] #:null [jsnull (json-null)])
|
||||
(read-json* 'read-json i jsnull))
|
||||
|
||||
(define (read-json* who i jsnull)
|
||||
;; Follows the specification (eg, at json.org) -- no extensions.
|
||||
|
@ -192,27 +222,23 @@
|
|||
;;
|
||||
(read-json #t))
|
||||
|
||||
(provide read-json)
|
||||
(define (read-json [i (current-input-port)] #:null [jsnull (json-null)])
|
||||
(read-json* 'read-json i jsnull))
|
||||
;; -----------------------------------------------------------------------------
|
||||
;; CONVENIENCE FUNCTIONS
|
||||
|
||||
;; ----------------------------------------------------------------------------
|
||||
;; Convenience functions
|
||||
|
||||
(provide jsexpr->string jsexpr->bytes)
|
||||
(define (jsexpr->string x #:null [jsnull (json-null)] #:encode [enc 'control])
|
||||
(define o (open-output-string))
|
||||
(write-json* 'jsexpr->string x o jsnull enc)
|
||||
(get-output-string o))
|
||||
|
||||
(define (jsexpr->bytes x #:null [jsnull (json-null)] #:encode [enc 'control])
|
||||
(define o (open-output-bytes))
|
||||
(write-json* 'jsexpr->bytes x o jsnull enc)
|
||||
(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* 'string->jsexpr (open-input-string str) jsnull))
|
||||
|
||||
(define (bytes->jsexpr str #:null [jsnull (json-null)])
|
||||
(unless (bytes? str) (raise-type-error 'bytes->jsexpr "bytes" str))
|
||||
(read-json* 'bytes->jsexpr (open-input-bytes str) jsnull))
|
||||
|
|
Loading…
Reference in New Issue
Block a user