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