blob: 8838c779e8a45f7f85b920acfc4ad5ade5b34f46 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
(define-library (zambyte meta json)
;; portable
(export json
json-ref
json-value?
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)
(import (scheme base))
;; portable
(begin
(define-syntax json
(syntax-rules (object list null true false)
((_ (object (key . value) ...))
(json-object `(key . ,(json value)) ...))
((_ (list vs ...))
(json-list (json vs) ...))
((_ null) json-null)
((_ true) #t)
((_ false) #f)
((_ value)
(if (json-value? value)
value
(error "json: not a json value" value)))))
(define (json-ref json key . keys)
(let ((ref (cond ((json-object? json) json-object-ref)
((json-list? json) json-list-ref)
(else (error "json-ref: cannot get reference on json value" json)))))
(if (null? keys)
(ref json key)
(apply json-ref (ref json key) keys))))
(define (json-value? obj)
(or (boolean? obj)
(number? obj)
(string? obj)
(json-null? obj)
(json-list? obj)
(json-object? obj)))
(define json-key-not-found (make-parameter (lambda () (values)))))
;; non-portable
(cond-expand
((and (library (macduffie json)) (srfi 69))
(include-library-declarations "macduffie.scm"))
((and guile (library (json)))
(import (only (guile) include-from-path import))
(begin (include-from-path "zambyte/meta/guile.scm")))
(gauche
(include-library-declarations "gauche.scm"))
(gerbil
(include-library-declarations "gerbil.scm"))
(sagittarius
(include-library-declarations "sagittarius.scm"))
((library (chibi json))
(include-library-declarations "chibi.scm"))
((library (srfi 180))
(include-library-declarations "180.scm"))
(else
(error "No implementation of JSON library available."))))
|
