(import (except (srfi 180) json-null) (scheme case-lambda) (srfi 1) (srfi 2)) (begin (define json-object list) (define json-list vector) (define json-null 'null) (define (json-object? j) (or (list? j) (json-record? j))) (define json-list? vector?) ;; json-null? already defined in srfi 180 (define (json-object-contains-key? obj key) (or (and (list? obj) (assoc key obj) #t) (and (json-record? obj) (json-object-contains-key? (json-record->fields obj) key)))) (define (string->json str) (call-with-port (open-input-string str) (lambda (port) (json-read port)))) (define (json->string json) (call-with-port (open-output-string) (lambda (port) (json-write (json->typeless-json json) port) (get-output-string port)))) (define (json-object-ref json key) (cond ((list? json) (let ((pair (assoc key json))) (if pair (cdr pair) ((json-key-not-found))))) ((json-record? json) (json-object-ref (json-record->fields json) key)) (else ((key-not-found))))) (define (json-object-set! json key value) (cond ((and (list? json) (json-object-contains-key? json key)) (json-object-map (lambda (k v) (if (eq? k key) (values k value) (values k v))) json)) ((null? json) (json-object (cons key value))) ((list? json) (append! json (list (cons key value)))) ((json-record? json) (or (and-let* ((pair (assoc key (json-record->mutators json))) (mutator (cdr pair))) (mutator json value)) (error "json-object-set!: no mutator for field" (json-record->name json) key))))) (define json-list-ref vector-ref) (define json-list-length vector-length) (define (json-object-map proc json) (map (lambda (pair) (call-with-values (lambda () (proc (car pair) (cdr pair))) (case-lambda ((key value) (cons key value)) (_ (error "json-object-map: proc did not return two values"))))) json)) (define json-list-map vector-map) (define (json-object->alist obj) (cond ((list? obj) obj) ((json-record? obj) (json-record->fields obj)) (else (error "json-object->alist: not an object" obj)))) (define json-list->list vector->list))