(import (json) (scheme case-lambda) (srfi 1) (srfi 2)) (begin (define (json-object . pairs) (map (lambda (pair) (cons (symbol->string (car pair)) (cdr pair))) pairs)) (define json-list vector) (define json-null 'null) (define (json-object? obj) (or (list? obj) (json-record? obj))) (define json-list? vector?) (define (json-null? obj) (eq? obj json-null)) (define (json-object-contains-key? obj key) (or (and (list? obj) (assoc (symbol->string key) obj) #t) (and (json-record? obj) (json-object-contains-key? (json-record->fields obj) key)))) (define string->json json-string->scm) (define (json->string obj) (scm->json-string (json->typeless-json obj))) (define (json-object-ref json key) (cond ((list? json) (let ((pair (assoc (symbol->string key) json))) (if pair (cdr pair) ((json-key-not-found))))) ((json-record? json) (json-object-ref (json-record->fields json) key)) (else ((json-key-not-found))))) (define (json-object-set! json key value) (cond ((and (list? json) (json-object-contains-key? json key)) (set-cdr! (assoc (symbol->string key) json) value) json) ((null? json) (json-object (cons key value))) ((list? json) (append! json (list (cons (symbol->string key) value)))) ((json-record? json) (or (and-let* ((pair (assoc key (json-record->mutators json))) (mutator (cdr pair))) (mutator json value) json) (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 (string->symbol (car pair)) (cdr pair))) (case-lambda ((key value) (cons (symbol->string key) value)) (_ (error "json-object-map: proc did not return two values"))))) json)) (define json-list-map vector-map) (define (json-object->alist json) (cond ((list? json) (map (lambda (pair) (cons (string->symbol (car pair)) (cdr pair))) json)) ((json-record? json) (json-record->fields json)) (else (error "json-object->alist: not an object" json)))) (define json-list->list vector->list))