rlm@10: ;;; json.clj: A pretty printing version of the JavaScript Object Notation (JSON) generator
rlm@10: 
rlm@10: ;; by Tom Faulhaber, based on the version by Stuart Sierra (clojure.contrib.json.write)
rlm@10: ;; May 9, 2009
rlm@10: 
rlm@10: ;; Copyright (c) Tom Faulhaber/Stuart Sierra, 2009. All rights reserved.  The use
rlm@10: ;; and distribution terms for this software are covered by the Eclipse
rlm@10: ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
rlm@10: ;; which can be found in the file epl-v10.html at the root of this
rlm@10: ;; distribution.  By using this software in any fashion, you are
rlm@10: ;; agreeing to be bound by the terms of this license.  You must not
rlm@10: ;; remove this notice, or any other, from this software.
rlm@10: 
rlm@10: 
rlm@10: (ns 
rlm@10:   #^{:author "Tom Faulhaber (based on the version by Stuart Sierra)",
rlm@10:      :doc "Pretty printing JavaScript Object Notation (JSON) generator.
rlm@10: 
rlm@10: This is an example of using a pretty printer dispatch function to generate JSON output",
rlm@10:      :see-also [["http://json.org/", "JSON Home Page"]]}
rlm@10:   clojure.contrib.pprint.examples.json
rlm@10:   (:use [clojure.test :only (deftest- is)]
rlm@10:         [clojure.contrib.string :only (as-str)]
rlm@10:         [clojure.contrib.pprint :only (write formatter-out)]))
rlm@10: 
rlm@10: 
rlm@10: 
rlm@10: (defmulti dispatch-json
rlm@10:   "The dispatch function for printing objects as JSON"
rlm@10:   {:arglists '[[x]]} 
rlm@10:   (fn [x] (cond
rlm@10:             (nil? x) nil ;; prevent NullPointerException on next line
rlm@10:             (.isArray (class x)) ::array
rlm@10:             :else (type x))))
rlm@10: 
rlm@10: ;; Primitive types can be printed with Clojure's pr function.
rlm@10: (derive java.lang.Boolean ::pr)
rlm@10: (derive java.lang.Byte ::pr)
rlm@10: (derive java.lang.Short ::pr)
rlm@10: (derive java.lang.Integer ::pr)
rlm@10: (derive java.lang.Long ::pr)
rlm@10: (derive java.lang.Float ::pr)
rlm@10: (derive java.lang.Double ::pr)
rlm@10: 
rlm@10: ;; Collection types can be printed as JSON objects or arrays.
rlm@10: (derive java.util.Map ::object)
rlm@10: (derive java.util.Collection ::array)
rlm@10: 
rlm@10: ;; Symbols and keywords are converted to strings.
rlm@10: (derive clojure.lang.Symbol ::symbol)
rlm@10: (derive clojure.lang.Keyword ::symbol)
rlm@10: 
rlm@10: 
rlm@10: (defmethod dispatch-json ::pr [x] (pr x))
rlm@10: 
rlm@10: (defmethod dispatch-json nil [x] (print "null"))
rlm@10: 
rlm@10: (defmethod dispatch-json ::symbol [x] (pr (name x)))
rlm@10: 
rlm@10: (defmethod dispatch-json ::array [s] 
rlm@10:   ((formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>") s))
rlm@10: 
rlm@10: (defmethod dispatch-json ::object [m]
rlm@10:   ((formatter-out "~<{~;~@{~<~w:~_~w~:>~^, ~_~}~;}~:>") 
rlm@10:    (for [[k v] m] [(as-str k) v])))
rlm@10: 
rlm@10: (defmethod dispatch-json java.lang.CharSequence [s]
rlm@10:   (print \")
rlm@10:   (dotimes [i (count s)]
rlm@10:     (let [cp (Character/codePointAt s i)]
rlm@10:       (cond
rlm@10:         ;; Handle printable JSON escapes before ASCII
rlm@10:         (= cp 34) (print "\\\"")
rlm@10:         (= cp 92) (print "\\\\")
rlm@10:         ;; Print simple ASCII characters
rlm@10:         (< 31 cp 127) (print (.charAt s i))
rlm@10:         ;; Handle non-printable JSON escapes
rlm@10:         (= cp 8) (print "\\b")
rlm@10:         (= cp 12) (print "\\f")
rlm@10:         (= cp 10) (print "\\n")
rlm@10:         (= cp 13) (print "\\r")
rlm@10:         (= cp 9) (print "\\t")
rlm@10:         ;; Any other character is printed as Hexadecimal escape
rlm@10:         :else (printf "\\u%04x" cp))))
rlm@10:   (print \"))
rlm@10: 
rlm@10: (defn print-json 
rlm@10:   "Prints x as JSON.  Nil becomes JSON null.  Keywords become
rlm@10:   strings, without the leading colon.  Maps become JSON objects, all
rlm@10:   other collection types become JSON arrays.  Java arrays become JSON
rlm@10:   arrays.  Unicode characters in strings are escaped as \\uXXXX.
rlm@10:   Numbers print as with pr."
rlm@10:   [x] 
rlm@10:   (write x :dispatch dispatch-json))
rlm@10: 
rlm@10: (defn json-str
rlm@10:   "Converts x to a JSON-formatted string."
rlm@10:   [x]
rlm@10:   (with-out-str (print-json x)))
rlm@10: 
rlm@10: 
rlm@10: 
rlm@10: ;;; TESTS
rlm@10: 
rlm@10: ;; Run these tests with
rlm@10: ;; (clojure.test/run-tests 'clojure.contrib.print-json)
rlm@10: 
rlm@10: ;; Bind clojure.test/*load-tests* to false to omit these
rlm@10: ;; tests from production code.
rlm@10: 
rlm@10: (deftest- can-print-json-strings
rlm@10:   (is (= "\"Hello, World!\"" (json-str "Hello, World!")))
rlm@10:   (is (= "\"\\\"Embedded\\\" Quotes\"" (json-str "\"Embedded\" Quotes"))))
rlm@10: 
rlm@10: (deftest- can-print-unicode
rlm@10:   (is (= "\"\\u1234\\u4567\"" (json-str "\u1234\u4567"))))
rlm@10: 
rlm@10: (deftest- can-print-json-null
rlm@10:   (is (= "null" (json-str nil))))
rlm@10: 
rlm@10: (deftest- can-print-json-arrays
rlm@10:   (is (= "[1, 2, 3]" (json-str [1 2 3])))
rlm@10:   (is (= "[1, 2, 3]" (json-str (list 1 2 3))))
rlm@10:   (is (= "[1, 2, 3]" (json-str (sorted-set 1 2 3))))
rlm@10:   (is (= "[1, 2, 3]" (json-str (seq [1 2 3])))))
rlm@10: 
rlm@10: (deftest- can-print-java-arrays
rlm@10:   (is (= "[1, 2, 3]" (json-str (into-array [1 2 3])))))
rlm@10: 
rlm@10: (deftest- can-print-empty-arrays
rlm@10:   (is (= "[]" (json-str [])))
rlm@10:   (is (= "[]" (json-str (list))))
rlm@10:   (is (= "[]" (json-str #{}))))
rlm@10: 
rlm@10: (deftest- can-print-json-objects
rlm@10:   (is (= "{\"a\":1, \"b\":2}" (json-str (sorted-map :a 1 :b 2)))))
rlm@10: 
rlm@10: (deftest- object-keys-must-be-strings
rlm@10:   (is (= "{\"1\":1, \"2\":2}" (json-str (sorted-map 1 1 2 2)))))
rlm@10: 
rlm@10: (deftest- can-print-empty-objects
rlm@10:   (is (= "{}" (json-str {}))))