/
jansson.xtm
219 lines (173 loc) · 7.02 KB
/
jansson.xtm
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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
;;; jansson.xtm -- Extempore bindings for the jansson JSON library
;; Author: Ben Swift
;; Keywords: extempore
;; Required dylibs: jansson, ghttp
;;; Commentary:
;; jansson is a library for pulling down and working with JSON data.
;; This Extempore library provides a Extempore bindings, allowing the
;; Extempore to download and use JSON data in Extempore.
;; You'll need to build the jansson library as a shared library to use
;; jansson.xtm
;; On OSX, you can get it through homebrew (brew install jansson) and
;; it should just work
;;; Code:
(if *impc:compiler:with-cache* (sys:load "libs/aot-cache/jansson.xtm" 'quiet))
(sys:load-preload-check 'jansson)
(impc:aot:suppress-aot-do
(sys:load "libs/base/base.xtm"))
(impc:aot:insert-forms (sys:load "libs/base/base.xtm" 'quiet))
(impc:aot:insert-header "xtmjansson")
;; set up the current dylib name and path (for AOT compilation)
(bind-dylib libjansson
(cond ((string=? (sys:platform) "OSX")
"libjansson.dylib")
((string=? (sys:platform) "Linux")
"libjansson.so")
((string=? (sys:platform) "Windows")
"libjansson.dll")))
(define *xtmlib-jansson-loaded* #t)
(impc:aot:import-ll "xtmjansson")
;; the json_type enums
(bind-val JSON_OBJECT enum 0)
(bind-val JSON_ARRAY enum 1)
(bind-val JSON_STRING enum 2)
(bind-val JSON_INTEGER enum 3)
(bind-val JSON_REAL enum 4)
(bind-val JSON_TRUE enum 5)
(bind-val JSON_FALSE enum 6)
(bind-val JSON_NULL enum 7)
;; base type
;; <json_type,refcount>
(bind-type json_t <enum,size_t>)
;; line, column, position, source, text
(bind-type json_error_t <i32,i32,i32,i8*,i8*>)
;; creating JSON objects
(bind-lib libjansson json_object [json_t*]*)
(bind-lib libjansson json_array [json_t*]*)
(bind-lib libjansson json_string [json_t*,i8*]*)
(bind-lib libjansson json_string_nocheck [json_t*,i8*]*)
(bind-lib libjansson json_integer [json_t*,i64]*)
(bind-lib libjansson json_real [json_t*,double]*)
(bind-lib libjansson json_true [json_t*]*)
(bind-lib libjansson json_false [json_t*]*)
(bind-lib libjansson json_null [json_t*]*)
(bind-lib libjansson json_delete [void,json_t*]*)
;; JSON arrays
(bind-lib libjansson json_array_size [size_t,json_t*]*)
(bind-lib libjansson json_array_get [json_t*,json_t*,size_t]*)
(bind-lib libjansson json_array_set_new [i32,json_t*,size_t,json_t*]*)
(bind-lib libjansson json_array_append_new [i32,json_t*,json_t*]*)
(bind-lib libjansson json_array_insert_new [i32,json_t*,size_t,json_t*]*)
(bind-lib libjansson json_array_remove [i32,json_t*,size_t]*)
(bind-lib libjansson json_array_clear [i32,json_t*]*)
(bind-lib libjansson json_array_extend [i32,json_t*,json_t*]*)
;; JSON objects
(bind-lib libjansson json_object_size [size_t,json_t*]*)
(bind-lib libjansson json_object_get [json_t*,json_t*,i8*]*)
(bind-lib libjansson json_object_set_new [i32,json_t*,i8*,json_t*]*)
(bind-lib libjansson json_object_set_new_nocheck [i32,json_t*,i8*,json_t*]*)
(bind-lib libjansson json_object_del [i32,json_t*,i8*]*)
(bind-lib libjansson json_object_clear [i32,json_t*]*)
(bind-lib libjansson json_object_update [i32,json_t*,json_t*]*)
(bind-lib libjansson json_object_update_existing [i32,json_t*,json_t*]*)
(bind-lib libjansson json_object_update_missing [i32,json_t*,json_t*]*)
(bind-lib libjansson json_object_iter [i8*,json_t*]*)
(bind-lib libjansson json_object_iter_next [i8*,json_t*,i8*]*)
(bind-lib libjansson json_object_iter_key [i8*,i8*]*)
(bind-lib libjansson json_object_iter_value [json_t*,i8*]*)
(bind-lib libjansson json_object_iter_set_new [i32,json_t*,i8*,json_t*]*)
;; accessing values
(bind-lib libjansson json_string_value [i8*,json_t*]*)
(bind-lib libjansson json_integer_value [i64,json_t*]*)
(bind-lib libjansson json_real_value [double,json_t*]*)
(bind-lib libjansson json_number_value [double,json_t*]*)
;; setting values
(bind-lib libjansson json_string_set [i32,json_t*,i8*]*)
(bind-lib libjansson json_string_set_nocheck [i32,json_t*,i8*]*)
(bind-lib libjansson json_integer_set [i32,json_t*,i64]*)
(bind-lib libjansson json_real_set [i32,json_t*,double]*)
(bind-lib libjansson json_equal [i32,json_t*,json_t*]*)
;; decoding JSON data
(bind-lib libjansson json_loads [json_t*,i8*,size_t,json_error_t*]*)
(bind-lib libjansson json_loadb [json_t*,i8*,size_t,size_t,json_error_t*]*)
;; print JSON data to string
(bind-lib libjansson json_dumps [i8*,json_t*,size_t]*)
;; incref/decref are defined here in xtlang - in jansson.h they're in the
;; header and inlined (so they don't show up in the shared lib)
(bind-func json_incref
(lambda (json:json_t*)
(if (and (not (null? json))
(<> (tref json 1) -1))
(tset! json 1 (+ (tref json 1) 1)))
json))
(bind-func json_decref
(lambda (json:json_t*)
(if (and (not (null? json))
(<> (tref json 1) -1))
(tset! json 1 (- (tref json 1) 1)))
(if (= (tref json 1) 0)
(json_delete json))
void))
;; overload print function
(bind-func print_json_t
(lambda (json:json_t*)
(let ((s (json_dumps json 4)))
(printf "%s\n" s)
(free s))))
(bind-poly print print_json_t)
;; type functions
(bind-func json_typeof
(lambda (json:json_t*)
(tref json 0)))
(bind-func json_object_p
(lambda (json:json_t*)
(= (json_typeof json) JSON_OBJECT)))
(bind-func json_array_p
(lambda (json:json_t*)
(= (json_typeof json) JSON_ARRAY)))
(bind-func json_string_p
(lambda (json:json_t*)
(= (json_typeof json) JSON_STRING)))
(bind-func json_integer_p
(lambda (json:json_t*)
(= (json_typeof json) JSON_INTEGER)))
(bind-func json_real_p
(lambda (json:json_t*)
(= (json_typeof json) JSON_REAL)))
(bind-func json_true_p
(lambda (json:json_t*)
(= (json_typeof json) JSON_TRUE)))
(bind-func json_false_p
(lambda (json:json_t*)
(= (json_typeof json) JSON_FALSE)))
(bind-func json_null_p
(lambda (json:json_t*)
(= (json_typeof json) JSON_NULL)))
(bind-func json_print_type
(lambda (json:json_t*)
(let ((type (tref json 0)))
(cond ((= type JSON_OBJECT) (printf "JSON type: %s\n" "object"))
((= type JSON_ARRAY) (printf "JSON type: %s\n" "array"))
((= type JSON_STRING) (printf "JSON type: %s\n" "string"))
((= type JSON_INTEGER) (printf "JSON type: %s\n" "integer"))
((= type JSON_REAL) (printf "JSON type: %s\n" "real"))
((= type JSON_TRUE) (printf "JSON type: %s\n" "true"))
((= type JSON_FALSE) (printf "JSON type: %s\n" "false"))
((= type JSON_NULL) (printf "JSON type: %s\n" "null"))
(else (printf "JSON error: unsupported type.\n")))
(i64toi32 0))))
;; iterators
(bind-func json_obj_iterator
(lambda (object:json_t* iter:i8*)
(if (null? iter)
0
(begin (printf "%s\n" (json_object_iter_key iter))
(json_obj_iterator object (json_object_iter_next object iter))))))
(bind-func json_object_print_keys
(lambda (object:json_t*)
(if (json_object_p object)
(json_obj_iterator object (json_object_iter object))
(begin (printf "Error: argument is not a JSON object.%\n") 0))
0))
(define *xtmlib-jansson-loaded* #t)
(impc:aot:insert-footer "xtmjansson")