re-organized in preparation for additions

This commit is contained in:
Matthias Felleisen 2016-05-01 09:47:30 -04:00
parent 76418e9be8
commit fdcbe249f9

View File

@ -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))