diff --git a/doc/reference/std/text/json.md b/doc/reference/std/text/json.md index 71e42bca8..e23fb250c 100644 --- a/doc/reference/std/text/json.md +++ b/doc/reference/std/text/json.md @@ -1,12 +1,12 @@ # JSON ::: tip To use the bindings from this module: -``` scheme +```scheme (import :std/text/json) ``` ::: ## read-json -``` scheme +```scheme (read-json [input = (current-input-port)]) -> json | error input := input source to read JSON data @@ -20,7 +20,7 @@ The input source can be: - A BufferedReader. ## write-json -``` scheme +```scheme (write-json obj [sink = (current-output-port)]) -> void | error obj := JSON object @@ -38,7 +38,7 @@ The output sink can be: - A Writer. ## string->json-object -``` scheme +```scheme (string->json-object str) -> json | error str := a string of JSON data @@ -47,7 +47,7 @@ The output sink can be: Parses given *str* and returns JSON object or signals an error if it fails to parse. ## json-object->string -``` scheme +```scheme (json-object->string obj) -> string | error obj := JSON object @@ -57,7 +57,7 @@ Returns a newly allocated string with JSON object as a string. Signals an error fails to print JSON. ## bytes->json-object -``` scheme +```scheme (bytes->json-object str) -> json | error bytes := u8vector encoding a UTF-8 string of JSON data @@ -66,7 +66,7 @@ fails to print JSON. Parses given *bytes* and returns JSON object or signals an error if it fails to parse. ## json-object->bytes -``` scheme +```scheme (json-object->bytes obj) -> u8vector | error obj := JSON object @@ -76,7 +76,7 @@ Returns a newly allocated u8vector with JSON object as bytes. Signals an error if it fails to print JSON. ## port->json-object -``` scheme +```scheme (port->json-object port) -> json | error port := input port @@ -84,45 +84,109 @@ Signals an error if it fails to print JSON. Parses data on given *port* and returns JSON object or signals an error if it fails to parse. -## json-symbolic-keys -``` scheme -json-symbolic-keys +## read-json-key-as-symbol? +```scheme +read-json-key-as-symbol? ``` -Boolean parameter to control should decoded hashes have symbols as keys? Defaults to `#t`. -`#f` means that keys will be strings. +Boolean parameter to control whether JSON “objects” be decoded +as using symbols rather than strings as keys? +`#f` the default means strings, `#t` means symbols. + +NB: Before v0.18.2, this parameter used to be called `json-symbolic-keys` and default to `#t`. +The name is still available as an alias (sharing the default `#f`), +but may be removed as early as v0.19. ::: tip Examples -``` scheme +```scheme > (hash->list (string->json-object "{\"a\":1}")) -((a . 1)) +(("a" . 1)) -> (parameterize ((json-symbolic-keys #f)) +> (parameterize ((read-json-key-as-symbol? #t)) (hash->list (string->json-object "{\"a\":1}"))) -(("a" . 1)) +((a . 1)) +``` + +## json-object-walist? +```scheme +json-object-walist? +``` + +Parameter to control how JSON objects should be decoded. +If false (the default), JSON objects will be hash-tables. +If true, JSON objects will be `walistq` +(or `walist` if read-json-key-as-symbol? is false). + +This allows you to preserve the order of keys from JSON text, +in cases where this order matters, e.g. for the sake of +pretty-printing JSON or reading pretty-printed JSON, +where the order will make the data more readable to humans. + +NB: This parameter was introduced in Gerbil v0.18.2. + +::: tip Examples +```scheme +> (parameterize ((json-object-walist? #f)) + (hash->list (string->json-object "{\"a\":1,\"b\":2}"))) +((a . 1) (b . 2)) + +> (parameterize ((json-object-walist? #t)) + (walist->alist (string->json-object "{\"a\":1,\"b\":2}"))) +((a . 1) (b . 2)) ``` -## json-list-wrapper -``` scheme -json-list-wrapper +## read-json-array-as-vector? +```scheme +read-json-array-as-vector? ``` -Parameter to control how JSON lists should be transformed. -Defaults to `identity`, which means keep them as lists. -If bound to `list->vector` then JSON lists will be parsed as vectors. +Parameter to control how JSON “arrays” should be transformed. +Defaults to `#f`, which means keep them as lists. +Binding it to `#t` instead will mean read them as vectors. + +NB: Since Gerbil v0.18.2, this parameter replaces with reduced but more +streamlined functionality the previous `json-list-wrapper` parameter. +That previous parameter isn’t used anymore, and may be removed as early as v0.19. ::: tip Examples -``` scheme -> (string->json-object "[\"a\",1]") -("a" 1) +```scheme +> (string->json-object "[\"a\",1,[]]") +("a" 1 ()) -> (parameterize ((json-list-wrapper list->vector)) +> (parameterize ((read-json-array-as-vector? #t)) (string->json-object "[\"a\",1]")) -#("a" 1) +#("a" 1 ()) +``` + +## write-json-sort-keys? +```scheme +write-json-sort-keys? +``` + +This is a parameter that can be used to control how JSON objects should be written. +If false (the default), keys in JSON objects represented by hash-tables will be written +in no particular predictable order, by iterating as fast as possible through the hash-table. +If true, keys in JSON objects represented by hash-tables will be written in asciibetical order. +In either case, JSON objects represented by walists will be written in the order specified +by the walist. You can sort the walist yourself according to the order that matters to you, +whether asciibetical or not. + +NB: This parameter used to be called `json-sort-keys` and default to `#t` before Gerbil v0.18.2. +The name is still available as an alias (sharing the default `#f`), +but may be removed as early as v0.19. + +::: tip Examples +```scheme +> (parameterize ((write-json-sort-keys? #t)) + (json-object->string (hash (foo 1) (bar 2) (baz 3)))) +"{\"bar\":2,\"baz\":3,\"foo\":1}" +> (parameterize ((write-json-sort-keys? #f)) + (json-object->string (hash (foo 1) (bar 2) (baz 3)))) +"{\"baz\":3,\"bar\":2,\"foo\":1}" ``` ## trivial-class->json-object -``` scheme +```scheme (trivial-class->json-object object) -> json | error object := an object @@ -132,7 +196,7 @@ Extracts a printable JSON object from the slots of an `object`, or signals an error if it fails. ## json-object->trivial-class -``` scheme +```scheme (json-object->trivial-class class-descriptor json) -> object | error class-descriptor := class-descriptor @@ -143,7 +207,7 @@ Creates an object of the class corresponding to the `class-descriptor` by extracting its slots from a `json` hash-table. ## JSON -``` scheme +```scheme JSON -> class JSON::t -> class-descriptor ``` @@ -152,10 +216,21 @@ The default `:json` method is `trivial-class->json-object`. ## pretty-json ```scheme -(pretty-json object [output]) +(pretty-json object [output] + [indent: 2] [sort-keys?: (json-sort-keys)] [lisp-style?: #f]) ``` A function that pretty-prints a JSON `object` to the specified `output` -as per [with-output](../misc/ports.md#with-output) +as per [open-buffered-string-writer](../stdio.md#open-buffered-reader) (defaults to `#f`, i.e. print to string). - -Internally this function uses the external program `jq -M .` to do the pretty-printing. +The `indent` keyword specifies how much to increase indentation at each level of nesting +(must be a positive integer, defaults to 2). +The `sort-keys?` keyword offers a shortcut to parameterizing `write-json-sort-keys?` +which is heeded just like by `write-json`. +The `lisp-style?` keyword if true specifies a format that follows Lisp style, +and saves number of lines by starting objects and lists on the same line as the +square or curly bracket, and closing it on the same line as the last entry, +as opposed to regular style that uses newlines copiously. + +NB: Since Gerbil v0.18.2, this function no longer invokes `jq -M .` as an external program, +and no longer uses `with-output` but instead `open-buffered-string-writer`, +and has extra keyword arguments. diff --git a/src/std/io/interface.ss b/src/std/io/interface.ss index 78642edb8..c93a24997 100644 --- a/src/std/io/interface.ss +++ b/src/std/io/interface.ss @@ -122,7 +122,7 @@ (skip (count :~ nonnegative-fixnum? :- :fixnum)) => :void - ;; returns a new StringBufferedReader instance delimiting the input length that shares + ;; returns a new BufferedStringReader instance delimiting the input length that shares ;; the underlying buffer; the limit must be a fixnum. (delimit (limit :~ nonnegative-fixnum? :- :fixnum)) => @BufferedStringReader diff --git a/src/std/net/json-rpc-test.ss b/src/std/net/json-rpc-test.ss index 1e274e0f7..d9220194a 100644 --- a/src/std/net/json-rpc-test.ss +++ b/src/std/net/json-rpc-test.ss @@ -49,12 +49,14 @@ (test-basic-handlers 'GET) (check-exception (query 42 http-method: 'GET) true)) ;; can't uri-encode number 42 (test-case "encode params" - (check-equal? (json-object->string - (json-rpc-request jsonrpc: json-rpc-version - method: "foo" params: [42 "hello"] id: 13)) - "{\"id\":13,\"jsonrpc\":\"2.0\",\"method\":\"foo\",\"params\":[42,\"hello\"]}")) + (parameterize ((read-json-key-as-symbol? #f) + (write-json-sort-keys? #t)) + (check-equal? (json-object->string + (json-rpc-request jsonrpc: json-rpc-version + method: "foo" params: [42 "hello"] id: 13)) + "{\"id\":13,\"jsonrpc\":\"2.0\",\"method\":\"foo\",\"params\":[42,\"hello\"]}"))) (test-case "decode result" - (parameterize ((json-symbolic-keys #f)) + (parameterize ((read-json-key-as-symbol? #f)) (check-equal? (decode-json-rpc-response 1+ 69 (string->json-object "{\"jsonrpc\": \"2.0\", \"result\": 1776, \"id\": 69}")) 1777))) @@ -66,7 +68,8 @@ ((JSON-RPCError code: -151 message: "foo" data: #!void) #t) (else #f)) => #t)) (test-case "decode errors" - (parameterize ((json-symbolic-keys #f)) + (parameterize ((read-json-key-as-symbol? #f) + (write-json-sort-keys? #t)) (def response-json-1 (string->json-object "{\"jsonrpc\": \"2.0\", \"error\": { \"code\": -151, \"message\": \"foo\", \"data\": [1] }, \"id\": 42 }")) (check-exception (decode-json-rpc-response 1+ 42 response-json-1) diff --git a/src/std/net/json-rpc.ss b/src/std/net/json-rpc.ss index 2d2be6caa..964187f07 100644 --- a/src/std/net/json-rpc.ss +++ b/src/std/net/json-rpc.ss @@ -37,7 +37,7 @@ (only-in :std/net/uri form-url-decode uri-decode) (only-in :std/sugar try catch hash) (only-in :std/text/base64 u8vector->base64-string base64-string->u8vector) - (only-in :std/text/json trivial-json-object->class JSON json-symbolic-keys + (only-in :std/text/json trivial-json-object->class JSON read-json-key-as-symbol? bytes->json-object json-object->bytes json-object->string)) (deferror-class (JSON-RPCError IOError) @@ -124,7 +124,7 @@ class-instance-init!) (def (bytes->json b) ;; Don't intern JSON keys, using strings - (parameterize ((json-symbolic-keys #f)) (bytes->json-object b))) + (parameterize ((read-json-key-as-symbol? #f)) (bytes->json-object b))) ;;; Client code ;; TODO: implement timeouts, with semi-asynchronous shutdown of the http-post thread itself. diff --git a/src/std/text/json/api.ss b/src/std/text/json/api.ss index 43f38614c..fb9bdca76 100644 --- a/src/std/text/json/api.ss +++ b/src/std/text/json/api.ss @@ -5,7 +5,10 @@ (export read-json write-json string->json-object json-object->string bytes->json-object json-object->bytes port->json-object - json-symbolic-keys json-list-wrapper json-sort-keys + read-json-key-as-symbol? read-json-object-as-walist? read-json-array-as-vector? + write-json-sort-keys? + ;; The following line is old names / aliases, TO BE REMOVED as early as v0.19 + json-symbolic-keys json-sort-keys json-list-wrapper ;; <-- TO BE REMOVED trivial-class->json-object trivial-json-object->class trivial-struct->json-object trivial-json-object->struct JSON JSON::t pretty-json) diff --git a/src/std/text/json/env.ss b/src/std/text/json/env.ss index 7a87eceb3..17193b852 100644 --- a/src/std/text/json/env.ss +++ b/src/std/text/json/env.ss @@ -1,33 +1,46 @@ ;;; -*- Gerbil -*- -;;; ̧© vyzo +;;; © vyzo ;;; json io environment (import :std/error :std/sugar) (export #t) -;; should decoded hashes have symbols as keys? -(def json-symbolic-keys - (make-parameter #t)) +;; Should decoded JSON "objects" have symbols as keys rather than strings? +(def read-json-key-as-symbol? + (make-parameter #f)) -;; What should lists be decoded to? identity means a list, list->vector means a vector. -(def json-list-wrapper - (make-parameter identity)) +;; What should JSON "objects" be decoded to walist instead of hash? +(def read-json-object-as-walist? + (make-parameter #f)) + +;; What should JSON "arrays" be decoded to Scheme vectors rather than Scheme list? +(def read-json-array-as-vector? + (make-parameter #f)) ;; Should object keys be sorted when writing json? ;; Checking for duplicate keys only reliably works when this is true. -(def json-sort-keys - (make-parameter #t)) +(def write-json-sort-keys? + (make-parameter #f)) + +;; Old names, to be removed in v0.19. +(def json-symbolic-keys read-json-key-as-symbol?) +(def json-sort-keys write-json-sort-keys?) +(def json-list-wrapper (make-parameter identity)) ;; not used anymore, only there for soft migration -(defstruct env (symbolic-keys sort-keys list-wrapper) +(defstruct env (read-json-key-as-symbol? + read-json-object-as-walist? + read-json-array-as-vector? + write-json-sort-keys?) constructor: :init! - final: #t ) + transparent: #t final: #t) (defmethod {:init! env} (lambda (self) (using (self :- env) - (set! self.symbolic-keys (json-symbolic-keys)) - (set! self.sort-keys (json-sort-keys)) - (set! self.list-wrapper (json-list-wrapper))))) + (set! self.read-json-key-as-symbol? (read-json-key-as-symbol?)) + (set! self.read-json-object-as-walist? (read-json-object-as-walist?)) + (set! self.read-json-array-as-vector? (read-json-array-as-vector?)) + (set! self.write-json-sort-keys? (write-json-sort-keys?))))) (defrule (raise-invalid-token where input char) (if (eof-object? char) diff --git a/src/std/text/json/input.ss b/src/std/text/json/input.ss index cf96345df..135166556 100644 --- a/src/std/text/json/input.ss +++ b/src/std/text/json/input.ss @@ -5,6 +5,8 @@ :std/error :std/sugar :std/io + :std/misc/list + :std/misc/walist :std/text/hex ./env) (export read-json-object/port read-json-object/reader read-json-object/buffer) @@ -45,17 +47,20 @@ (def (read-json-hash input env) (read-char input) - (let (obj (if (&env-symbolic-keys env) - (make-hash-table-eq) - (make-hash-table))) + (let ((obj (if (&env-read-json-key-as-symbol? env) + (make-hash-table-eq) + (make-hash-table))) + (lst '())) (let lp () (let (key (read-json-hash-key input env)) - (if key + (when key ;; If you see a duplicate key, it's as likely an attack as a bug. #LangSec (if (hash-key? obj key) (error "Duplicate hash key in JSON input" key) (let (val (read-json-object input env)) (hash-put! obj key val) + (when (&env-read-json-object-as-walist? env) + (push! (cons key val) lst)) (skip-whitespace input) (let (char (peek-char input)) (case char @@ -63,11 +68,13 @@ (read-char input) (lp)) ((#\}) - (read-char input) - obj) + (read-char input)) (else - (raise-invalid-token read-json-hash input char)))))) - obj))))) + (raise-invalid-token read-json-hash input char))))))))) + (if (&env-read-json-object-as-walist? env) + (let (r (reverse! lst)) + (if (&env-read-json-key-as-symbol? env) (walistq r) (walist r))) + obj))) (def (read-json-hash-key input env) (skip-whitespace input) @@ -80,7 +87,7 @@ (case char ((#\:) (read-char input) - (if (&env-symbolic-keys env) + (if (&env-read-json-key-as-symbol? env) (string->symbol key) key)) (else @@ -97,7 +104,10 @@ (let lp ((tl root)) (let (next (read-json-list-next input env)) (if (eof-object? next) - ((&env-list-wrapper env) (cdr root)) + (let (l (cdr root)) + (if (&env-read-json-array-as-vector? env) + (list->vector l) + l)) (let (tl* [next]) (set! (cdr tl) tl*) (lp tl*))))))) diff --git a/src/std/text/json/json-test.ss b/src/std/text/json/json-test.ss index 92a5ce2e5..a4975ec7b 100644 --- a/src/std/text/json/json-test.ss +++ b/src/std/text/json/json-test.ss @@ -1,10 +1,11 @@ ;;; -*- Gerbil -*- -;;; (C) vyzo at hackzen.org +;;; © vyzo at hackzen.org ;;; :std/text/json unit test (import :std/io :std/misc/walist :std/misc/hash + :std/misc/ports :std/parser/base :std/sugar :std/test @@ -20,13 +21,25 @@ (def (check-encode-decode obj str) (let (eqf (if (hash-table? obj) equal-hash? equal?)) - (parameterize ((json-sort-keys #f)) + (parameterize ((write-json-sort-keys? #f)) (check (string->json-object (json-object->string obj)) => obj :: eqf)) - (parameterize ((json-sort-keys #t)) + (parameterize ((write-json-sort-keys? #t)) (check (json-object->string obj) => str) (check (string->json-object str) => obj :: eqf)))) +(defrule (check-encode-decode/ordered obj str) + (parameterize ((write-json-sort-keys? #f) + (read-json-key-as-symbol? #t) + (read-json-object-as-walist? #t)) + (check (json-object->string obj) => str) + (check (string->json-object str) => obj))) + +(defrule (check-pretty obj str . options) + (let (eqf (if (hash-table? obj) equal-hash? equal?)) + (check (with-output (out #f) (pretty-json obj out . options)) => str) + (check (string->json-object str) => obj :: eqf))) + (def (check-encode-decode= obj) (checkf = (string->json-object (json-object->string obj)) obj)) @@ -51,30 +64,93 @@ .1 .01 1e-3 1e-4 1e-5 1e-6 1e-7 1e-8 1e-9 1e-10)) (check-encode-decode "a string" "\"a string\"") (check-encode-decode [1 2 3 [4 5] ["six" "seven"]] "[1,2,3,[4,5],[\"six\",\"seven\"]]") - (check-encode-decode (hash-eq (a 1) (b 2) (c (hash-eq (d 3) (e 4) (f 5)))) - "{\"a\":1,\"b\":2,\"c\":{\"d\":3,\"e\":4,\"f\":5}}") - (parameterize ((json-symbolic-keys #f)) + (parameterize ((read-json-key-as-symbol? #t)) + (check-encode-decode (hash-eq (a 1) (b 2) (c (hash-eq (d 3) (e 4) (f 5)))) + "{\"a\":1,\"b\":2,\"c\":{\"d\":3,\"e\":4,\"f\":5}}")) + (parameterize ((read-json-key-as-symbol? #f)) (check-encode-decode (hash ("a" 1) ("b" 2) ("c" (hash ("d" 3) ("e" 4) ("f" 5)))) "{\"a\":1,\"b\":2,\"c\":{\"d\":3,\"e\":4,\"f\":5}}")) (check-encode-decode [1 2 #f #t 3] "[1,2,false,true,3]") - (check-encode (walist '((d . 41) (c . 23))) "{\"d\":41,\"c\":23}") - (check (call-with-output-string (cut write-json (foo 23 41) <>)) => "{\"a\":23,\"b\":41}") - (check-exception (string->json-object "true junk") parse-error?)) - + (parameterize ((write-json-sort-keys? #t)) + (check (call-with-output-string (cut write-json (foo 23 41) <>)) => "{\"a\":23,\"b\":41}")) + (check-exception (string->json-object "true junk") parse-error?) + (def my-obj (hash (obj0 (hash)) (l3 [1 2 3]) (obj1 (hash (name "John Doe") (age 33))))) + #;(check-pretty my-obj + "{\"l3\":\n [1,\n 2,\n 3],\n \"obj0\": {},\n \"obj1\":\n {\"age\": 33,\n \"name\": \"John doe\"}}\n" + sort-keys?: #t + lisp-style?: #t) + (parameterize ((write-json-sort-keys? #t) + (read-json-key-as-symbol? #t) + (read-json-object-as-walist? #f)) + (check-pretty my-obj #<)) => str) - (check (call-with-input-string str read-json) => obj :: equal-hash?) + (check (call-with-output-string "" (cut write-json obj <>)) => str) + (check (call-with-input-string str read-json) => obj :: equal-hash?) - (check (do-with-buffered-string-writer (cut write-json obj <>)) => str) - (check (do-with-buffered-string-reader str read-json) => obj :: equal-hash?) + (check (do-with-buffered-string-writer (cut write-json obj <>)) => str) + (check (do-with-buffered-string-reader str read-json) => obj :: equal-hash?) - (check (do-with-buffered-writer (cut write-json obj <>)) => str) - (check (do-with-buffered-reader str read-json) => obj :: equal-hash?)))) + (check (do-with-buffered-writer (cut write-json obj <>)) => str) + (check (do-with-buffered-reader str read-json) => obj :: equal-hash?))))) (def (do-with-buffered-writer proc) (let (buf (open-buffered-writer #f)) diff --git a/src/std/text/json/output.ss b/src/std/text/json/output.ss index 9adaefee0..07f825af4 100644 --- a/src/std/text/json/output.ss +++ b/src/std/text/json/output.ss @@ -9,7 +9,8 @@ :std/sort :std/text/hex ./env) -(export write-json-object/port write-json-object/writer write-json-object/buffer) +(export write-json-object/port write-json-object/writer write-json-object/buffer + json-key-string json-sort-alist) (declare (not safe)) (def (json-key-string key) @@ -139,7 +140,7 @@ (def (write-json-hash obj output env) (def lst (hash->list obj)) - (if (&env-sort-keys env) + (if (&env-write-json-sort-keys? env) (write-json-alist/sort lst output env) (write-json-alist lst output env))) diff --git a/src/std/text/json/util.ss b/src/std/text/json/util.ss index 002cc1eae..73d0080f8 100644 --- a/src/std/text/json/util.ss +++ b/src/std/text/json/util.ss @@ -4,8 +4,10 @@ (import :gerbil/gambit :gerbil/runtime/hash + :std/contract :std/error :std/io + :std/io/strio/types :std/misc/ports :std/misc/process :std/iter @@ -13,6 +15,7 @@ :std/misc/hash :std/misc/list :std/misc/list-builder + :std/misc/number :std/misc/ports :std/misc/plist :std/misc/walist @@ -92,7 +95,7 @@ (def (trivial-struct->json-object struct) (with ([strukt . fields] (struct->list struct)) - (let (f (if (json-symbolic-keys) cons (lambda (slot v) (cons (symbol->string slot) v)))) + (let (f (if (read-json-key-as-symbol?) cons (lambda (slot v) (cons (symbol->string slot) v)))) (walist (map f (cdr (vector->list (class-type-slot-vector strukt))) fields))))) (def (trivial-json-object->struct strukt json (defaults #f)) @@ -133,9 +136,67 @@ (defclass JSON ()) (defmethod {:json JSON} trivial-class->json-object) -(def (pretty-json object (out #f)) - (with-output (out) - (filter-with-process - ["jq" "-M" "."] - (cut write-json object <>) - (cut copy-port <> out)))) +(def (pretty-json object (output (current-output-port)) + indent: (indent :~ fx>0? :- :fixnum := 2) + sort-keys?: (sort-keys? : :boolean := (write-json-sort-keys?)) + lisp-style?: (lisp-style? : :boolean := #f)) + (using (out (open-buffered-string-writer output) : BufferedStringWriter) + (def env (make-env)) + (def (simple? obj) + (or (number? obj) (string? obj) (symbol? obj) (keyword? obj) + (boolean? obj) (void? obj) (null? obj) (equal? obj #()) + (and (hash-table? obj) (zero? (hash-length obj))) + (and (walist? obj) (null? (walist-alist obj))))) + (def (write-value obj indentation) + (cond + ((simple? obj) + (write-json-object/writer obj out env)) + ((list? obj) + (write-list obj indentation)) + ((vector? obj) + (write-list (vector->list obj) indentation)) + ((hash-table? obj) + (let* ((alst (hash->list obj)) + (alst (if (write-json-sort-keys?) (json-sort-alist alst) alst))) + (write-alist alst indentation))) + ((walist? obj) + (write-alist (walist-alist obj) indentation)) + (else + (write-value {:json obj} indentation)))) + (def (write-many write-one open close lst indentation) + (let (new-indentation (+ indentation indent)) + (out.write-char-inline open) + (unless lisp-style? (newline-indent new-indentation)) + (let lp ((l lst)) + (match l + ([e . r] + (write-one e new-indentation) + (unless (null? r) + (out.write-char-inline #\,) + (newline-indent new-indentation) + (lp r))))) + (unless lisp-style? (newline-indent indentation)) + (out.write-char-inline close))) + (def (write-alist alst indentation) + (write-many write-binding #\{ #\} alst indentation)) + (def (write-list list indentation) + (write-many write-value #\[ #\] list indentation)) + (def (space!) (out.write-char-inline #\space)) + (def (newline!) (out.write-char-inline #\newline)) + (def (newline-indent indentation) + (newline!) + (for (_ (in-range indentation)) (space!))) + (def (write-binding binding indentation) + (match binding + ([key . val] + (let (key (json-key-string key)) + (write-json-object/writer key out env) + (out.write-char-inline #\:) + (if (or (not lisp-style?) (simple? val)) + (space!) + (newline-indent (1+ indentation))) + (write-value val indentation))))) + (parameterize ((write-json-sort-keys? sort-keys?)) + (write-value object (if lisp-style? -1 0))) + (newline!) + (unless output (get-buffer-output-string out))))