summaryrefslogtreecommitdiff
path: root/lib/zambyte
diff options
context:
space:
mode:
Diffstat (limited to 'lib/zambyte')
-rw-r--r--lib/zambyte/meta/180.scm68
-rw-r--r--lib/zambyte/meta/chibi.scm2
2 files changed, 60 insertions, 10 deletions
diff --git a/lib/zambyte/meta/180.scm b/lib/zambyte/meta/180.scm
index 30c0c74..832e3e2 100644
--- a/lib/zambyte/meta/180.scm
+++ b/lib/zambyte/meta/180.scm
@@ -1,15 +1,25 @@
(import (except (srfi 180) json-null)
- (srfi 1))
+ (scheme case-lambda)
+ (srfi 1)
+ (srfi 2))
(begin
(define json-object list)
(define json-list vector)
(define json-null 'null)
- (define json-object? list?)
+
+ (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)
- (and (assoc key obj) #t))
+ (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)
@@ -19,16 +29,56 @@
(define (json->string json)
(call-with-port (open-output-string)
(lambda (port)
- (json-write json port)
+ (json-write (json->typeless-json json) port)
(get-output-string port))))
(define (json-object-ref json key)
- (let ((pair (assoc key json)))
- (if pair
- (cdr pair)
- ((json-key-not-found)))))
+ (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->alist values)
+
+ (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))
diff --git a/lib/zambyte/meta/chibi.scm b/lib/zambyte/meta/chibi.scm
index 856e1b8..3ce8192 100644
--- a/lib/zambyte/meta/chibi.scm
+++ b/lib/zambyte/meta/chibi.scm
@@ -46,7 +46,7 @@
(set-cdr! (assoc key json) value)
json)
((null? json)
- (error "json-object-set!: cannot set on an empty object" json))
+ (json-object (cons key value)))
((list? json)
(append! json (list (cons key value))))
((json-record? json)