Mercurial > lasercutter
diff 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 |
line wrap: on
line diff
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 1.2 +++ b/src/clojure/contrib/json.clj Sat Aug 21 06:25:44 2010 -0400 1.3 @@ -0,0 +1,341 @@ 1.4 +;;; json.clj: JavaScript Object Notation (JSON) parser/writer 1.5 + 1.6 +;; by Stuart Sierra, http://stuartsierra.com/ 1.7 +;; January 30, 2010 1.8 + 1.9 +;; Copyright (c) Stuart Sierra, 2010. All rights reserved. The use 1.10 +;; and distribution terms for this software are covered by the Eclipse 1.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 1.12 +;; which can be found in the file epl-v10.html at the root of this 1.13 +;; distribution. By using this software in any fashion, you are 1.14 +;; agreeing to be bound by the terms of this license. You must not 1.15 +;; remove this notice, or any other, from this software. 1.16 + 1.17 +(ns ^{:author "Stuart Sierra" 1.18 + :doc "JavaScript Object Notation (JSON) parser/writer. 1.19 + See http://www.json.org/ 1.20 + To write JSON, use json-str, write-json, or write-json. 1.21 + To read JSON, use read-json."} 1.22 + clojure.contrib.json 1.23 + (:use [clojure.contrib.pprint :only (write formatter-out)] 1.24 + [clojure.contrib.string :only (as-str)]) 1.25 + (:import (java.io PrintWriter PushbackReader StringWriter 1.26 + StringReader Reader EOFException))) 1.27 + 1.28 +;;; JSON READER 1.29 + 1.30 +(declare read-json-reader) 1.31 + 1.32 +(defn- read-json-array [^PushbackReader stream keywordize?] 1.33 + ;; Expects to be called with the head of the stream AFTER the 1.34 + ;; opening bracket. 1.35 + (loop [i (.read stream), result (transient [])] 1.36 + (let [c (char i)] 1.37 + (cond 1.38 + (= i -1) (throw (EOFException. "JSON error (end-of-file inside array)")) 1.39 + (Character/isWhitespace c) (recur (.read stream) result) 1.40 + (= c \,) (recur (.read stream) result) 1.41 + (= c \]) (persistent! result) 1.42 + :else (do (.unread stream (int c)) 1.43 + (let [element (read-json-reader stream keywordize? true nil)] 1.44 + (recur (.read stream) (conj! result element)))))))) 1.45 + 1.46 +(defn- read-json-object [^PushbackReader stream keywordize?] 1.47 + ;; Expects to be called with the head of the stream AFTER the 1.48 + ;; opening bracket. 1.49 + (loop [i (.read stream), key nil, result (transient {})] 1.50 + (let [c (char i)] 1.51 + (cond 1.52 + (= i -1) (throw (EOFException. "JSON error (end-of-file inside object)")) 1.53 + 1.54 + (Character/isWhitespace c) (recur (.read stream) key result) 1.55 + 1.56 + (= c \,) (recur (.read stream) nil result) 1.57 + 1.58 + (= c \:) (recur (.read stream) key result) 1.59 + 1.60 + (= c \}) (if (nil? key) 1.61 + (persistent! result) 1.62 + (throw (Exception. "JSON error (key missing value in object)"))) 1.63 + 1.64 + :else (do (.unread stream i) 1.65 + (let [element (read-json-reader stream keywordize? true nil)] 1.66 + (if (nil? key) 1.67 + (if (string? element) 1.68 + (recur (.read stream) element result) 1.69 + (throw (Exception. "JSON error (non-string key in object)"))) 1.70 + (recur (.read stream) nil 1.71 + (assoc! result (if keywordize? (keyword key) key) 1.72 + element))))))))) 1.73 + 1.74 +(defn- read-json-hex-character [^PushbackReader stream] 1.75 + ;; Expects to be called with the head of the stream AFTER the 1.76 + ;; initial "\u". Reads the next four characters from the stream. 1.77 + (let [digits [(.read stream) 1.78 + (.read stream) 1.79 + (.read stream) 1.80 + (.read stream)]] 1.81 + (when (some neg? digits) 1.82 + (throw (EOFException. "JSON error (end-of-file inside Unicode character escape)"))) 1.83 + (let [chars (map char digits)] 1.84 + (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} 1.85 + chars) 1.86 + (throw (Exception. "JSON error (invalid hex character in Unicode character escape)"))) 1.87 + (char (Integer/parseInt (apply str chars) 16))))) 1.88 + 1.89 +(defn- read-json-escaped-character [^PushbackReader stream] 1.90 + ;; Expects to be called with the head of the stream AFTER the 1.91 + ;; initial backslash. 1.92 + (let [c (char (.read stream))] 1.93 + (cond 1.94 + (#{\" \\ \/} c) c 1.95 + (= c \b) \backspace 1.96 + (= c \f) \formfeed 1.97 + (= c \n) \newline 1.98 + (= c \r) \return 1.99 + (= c \t) \tab 1.100 + (= c \u) (read-json-hex-character stream)))) 1.101 + 1.102 +(defn- read-json-quoted-string [^PushbackReader stream] 1.103 + ;; Expects to be called with the head of the stream AFTER the 1.104 + ;; opening quotation mark. 1.105 + (let [buffer (StringBuilder.)] 1.106 + (loop [i (.read stream)] 1.107 + (let [c (char i)] 1.108 + (cond 1.109 + (= i -1) (throw (EOFException. "JSON error (end-of-file inside string)")) 1.110 + (= c \") (str buffer) 1.111 + (= c \\) (do (.append buffer (read-json-escaped-character stream)) 1.112 + (recur (.read stream))) 1.113 + :else (do (.append buffer c) 1.114 + (recur (.read stream)))))))) 1.115 + 1.116 +(defn- read-json-reader 1.117 + ([^PushbackReader stream keywordize? eof-error? eof-value] 1.118 + (loop [i (.read stream)] 1.119 + (let [c (char i)] 1.120 + (cond 1.121 + ;; Handle end-of-stream 1.122 + (= i -1) (if eof-error? 1.123 + (throw (EOFException. "JSON error (end-of-file)")) 1.124 + eof-value) 1.125 + 1.126 + ;; Ignore whitespace 1.127 + (Character/isWhitespace c) (recur (.read stream)) 1.128 + 1.129 + ;; Read numbers, true, and false with Clojure reader 1.130 + (#{\- \0 \1 \2 \3 \4 \5 \6 \7 \8 \9} c) 1.131 + (do (.unread stream i) 1.132 + (read stream true nil)) 1.133 + 1.134 + ;; Read strings 1.135 + (= c \") (read-json-quoted-string stream) 1.136 + 1.137 + ;; Read null as nil 1.138 + (= c \n) (let [ull [(char (.read stream)) 1.139 + (char (.read stream)) 1.140 + (char (.read stream))]] 1.141 + (if (= ull [\u \l \l]) 1.142 + nil 1.143 + (throw (Exception. (str "JSON error (expected null): " c ull))))) 1.144 + 1.145 + ;; Read true 1.146 + (= c \t) (let [rue [(char (.read stream)) 1.147 + (char (.read stream)) 1.148 + (char (.read stream))]] 1.149 + (if (= rue [\r \u \e]) 1.150 + true 1.151 + (throw (Exception. (str "JSON error (expected true): " c rue))))) 1.152 + 1.153 + ;; Read false 1.154 + (= c \f) (let [alse [(char (.read stream)) 1.155 + (char (.read stream)) 1.156 + (char (.read stream)) 1.157 + (char (.read stream))]] 1.158 + (if (= alse [\a \l \s \e]) 1.159 + false 1.160 + (throw (Exception. (str "JSON error (expected false): " c alse))))) 1.161 + 1.162 + ;; Read JSON objects 1.163 + (= c \{) (read-json-object stream keywordize?) 1.164 + 1.165 + ;; Read JSON arrays 1.166 + (= c \[) (read-json-array stream keywordize?) 1.167 + 1.168 + :else (throw (Exception. (str "JSON error (unexpected character): " c)))))))) 1.169 + 1.170 +(defprotocol Read-JSON-From 1.171 + (read-json-from [input keywordize? eof-error? eof-value] 1.172 + "Reads one JSON value from input String or Reader. 1.173 + If keywordize? is true, object keys will be converted to keywords. 1.174 + If eof-error? is true, empty input will throw an EOFException; if 1.175 + false EOF will return eof-value. ")) 1.176 + 1.177 +(extend-protocol 1.178 + Read-JSON-From 1.179 + String 1.180 + (read-json-from [input keywordize? eof-error? eof-value] 1.181 + (read-json-reader (PushbackReader. (StringReader. input)) 1.182 + keywordize? eof-error? eof-value)) 1.183 + PushbackReader 1.184 + (read-json-from [input keywordize? eof-error? eof-value] 1.185 + (read-json-reader input 1.186 + keywordize? eof-error? eof-value)) 1.187 + Reader 1.188 + (read-json-from [input keywordize? eof-error? eof-value] 1.189 + (read-json-reader (PushbackReader. input) 1.190 + keywordize? eof-error? eof-value))) 1.191 + 1.192 +(defn read-json 1.193 + "Reads one JSON value from input String or Reader. 1.194 + If keywordize? is true (default), object keys will be converted to 1.195 + keywords. If eof-error? is true (default), empty input will throw 1.196 + an EOFException; if false EOF will return eof-value. " 1.197 + ([input] 1.198 + (read-json-from input true true nil)) 1.199 + ([input keywordize?] 1.200 + (read-json-from input keywordize? true nil)) 1.201 + ([input keywordize? eof-error? eof-value] 1.202 + (read-json-from input keywordize? eof-error? eof-value))) 1.203 + 1.204 + 1.205 +;;; JSON PRINTER 1.206 + 1.207 +(defprotocol Write-JSON 1.208 + (write-json [object out] 1.209 + "Print object to PrintWriter out as JSON")) 1.210 + 1.211 +(defn- write-json-string [^CharSequence s ^PrintWriter out] 1.212 + (let [sb (StringBuilder. ^Integer (count s))] 1.213 + (.append sb \") 1.214 + (dotimes [i (count s)] 1.215 + (let [cp (Character/codePointAt s i)] 1.216 + (cond 1.217 + ;; Handle printable JSON escapes before ASCII 1.218 + (= cp 34) (.append sb "\\\"") 1.219 + (= cp 92) (.append sb "\\\\") 1.220 + (= cp 47) (.append sb "\\/") 1.221 + ;; Print simple ASCII characters 1.222 + (< 31 cp 127) (.append sb (.charAt s i)) 1.223 + ;; Handle non-printable JSON escapes 1.224 + (= cp 8) (.append sb "\\b") 1.225 + (= cp 12) (.append sb "\\f") 1.226 + (= cp 10) (.append sb "\\n") 1.227 + (= cp 13) (.append sb "\\r") 1.228 + (= cp 9) (.append sb "\\t") 1.229 + ;; Any other character is Hexadecimal-escaped 1.230 + :else (.append sb (format "\\u%04x" cp))))) 1.231 + (.append sb \") 1.232 + (.print out (str sb)))) 1.233 + 1.234 +(defn- write-json-object [m ^PrintWriter out] 1.235 + (.print out \{) 1.236 + (loop [x m] 1.237 + (when (seq m) 1.238 + (let [[k v] (first x)] 1.239 + (when (nil? k) 1.240 + (throw (Exception. "JSON object keys cannot be nil/null"))) 1.241 + (.print out \") 1.242 + (.print out (as-str k)) 1.243 + (.print out \") 1.244 + (.print out \:) 1.245 + (write-json v out)) 1.246 + (let [nxt (next x)] 1.247 + (when (seq nxt) 1.248 + (.print out \,) 1.249 + (recur nxt))))) 1.250 + (.print out \})) 1.251 + 1.252 +(defn- write-json-array [s ^PrintWriter out] 1.253 + (.print out \[) 1.254 + (loop [x s] 1.255 + (when (seq x) 1.256 + (let [fst (first x) 1.257 + nxt (next x)] 1.258 + (write-json fst out) 1.259 + (when (seq nxt) 1.260 + (.print out \,) 1.261 + (recur nxt))))) 1.262 + (.print out \])) 1.263 + 1.264 +(defn- write-json-bignum [x ^PrintWriter out] 1.265 + (.print out (str x))) 1.266 + 1.267 +(defn- write-json-plain [x ^PrintWriter out] 1.268 + (.print out x)) 1.269 + 1.270 +(defn- write-json-null [x ^PrintWriter out] 1.271 + (.print out "null")) 1.272 + 1.273 +(defn- write-json-named [x ^PrintWriter out] 1.274 + (write-json-string (name x) out)) 1.275 + 1.276 +(defn- write-json-generic [x out] 1.277 + (if (.isArray (class x)) 1.278 + (write-json (seq x) out) 1.279 + (throw (Exception. (str "Don't know how to write JSON of " (class x)))))) 1.280 + 1.281 +(extend nil Write-JSON 1.282 + {:write-json write-json-null}) 1.283 +(extend clojure.lang.Named Write-JSON 1.284 + {:write-json write-json-named}) 1.285 +(extend java.lang.Boolean Write-JSON 1.286 + {:write-json write-json-plain}) 1.287 +(extend java.lang.Number Write-JSON 1.288 + {:write-json write-json-plain}) 1.289 +(extend java.math.BigInteger Write-JSON 1.290 + {:write-json write-json-bignum}) 1.291 +(extend java.math.BigDecimal Write-JSON 1.292 + {:write-json write-json-bignum}) 1.293 +(extend java.lang.CharSequence Write-JSON 1.294 + {:write-json write-json-string}) 1.295 +(extend java.util.Map Write-JSON 1.296 + {:write-json write-json-object}) 1.297 +(extend java.util.Collection Write-JSON 1.298 + {:write-json write-json-array}) 1.299 +(extend clojure.lang.ISeq Write-JSON 1.300 + {:write-json write-json-array}) 1.301 +(extend java.lang.Object Write-JSON 1.302 + {:write-json write-json-generic}) 1.303 + 1.304 +(defn json-str 1.305 + "Converts x to a JSON-formatted string." 1.306 + [x] 1.307 + (let [sw (StringWriter.) 1.308 + out (PrintWriter. sw)] 1.309 + (write-json x out) 1.310 + (.toString sw))) 1.311 + 1.312 +(defn print-json 1.313 + "Write JSON-formatted output to *out*" 1.314 + [x] 1.315 + (write-json x *out*)) 1.316 + 1.317 + 1.318 +;;; JSON PRETTY-PRINTER 1.319 + 1.320 +;; Based on code by Tom Faulhaber 1.321 + 1.322 +(defn- pprint-json-array [s] 1.323 + ((formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>") s)) 1.324 + 1.325 +(defn- pprint-json-object [m] 1.326 + ((formatter-out "~<{~;~@{~<~w:~_~w~:>~^, ~_~}~;}~:>") 1.327 + (for [[k v] m] [(as-str k) v]))) 1.328 + 1.329 +(defn- pprint-json-generic [x] 1.330 + (if (.isArray (class x)) 1.331 + (pprint-json-array (seq x)) 1.332 + (print (json-str x)))) 1.333 + 1.334 +(defn- pprint-json-dispatch [x] 1.335 + (cond (nil? x) (print "null") 1.336 + (instance? java.util.Map x) (pprint-json-object x) 1.337 + (instance? java.util.Collection x) (pprint-json-array x) 1.338 + (instance? clojure.lang.ISeq x) (pprint-json-array x) 1.339 + :else (pprint-json-generic x))) 1.340 + 1.341 +(defn pprint-json 1.342 + "Pretty-prints JSON representation of x to *out*" 1.343 + [x] 1.344 + (write x :dispatch pprint-json-dispatch))