summaryrefslogtreecommitdiff
path: root/lib/zambyte
diff options
context:
space:
mode:
Diffstat (limited to 'lib/zambyte')
-rw-r--r--lib/zambyte/meta/180.scm31
-rw-r--r--lib/zambyte/meta/chibi.scm15
-rw-r--r--lib/zambyte/meta/gauche.scm24
-rw-r--r--lib/zambyte/meta/gerbil.scm16
-rw-r--r--lib/zambyte/meta/guile.scm14
-rw-r--r--lib/zambyte/meta/json.sld18
-rw-r--r--lib/zambyte/meta/macduffie.scm14
-rw-r--r--lib/zambyte/meta/sagittarius.scm35
8 files changed, 109 insertions, 58 deletions
diff --git a/lib/zambyte/meta/180.scm b/lib/zambyte/meta/180.scm
index 735a895..71ee1a8 100644
--- a/lib/zambyte/meta/180.scm
+++ b/lib/zambyte/meta/180.scm
@@ -2,17 +2,6 @@
(srfi 1)
(srfi 2))
(begin
- (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 port)
- (get-output-string port))))
-
(define (json-object . pairs)
(map
(lambda (pair)
@@ -25,11 +14,27 @@
(define json-list? vector?)
;; json-null? already defined in srfi 180
+ (define (json-object-contains-key? obj key)
+ (and (assoc (string->symbol key) obj) #t))
+
+ (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 port)
+ (get-output-string port))))
+
(define (json-object-ref json key)
- (and-let* ((pair (assoc (string->symbol key) json)))
- (cdr pair)))
+ (or (and-let* ((pair (assoc (string->symbol key) json)))
+ (cdr pair))
+ ((json-key-not-found))))
(define json-list-ref vector-ref)
+ (define json-list-length vector-length)
(define (json-object->alist json)
(map
diff --git a/lib/zambyte/meta/chibi.scm b/lib/zambyte/meta/chibi.scm
index 49f72f6..fc8e942 100644
--- a/lib/zambyte/meta/chibi.scm
+++ b/lib/zambyte/meta/chibi.scm
@@ -2,9 +2,6 @@
(srfi 1)
(srfi 2))
(begin
- ;; json->string already defined in chibi json
- ;; string->json already defined in chibi json
-
(define (json-object . pairs)
(map
(lambda (pair)
@@ -16,14 +13,22 @@
(define json-object? list?)
(define json-list? vector?)
+ (define (json-object-contains-key? obj key)
+ (and (assoc (string->symbol key) obj) #t))
+
(define (json-null? obj)
(eq? obj json-null))
+ ;; json->string already defined in chibi json
+ ;; string->json already defined in chibi json
+
(define (json-object-ref json key)
- (and-let* ((pair (assoc (string->symbol key) json)))
- (cdr pair)))
+ (or (and-let* ((pair (assoc (string->symbol key) json)))
+ (cdr pair))
+ ((json-key-not-found))))
(define json-list-ref vector-ref)
+ (define json-list-length vector-length)
(define (json-object->alist json)
(map
diff --git a/lib/zambyte/meta/gauche.scm b/lib/zambyte/meta/gauche.scm
index 733599a..3ab2062 100644
--- a/lib/zambyte/meta/gauche.scm
+++ b/lib/zambyte/meta/gauche.scm
@@ -2,6 +2,18 @@
(rfc json)
(srfi 1))
(begin
+ (define json-object list)
+ (define json-list vector)
+ (define json-null 'null)
+ (define json-object? list?)
+ (define json-list? vector?)
+
+ (define (json-null? obj)
+ (eq? obj json-null))
+
+ (define (json-object-contains-key? obj key)
+ (and (assoc key obj) #t))
+
(define array-handler list->vector)
(define object-handler identity)
(define (special-handler x)
@@ -17,16 +29,12 @@
(parse-json-string str)))
(define json->string construct-json-string)
- (define json-object list)
- (define json-list vector)
- (define json-null 'null)
- (define json-object? list?)
- (define json-list? vector?)
- (define (json-null? obj)
- (eq? obj json-null))
+ (define (json-object-ref json key)
+ (or (assoc-ref json key)
+ ((json-key-not-found))))
- (define json-object-ref assoc-ref)
(define json-list-ref vector-ref)
+ (define json-list-length vector-length)
(define json-object->alist identity)
(define json-list->list vector->list))
diff --git a/lib/zambyte/meta/gerbil.scm b/lib/zambyte/meta/gerbil.scm
index 00f7b0e..8d545ef 100644
--- a/lib/zambyte/meta/gerbil.scm
+++ b/lib/zambyte/meta/gerbil.scm
@@ -1,23 +1,29 @@
(import (std text json)
(scheme hash-table))
(begin
- (define string->json string->json-object)
- (define json->string json-object->string)
-
(define (json-object . pairs)
(alist->hash-table pairs equal?))
(define json-list list)
- (define json-null #!void)
+ (define json-null (if #f #f))
(define json-object? hash-table?)
(define json-list? list?)
(define (json-null? obj)
(eq? obj json-null))
+ (define (json-object-contains-key? json key)
+ (hash-table-contains? json key))
+
+ (define string->json string->json-object)
+ (define json->string json-object->string)
+
(define (json-object-ref json key)
- (hash-table-ref json (string->symbol key)))
+ (or (and (json-object-contains-key? json key)
+ (hash-table-ref json key))
+ ((json-key-not-found))))
(define json-list-ref list-ref)
+ (define json-list-length length)
(define json-object->alist hash-table->alist)
(define json-list->list values))
diff --git a/lib/zambyte/meta/guile.scm b/lib/zambyte/meta/guile.scm
index cbd998b..96968d6 100644
--- a/lib/zambyte/meta/guile.scm
+++ b/lib/zambyte/meta/guile.scm
@@ -2,8 +2,6 @@
(srfi 1)
(srfi 2))
(begin
- (define string->json json-string->scm)
- (define json->string scm->json-string)
(define json-object list)
(define json-list vector)
(define json-null 'null)
@@ -13,10 +11,18 @@
(define (json-null? obj)
(eq? obj json-null))
+ (define (json-object-cointains-key? obj key)
+ (and (assoc key obj) #t))
+
+ (define string->json json-string->scm)
+ (define json->string scm->json-string)
+
(define (json-object-ref json key)
- (and-let* ((pair (assoc key json)))
- (cdr pair)))
+ (or (and-let* ((pair (assoc key json)))
+ (cdr pair))
+ ((json-key-not-found))))
(define json-list-ref vector-ref)
+ (define json-list-length vector-length)
(define json-object->alist values)
(define json-list->list vector->list))
diff --git a/lib/zambyte/meta/json.sld b/lib/zambyte/meta/json.sld
index 0313516..58479e8 100644
--- a/lib/zambyte/meta/json.sld
+++ b/lib/zambyte/meta/json.sld
@@ -1,21 +1,25 @@
(define-library (zambyte meta json)
;; portable
(export json-ref
- json-value?)
- ;; non-portable
- (export string->json
- json->string
+ json-value?
- json-object
+ json-key-not-found)
+ ;; non-portable
+ (export json-object
json-list
json-null
json-object?
json-list?
json-null?
+ json-object-contains-key?
+
+ string->json
+ json->string
json-object-ref
json-list-ref
+ json-list-length
json-object->alist
json-list->list)
@@ -36,7 +40,9 @@
(string? obj)
(json-null? obj)
(json-list? obj)
- (json-object? obj))))
+ (json-object? obj)))
+
+ (define json-key-not-found (make-parameter (lambda () (values)))))
;; non-portable
(cond-expand
((and (library (macduffie json)) (srfi 69))
diff --git a/lib/zambyte/meta/macduffie.scm b/lib/zambyte/meta/macduffie.scm
index f80ea18..8a42183 100644
--- a/lib/zambyte/meta/macduffie.scm
+++ b/lib/zambyte/meta/macduffie.scm
@@ -2,9 +2,6 @@
(json-null md:json-null))
(srfi 69))
(begin
- (define string->json json-read-string)
- (define json->string json-write-string)
-
(define (json-object . pairs)
(alist->hash-table pairs))
@@ -13,7 +10,16 @@
(define json-object? hash-table?)
(define json-list? list?)
;; json-null? already defined in macduffie json
- (define json-object-ref hash-table-ref)
+ (define json-object-contains-key? hash-table-exists?)
+ (define string->json json-read-string)
+ (define json->string json-write-string)
+
+ (define (json-object-ref json key)
+ (or (and (hash-table-exists? json key)
+ (hash-table-ref json key))
+ ((json-key-not-found))))
+
(define json-list-ref list-ref)
+ (define json-list-length length)
(define json-object->alist hash-table->alist)
(define json-list->list values))
diff --git a/lib/zambyte/meta/sagittarius.scm b/lib/zambyte/meta/sagittarius.scm
index 3b5a741..97deb0b 100644
--- a/lib/zambyte/meta/sagittarius.scm
+++ b/lib/zambyte/meta/sagittarius.scm
@@ -2,17 +2,6 @@
(srfi 1)
(srfi 2))
(begin
- (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 port)
- (get-output-string port))))
-
(define (json-object . pairs)
(if (eq? (*json-map-type*) 'vector)
(apply vector pairs)
@@ -38,13 +27,33 @@
(define (json-null? obj)
(eq? obj json-null))
+ (define (json-object-contains-key? obj key)
+ (and (assoc key (json-object->alist obj)) #t))
+
+ (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 port)
+ (get-output-string port))))
+
(define (json-object-ref json key)
- (and-let* ((pair (assoc key (json-object->alist json))))
- (cdr pair)))
+ (or (and-let* ((pair (assoc key (json-object->alist json))))
+ (cdr pair))
+ ((json-key-not-found))))
(define (json-list-ref json index)
(list-ref (json-list->list json) index))
+ (define (json-list-length json)
+ (if (eq? (*json-map-type*) 'vector)
+ (length json)
+ (vector-length json)))
+
(define (json-object->alist json)
(if (eq? (*json-map-type*) 'vector)
(vector->list json)