Mercurial > lasercutter
comparison src/clojure/contrib/json.clj @ 10:ef7dbbd6452c
added clojure source goodness
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 21 Aug 2010 06:25:44 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
9:35cf337adfcf | 10:ef7dbbd6452c |
---|---|
1 ;;; json.clj: JavaScript Object Notation (JSON) parser/writer | |
2 | |
3 ;; by Stuart Sierra, http://stuartsierra.com/ | |
4 ;; January 30, 2010 | |
5 | |
6 ;; Copyright (c) Stuart Sierra, 2010. All rights reserved. The use | |
7 ;; and distribution terms for this software are covered by the Eclipse | |
8 ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) | |
9 ;; which can be found in the file epl-v10.html at the root of this | |
10 ;; distribution. By using this software in any fashion, you are | |
11 ;; agreeing to be bound by the terms of this license. You must not | |
12 ;; remove this notice, or any other, from this software. | |
13 | |
14 (ns ^{:author "Stuart Sierra" | |
15 :doc "JavaScript Object Notation (JSON) parser/writer. | |
16 See http://www.json.org/ | |
17 To write JSON, use json-str, write-json, or write-json. | |
18 To read JSON, use read-json."} | |
19 clojure.contrib.json | |
20 (:use [clojure.contrib.pprint :only (write formatter-out)] | |
21 [clojure.contrib.string :only (as-str)]) | |
22 (:import (java.io PrintWriter PushbackReader StringWriter | |
23 StringReader Reader EOFException))) | |
24 | |
25 ;;; JSON READER | |
26 | |
27 (declare read-json-reader) | |
28 | |
29 (defn- read-json-array [^PushbackReader stream keywordize?] | |
30 ;; Expects to be called with the head of the stream AFTER the | |
31 ;; opening bracket. | |
32 (loop [i (.read stream), result (transient [])] | |
33 (let [c (char i)] | |
34 (cond | |
35 (= i -1) (throw (EOFException. "JSON error (end-of-file inside array)")) | |
36 (Character/isWhitespace c) (recur (.read stream) result) | |
37 (= c \,) (recur (.read stream) result) | |
38 (= c \]) (persistent! result) | |
39 :else (do (.unread stream (int c)) | |
40 (let [element (read-json-reader stream keywordize? true nil)] | |
41 (recur (.read stream) (conj! result element)))))))) | |
42 | |
43 (defn- read-json-object [^PushbackReader stream keywordize?] | |
44 ;; Expects to be called with the head of the stream AFTER the | |
45 ;; opening bracket. | |
46 (loop [i (.read stream), key nil, result (transient {})] | |
47 (let [c (char i)] | |
48 (cond | |
49 (= i -1) (throw (EOFException. "JSON error (end-of-file inside object)")) | |
50 | |
51 (Character/isWhitespace c) (recur (.read stream) key result) | |
52 | |
53 (= c \,) (recur (.read stream) nil result) | |
54 | |
55 (= c \:) (recur (.read stream) key result) | |
56 | |
57 (= c \}) (if (nil? key) | |
58 (persistent! result) | |
59 (throw (Exception. "JSON error (key missing value in object)"))) | |
60 | |
61 :else (do (.unread stream i) | |
62 (let [element (read-json-reader stream keywordize? true nil)] | |
63 (if (nil? key) | |
64 (if (string? element) | |
65 (recur (.read stream) element result) | |
66 (throw (Exception. "JSON error (non-string key in object)"))) | |
67 (recur (.read stream) nil | |
68 (assoc! result (if keywordize? (keyword key) key) | |
69 element))))))))) | |
70 | |
71 (defn- read-json-hex-character [^PushbackReader stream] | |
72 ;; Expects to be called with the head of the stream AFTER the | |
73 ;; initial "\u". Reads the next four characters from the stream. | |
74 (let [digits [(.read stream) | |
75 (.read stream) | |
76 (.read stream) | |
77 (.read stream)]] | |
78 (when (some neg? digits) | |
79 (throw (EOFException. "JSON error (end-of-file inside Unicode character escape)"))) | |
80 (let [chars (map char digits)] | |
81 (when-not (every? #{\0 \1 \2 \3 \4 \5 \6 \7 \8 \9 \a \b \c \d \e \f \A \B \C \D \E \F} | |
82 chars) | |
83 (throw (Exception. "JSON error (invalid hex character in Unicode character escape)"))) | |
84 (char (Integer/parseInt (apply str chars) 16))))) | |
85 | |
86 (defn- read-json-escaped-character [^PushbackReader stream] | |
87 ;; Expects to be called with the head of the stream AFTER the | |
88 ;; initial backslash. | |
89 (let [c (char (.read stream))] | |
90 (cond | |
91 (#{\" \\ \/} c) c | |
92 (= c \b) \backspace | |
93 (= c \f) \formfeed | |
94 (= c \n) \newline | |
95 (= c \r) \return | |
96 (= c \t) \tab | |
97 (= c \u) (read-json-hex-character stream)))) | |
98 | |
99 (defn- read-json-quoted-string [^PushbackReader stream] | |
100 ;; Expects to be called with the head of the stream AFTER the | |
101 ;; opening quotation mark. | |
102 (let [buffer (StringBuilder.)] | |
103 (loop [i (.read stream)] | |
104 (let [c (char i)] | |
105 (cond | |
106 (= i -1) (throw (EOFException. "JSON error (end-of-file inside string)")) | |
107 (= c \") (str buffer) | |
108 (= c \\) (do (.append buffer (read-json-escaped-character stream)) | |
109 (recur (.read stream))) | |
110 :else (do (.append buffer c) | |
111 (recur (.read stream)))))))) | |
112 | |
113 (defn- read-json-reader | |
114 ([^PushbackReader stream keywordize? eof-error? eof-value] | |
115 (loop [i (.read stream)] | |
116 (let [c (char i)] | |
117 (cond | |
118 ;; Handle end-of-stream | |
119 (= i -1) (if eof-error? | |
120 (throw (EOFException. "JSON error (end-of-file)")) | |
121 eof-value) | |
122 | |
123 ;; Ignore whitespace | |
124 (Character/isWhitespace c) (recur (.read stream)) | |
125 | |
126 ;; Read numbers, true, and false with Clojure reader | |
127 (#{\- \0 \1 \2 \3 \4 \5 \6 \7 \8 \9} c) | |
128 (do (.unread stream i) | |
129 (read stream true nil)) | |
130 | |
131 ;; Read strings | |
132 (= c \") (read-json-quoted-string stream) | |
133 | |
134 ;; Read null as nil | |
135 (= c \n) (let [ull [(char (.read stream)) | |
136 (char (.read stream)) | |
137 (char (.read stream))]] | |
138 (if (= ull [\u \l \l]) | |
139 nil | |
140 (throw (Exception. (str "JSON error (expected null): " c ull))))) | |
141 | |
142 ;; Read true | |
143 (= c \t) (let [rue [(char (.read stream)) | |
144 (char (.read stream)) | |
145 (char (.read stream))]] | |
146 (if (= rue [\r \u \e]) | |
147 true | |
148 (throw (Exception. (str "JSON error (expected true): " c rue))))) | |
149 | |
150 ;; Read false | |
151 (= c \f) (let [alse [(char (.read stream)) | |
152 (char (.read stream)) | |
153 (char (.read stream)) | |
154 (char (.read stream))]] | |
155 (if (= alse [\a \l \s \e]) | |
156 false | |
157 (throw (Exception. (str "JSON error (expected false): " c alse))))) | |
158 | |
159 ;; Read JSON objects | |
160 (= c \{) (read-json-object stream keywordize?) | |
161 | |
162 ;; Read JSON arrays | |
163 (= c \[) (read-json-array stream keywordize?) | |
164 | |
165 :else (throw (Exception. (str "JSON error (unexpected character): " c)))))))) | |
166 | |
167 (defprotocol Read-JSON-From | |
168 (read-json-from [input keywordize? eof-error? eof-value] | |
169 "Reads one JSON value from input String or Reader. | |
170 If keywordize? is true, object keys will be converted to keywords. | |
171 If eof-error? is true, empty input will throw an EOFException; if | |
172 false EOF will return eof-value. ")) | |
173 | |
174 (extend-protocol | |
175 Read-JSON-From | |
176 String | |
177 (read-json-from [input keywordize? eof-error? eof-value] | |
178 (read-json-reader (PushbackReader. (StringReader. input)) | |
179 keywordize? eof-error? eof-value)) | |
180 PushbackReader | |
181 (read-json-from [input keywordize? eof-error? eof-value] | |
182 (read-json-reader input | |
183 keywordize? eof-error? eof-value)) | |
184 Reader | |
185 (read-json-from [input keywordize? eof-error? eof-value] | |
186 (read-json-reader (PushbackReader. input) | |
187 keywordize? eof-error? eof-value))) | |
188 | |
189 (defn read-json | |
190 "Reads one JSON value from input String or Reader. | |
191 If keywordize? is true (default), object keys will be converted to | |
192 keywords. If eof-error? is true (default), empty input will throw | |
193 an EOFException; if false EOF will return eof-value. " | |
194 ([input] | |
195 (read-json-from input true true nil)) | |
196 ([input keywordize?] | |
197 (read-json-from input keywordize? true nil)) | |
198 ([input keywordize? eof-error? eof-value] | |
199 (read-json-from input keywordize? eof-error? eof-value))) | |
200 | |
201 | |
202 ;;; JSON PRINTER | |
203 | |
204 (defprotocol Write-JSON | |
205 (write-json [object out] | |
206 "Print object to PrintWriter out as JSON")) | |
207 | |
208 (defn- write-json-string [^CharSequence s ^PrintWriter out] | |
209 (let [sb (StringBuilder. ^Integer (count s))] | |
210 (.append sb \") | |
211 (dotimes [i (count s)] | |
212 (let [cp (Character/codePointAt s i)] | |
213 (cond | |
214 ;; Handle printable JSON escapes before ASCII | |
215 (= cp 34) (.append sb "\\\"") | |
216 (= cp 92) (.append sb "\\\\") | |
217 (= cp 47) (.append sb "\\/") | |
218 ;; Print simple ASCII characters | |
219 (< 31 cp 127) (.append sb (.charAt s i)) | |
220 ;; Handle non-printable JSON escapes | |
221 (= cp 8) (.append sb "\\b") | |
222 (= cp 12) (.append sb "\\f") | |
223 (= cp 10) (.append sb "\\n") | |
224 (= cp 13) (.append sb "\\r") | |
225 (= cp 9) (.append sb "\\t") | |
226 ;; Any other character is Hexadecimal-escaped | |
227 :else (.append sb (format "\\u%04x" cp))))) | |
228 (.append sb \") | |
229 (.print out (str sb)))) | |
230 | |
231 (defn- write-json-object [m ^PrintWriter out] | |
232 (.print out \{) | |
233 (loop [x m] | |
234 (when (seq m) | |
235 (let [[k v] (first x)] | |
236 (when (nil? k) | |
237 (throw (Exception. "JSON object keys cannot be nil/null"))) | |
238 (.print out \") | |
239 (.print out (as-str k)) | |
240 (.print out \") | |
241 (.print out \:) | |
242 (write-json v out)) | |
243 (let [nxt (next x)] | |
244 (when (seq nxt) | |
245 (.print out \,) | |
246 (recur nxt))))) | |
247 (.print out \})) | |
248 | |
249 (defn- write-json-array [s ^PrintWriter out] | |
250 (.print out \[) | |
251 (loop [x s] | |
252 (when (seq x) | |
253 (let [fst (first x) | |
254 nxt (next x)] | |
255 (write-json fst out) | |
256 (when (seq nxt) | |
257 (.print out \,) | |
258 (recur nxt))))) | |
259 (.print out \])) | |
260 | |
261 (defn- write-json-bignum [x ^PrintWriter out] | |
262 (.print out (str x))) | |
263 | |
264 (defn- write-json-plain [x ^PrintWriter out] | |
265 (.print out x)) | |
266 | |
267 (defn- write-json-null [x ^PrintWriter out] | |
268 (.print out "null")) | |
269 | |
270 (defn- write-json-named [x ^PrintWriter out] | |
271 (write-json-string (name x) out)) | |
272 | |
273 (defn- write-json-generic [x out] | |
274 (if (.isArray (class x)) | |
275 (write-json (seq x) out) | |
276 (throw (Exception. (str "Don't know how to write JSON of " (class x)))))) | |
277 | |
278 (extend nil Write-JSON | |
279 {:write-json write-json-null}) | |
280 (extend clojure.lang.Named Write-JSON | |
281 {:write-json write-json-named}) | |
282 (extend java.lang.Boolean Write-JSON | |
283 {:write-json write-json-plain}) | |
284 (extend java.lang.Number Write-JSON | |
285 {:write-json write-json-plain}) | |
286 (extend java.math.BigInteger Write-JSON | |
287 {:write-json write-json-bignum}) | |
288 (extend java.math.BigDecimal Write-JSON | |
289 {:write-json write-json-bignum}) | |
290 (extend java.lang.CharSequence Write-JSON | |
291 {:write-json write-json-string}) | |
292 (extend java.util.Map Write-JSON | |
293 {:write-json write-json-object}) | |
294 (extend java.util.Collection Write-JSON | |
295 {:write-json write-json-array}) | |
296 (extend clojure.lang.ISeq Write-JSON | |
297 {:write-json write-json-array}) | |
298 (extend java.lang.Object Write-JSON | |
299 {:write-json write-json-generic}) | |
300 | |
301 (defn json-str | |
302 "Converts x to a JSON-formatted string." | |
303 [x] | |
304 (let [sw (StringWriter.) | |
305 out (PrintWriter. sw)] | |
306 (write-json x out) | |
307 (.toString sw))) | |
308 | |
309 (defn print-json | |
310 "Write JSON-formatted output to *out*" | |
311 [x] | |
312 (write-json x *out*)) | |
313 | |
314 | |
315 ;;; JSON PRETTY-PRINTER | |
316 | |
317 ;; Based on code by Tom Faulhaber | |
318 | |
319 (defn- pprint-json-array [s] | |
320 ((formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>") s)) | |
321 | |
322 (defn- pprint-json-object [m] | |
323 ((formatter-out "~<{~;~@{~<~w:~_~w~:>~^, ~_~}~;}~:>") | |
324 (for [[k v] m] [(as-str k) v]))) | |
325 | |
326 (defn- pprint-json-generic [x] | |
327 (if (.isArray (class x)) | |
328 (pprint-json-array (seq x)) | |
329 (print (json-str x)))) | |
330 | |
331 (defn- pprint-json-dispatch [x] | |
332 (cond (nil? x) (print "null") | |
333 (instance? java.util.Map x) (pprint-json-object x) | |
334 (instance? java.util.Collection x) (pprint-json-array x) | |
335 (instance? clojure.lang.ISeq x) (pprint-json-array x) | |
336 :else (pprint-json-generic x))) | |
337 | |
338 (defn pprint-json | |
339 "Pretty-prints JSON representation of x to *out*" | |
340 [x] | |
341 (write x :dispatch pprint-json-dispatch)) |