Add c.c.json; replacement for c.c.json.read & c.c.json.write

 * New library uses protocols.
 * read-json accepts any String or Reader.
 * read-json keywordizes keys by default.

src/main/clojure/clojure/contrib/json.clj

@@ -0,0 +1,305 @@
+;;; json.clj: JavaScript Object Notation (JSON) parser/writer
+
+;; by Stuart Sierra, http://stuartsierra.com/
+;; January 30, 2010
+
+;; Copyright (c) Stuart Sierra, 2010. All rights reserved.  The use
+;; and distribution terms for this software are covered by the Eclipse
+;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this
+;; distribution.  By using this software in any fashion, you are
+;; agreeing to be bound by the terms of this license.  You must not
+;; remove this notice, or any other, from this software.
+
+
+(ns #^{:author "Stuart Sierra"
+       :doc "JavaScript Object Notation (JSON) parser/writer.
+  See http://www.json.org/
+  To write JSON, use json-str, write-json, or print-json.
+  To read JSON, use read-json."}
+    clojure.contrib.json
+  (:require [clojure.contrib.java-utils :as j])
+  (:import (java.io PushbackReader StringReader Reader EOFException)))
+
+(declare read-json-reader)
+
+(defn- read-json-array [#^PushbackReader stream keywordize?]
+  ;; Expects to be called with the head of the stream AFTER the
+  ;; opening bracket.
+  (loop [i (.read stream), result (transient [])]
+    (let [c (char i)]
+      (cond
+       (= i -1) (throw (EOFException. "JSON error (end-of-file inside array)"))
+       (Character/isWhitespace c) (recur (.read stream) result)
+       (= c \,) (recur (.read stream) result)
+       (= c \]) (persistent! result)
+       :else (do (.unread stream (int c))
+                 (let [element (read-json-reader stream keywordize? true nil)]
+                   (recur (.read stream) (conj! result element))))))))
+
+(defn- read-json-object [#^PushbackReader stream keywordize?]
+  ;; Expects to be called with the head of the stream AFTER the
+  ;; opening bracket.
+  (loop [i (.read stream), key nil, result (transient {})]
+    (let [c (char i)]
+      (cond
+       (= i -1) (throw (EOFException. "JSON error (end-of-file inside object)"))
+
+       (Character/isWhitespace c) (recur (.read stream) key result)
+
+       (= c \,) (recur (.read stream) nil result)
+
+       (= c \:) (recur (.read stream) key result)
+
+       (= c \}) (if (nil? key)
+                  (persistent! result)
+                  (throw (Exception. "JSON error (key missing value in object)")))
+
+       :else (do (.unread stream i)
+                 (let [element (read-json-reader stream keywordize? true nil)]
+                   (if (nil? key)
+                     (if (string? element)
+                       (recur (.read stream) element result)
+                       (throw (Exception. "JSON error (non-string key in object)")))
+                     (recur (.read stream) nil
+                            (assoc! result (if keywordize? (keyword key) key)
+                                    element)))))))))
+
+(defn- read-json-hex-character [#^PushbackReader stream]
+  ;; Expects to be called with the head of the stream AFTER the
+  ;; initial "\u".  Reads the next four characters from the stream.
+  (let [digits [(.read stream)
+                (.read stream)
+                (.read stream)
+                (.read stream)]]
+    (when (some neg? digits)
+      (throw (EOFException. "JSON error (end-of-file inside Unicode character escape)")))
+    (let [chars (map char digits)]
+      (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}
+                        chars)
+        (throw (Exception. "JSON error (invalid hex character in Unicode character escape)")))
+      (char (Integer/parseInt (apply str chars) 16)))))
+
+(defn- read-json-escaped-character [#^PushbackReader stream]
+  ;; Expects to be called with the head of the stream AFTER the
+  ;; initial backslash.
+  (let [c (char (.read stream))]
+    (cond
+     (#{\" \\ \/} c) c
+     (= c \b) \backspace
+     (= c \f) \formfeed
+     (= c \n) \newline
+     (= c \r) \return
+     (= c \t) \tab
+     (= c \u) (read-json-hex-character stream))))
+
+(defn- read-json-quoted-string [#^PushbackReader stream]
+  ;; Expects to be called with the head of the stream AFTER the
+  ;; opening quotation mark.
+  (let [buffer (StringBuilder.)]
+    (loop [i (.read stream)]
+      (let [c (char i)]
+        (cond
+         (= i -1) (throw (EOFException. "JSON error (end-of-file inside string)"))
+         (= c \") (str buffer)
+         (= c \\) (do (.append buffer (read-json-escaped-character stream))
+                      (recur (.read stream)))
+         :else (do (.append buffer c)
+                   (recur (.read stream))))))))
+
+(defn read-json-reader
+  ([#^PushbackReader stream keywordize? eof-error? eof-value]
+     (loop [i (.read stream)]
+       (let [c (char i)]
+         (cond
+          ;; Handle end-of-stream
+          (= i -1) (if eof-error?
+                     (throw (EOFException. "JSON error (end-of-file)"))
+                     eof-value)
+
+          ;; Ignore whitespace
+          (Character/isWhitespace c) (recur (.read stream))
+
+          ;; Read numbers, true, and false with Clojure reader
+          (#{\- \0 \1 \2 \3 \4 \5 \6 \7 \8 \9} c)
+          (do (.unread stream i)
+              (read stream true nil))
+
+          ;; Read strings
+          (= c \") (read-json-quoted-string stream)
+
+          ;; Read null as nil
+          (= c \n) (let [ull [(char (.read stream))
+                              (char (.read stream))
+                              (char (.read stream))]]
+                     (if (= ull [\u \l \l])
+                       nil
+                       (throw (Exception. (str "JSON error (expected null): " c ull)))))
+
+          ;; Read true
+          (= c \t) (let [rue [(char (.read stream))
+                              (char (.read stream))
+                              (char (.read stream))]]
+                     (if (= rue [\r \u \e])
+                       true
+                       (throw (Exception. (str "JSON error (expected true): " c rue)))))
+
+          ;; Read false
+          (= c \f) (let [alse [(char (.read stream))
+                               (char (.read stream))
+                               (char (.read stream))
+                               (char (.read stream))]]
+                     (if (= alse [\a \l \s \e])
+                       false
+                       (throw (Exception. (str "JSON error (expected false): " c alse)))))
+
+          ;; Read JSON objects
+          (= c \{) (read-json-object stream keywordize?)
+
+          ;; Read JSON arrays
+          (= c \[) (read-json-array stream keywordize?)
+
+          :else (throw (Exception. (str "JSON error (unexpected character): " c))))))))
+
+(defprotocol Read-JSON-From
+  (read-json-from [input keywordize? eof-error? eof-value]
+                  "Reads one JSON value from input String or Reader.
+  If keywordize? is true, object keys will be converted to keywords.
+  If eof-error? is true, empty input will throw an EOFException; if
+  false EOF will return eof-value. "))
+
+(extend-protocol
+ Read-JSON-From
+ String
+ (read-json-from [input keywordize? eof-error? eof-value]
+                 (read-json-reader (PushbackReader. (StringReader. input))
+                                   keywordize? eof-error? eof-value))
+ PushbackReader
+ (read-json-from [input keywordize? eof-error? eof-value]
+                 (read-json-reader (PushbackReader. (StringReader. input))
+                                   keywordize? eof-error? eof-value))
+ Reader
+ (read-json-from [input keywordize? eof-error? eof-value]
+                 (read-json-reader (PushbackReader. input)
+                                   keywordize? eof-error? eof-value)))
+
+(defn read-json
+  "Reads one JSON value from input String or Reader.
+  If keywordize? is true (default), object keys will be converted to
+  keywords.  If eof-error? is true (default), empty input will throw
+  an EOFException; if false EOF will return eof-value. "
+  ([input]
+     (read-json-from input true true nil))
+  ([input keywordize?]
+     (read-json-from input keywordize? true nil))
+  ([input keywordize? eof-error? eof-value]
+     (read-json-from input keywordize? eof-error? eof-value)))
+
+(defprotocol Print-JSON
+  (print-json [object]
+              "Print object to *out* as JSON"))
+
+(extend-protocol
+ Print-JSON
+
+ nil
+ (print-json [x] (print "null"))
+
+ clojure.lang.Named
+ (print-json [x] (print-json (name x)))
+
+ java.lang.Boolean
+ (print-json [x] (pr x))
+
+ java.lang.Number
+ (print-json [x] (pr x))
+
+ java.math.BigInteger
+ (print-json [x] (print (str x)))
+
+ java.math.BigDecimal
+ (print-json [x] (print (str x)))
+
+ java.lang.CharSequence
+ (print-json [s]
+             (let [sb (StringBuilder. (count s))]
+               (.append sb \")
+               (dotimes [i (count s)]
+                 (let [cp (Character/codePointAt s i)]
+                   (cond
+                    ;; Handle printable JSON escapes before ASCII
+                    (= cp 34) (.append sb "\\\"")
+                    (= cp 92) (.append sb "\\\\")
+                    (= cp 47) (.append sb "\\/")
+                    ;; Print simple ASCII characters
+                    (< 31 cp 127) (.append sb (.charAt s i))
+                    ;; Handle non-printable JSON escapes
+                    (= cp 8) (.append sb "\\b")
+                    (= cp 12) (.append sb "\\f")
+                    (= cp 10) (.append sb "\\n")
+                    (= cp 13) (.append sb "\\r")
+                    (= cp 9) (.append sb "\\t")
+                    ;; Any other character is Hexadecimal-escaped
+                    :else (.append sb (format "\\u%04x" cp)))))
+               (.append sb \")
+               (print (str sb))))
+
+ java.util.Map
+ (print-json [m] 
+             (print \{)
+             (loop [x m]
+               (when (seq m)
+                 (let [[k v] (first x)]
+                   (when (nil? k)
+                     (throw (Exception. "JSON object keys cannot be nil/null")))
+                   (print-json (j/as-str k))
+                   (print \:)
+                   (print-json v))
+                 (let [nxt (next x)]
+                   (when (seq nxt)
+                     (print \,)
+                     (recur nxt)))))
+             (print \}))
+
+ java.util.Collection
+ (print-json [s]
+             (print \[)
+             (loop [x s]
+               (when (seq x)
+                 (let [fst (first x)
+                       nxt (next x)]
+                   (print-json fst)
+                   (when (seq nxt)
+                     (print \,)
+                     (recur nxt)))))
+             (print \]))
+
+ clojure.lang.ISeq
+ (print-json [s]
+             (print \[)
+             (loop [x s]
+               (when (seq x)
+                 (let [fst (first x)
+                       nxt (next x)]
+                   (print-json fst)
+                   (when (seq nxt)
+                     (print \,)
+                     (recur nxt)))))
+             (print \])) 
+
+ java.lang.Object
+ (print-json [x]
+             (if (.isArray (class x))
+               (print-json (seq x))
+               (throw (Exception. "Don't know how to print JSON of " (class x))))))
+
+(defn json-str
+  "Converts x to a JSON-formatted string."
+  [x]
+  (with-out-str (print-json x)))
+
+(defn write-json
+  "Writes JSON-formatted text to out."
+  [x out]
+  (binding [*out* out]
+    (print-json x)))