Mercurial > lasercutter

comparison src/clojure/contrib/test_contrib/pprint/examples/json.clj @ 10:ef7dbbd6452c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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: A pretty printing version of the JavaScript Object Notation (JSON) generator
2
3 ;; by Tom Faulhaber, based on the version by Stuart Sierra (clojure.contrib.json.write)
4 ;; May 9, 2009
5
6 ;; Copyright (c) Tom Faulhaber/Stuart Sierra, 2009. 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
15 (ns
16 #^{:author "Tom Faulhaber (based on the version by Stuart Sierra)",
17 :doc "Pretty printing JavaScript Object Notation (JSON) generator.
18
19 This is an example of using a pretty printer dispatch function to generate JSON output",
20 :see-also [["http://json.org/", "JSON Home Page"]]}
21 clojure.contrib.pprint.examples.json
22 (:use [clojure.test :only (deftest- is)]
23 [clojure.contrib.string :only (as-str)]
24 [clojure.contrib.pprint :only (write formatter-out)]))
25
26
27
28 (defmulti dispatch-json
29 "The dispatch function for printing objects as JSON"
30 {:arglists '[[x]]}
31 (fn [x] (cond
32 (nil? x) nil ;; prevent NullPointerException on next line
33 (.isArray (class x)) ::array
34 :else (type x))))
35
36 ;; Primitive types can be printed with Clojure's pr function.
37 (derive java.lang.Boolean ::pr)
38 (derive java.lang.Byte ::pr)
39 (derive java.lang.Short ::pr)
40 (derive java.lang.Integer ::pr)
41 (derive java.lang.Long ::pr)
42 (derive java.lang.Float ::pr)
43 (derive java.lang.Double ::pr)
44
45 ;; Collection types can be printed as JSON objects or arrays.
46 (derive java.util.Map ::object)
47 (derive java.util.Collection ::array)
48
49 ;; Symbols and keywords are converted to strings.
50 (derive clojure.lang.Symbol ::symbol)
51 (derive clojure.lang.Keyword ::symbol)
52
53
54 (defmethod dispatch-json ::pr [x] (pr x))
55
56 (defmethod dispatch-json nil [x] (print "null"))
57
58 (defmethod dispatch-json ::symbol [x] (pr (name x)))
59
60 (defmethod dispatch-json ::array [s]
61 ((formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>") s))
62
63 (defmethod dispatch-json ::object [m]
64 ((formatter-out "~<{~;~@{~<~w:~_~w~:>~^, ~_~}~;}~:>")
65 (for [[k v] m] [(as-str k) v])))
66
67 (defmethod dispatch-json java.lang.CharSequence [s]
68 (print \")
69 (dotimes [i (count s)]
70 (let [cp (Character/codePointAt s i)]
71 (cond
72 ;; Handle printable JSON escapes before ASCII
73 (= cp 34) (print "\\\"")
74 (= cp 92) (print "\\\\")
75 ;; Print simple ASCII characters
76 (< 31 cp 127) (print (.charAt s i))
77 ;; Handle non-printable JSON escapes
78 (= cp 8) (print "\\b")
79 (= cp 12) (print "\\f")
80 (= cp 10) (print "\\n")
81 (= cp 13) (print "\\r")
82 (= cp 9) (print "\\t")
83 ;; Any other character is printed as Hexadecimal escape
84 :else (printf "\\u%04x" cp))))
85 (print \"))
86
87 (defn print-json
88 "Prints x as JSON. Nil becomes JSON null. Keywords become
89 strings, without the leading colon. Maps become JSON objects, all
90 other collection types become JSON arrays. Java arrays become JSON
91 arrays. Unicode characters in strings are escaped as \\uXXXX.
92 Numbers print as with pr."
93 [x]
94 (write x :dispatch dispatch-json))
95
96 (defn json-str
97 "Converts x to a JSON-formatted string."
98 [x]
99 (with-out-str (print-json x)))
100
101
102
103 ;;; TESTS
104
105 ;; Run these tests with
106 ;; (clojure.test/run-tests 'clojure.contrib.print-json)
107
108 ;; Bind clojure.test/*load-tests* to false to omit these
109 ;; tests from production code.
110
111 (deftest- can-print-json-strings
112 (is (= "\"Hello, World!\"" (json-str "Hello, World!")))
113 (is (= "\"\\\"Embedded\\\" Quotes\"" (json-str "\"Embedded\" Quotes"))))
114
115 (deftest- can-print-unicode
116 (is (= "\"\\u1234\\u4567\"" (json-str "\u1234\u4567"))))
117
118 (deftest- can-print-json-null
119 (is (= "null" (json-str nil))))
120
121 (deftest- can-print-json-arrays
122 (is (= "[1, 2, 3]" (json-str [1 2 3])))
123 (is (= "[1, 2, 3]" (json-str (list 1 2 3))))
124 (is (= "[1, 2, 3]" (json-str (sorted-set 1 2 3))))
125 (is (= "[1, 2, 3]" (json-str (seq [1 2 3])))))
126
127 (deftest- can-print-java-arrays
128 (is (= "[1, 2, 3]" (json-str (into-array [1 2 3])))))
129
130 (deftest- can-print-empty-arrays
131 (is (= "[]" (json-str [])))
132 (is (= "[]" (json-str (list))))
133 (is (= "[]" (json-str #{}))))
134
135 (deftest- can-print-json-objects
136 (is (= "{\"a\":1, \"b\":2}" (json-str (sorted-map :a 1 :b 2)))))
137
138 (deftest- object-keys-must-be-strings
139 (is (= "{\"1\":1, \"2\":2}" (json-str (sorted-map 1 1 2 2)))))
140
141 (deftest- can-print-empty-objects
142 (is (= "{}" (json-str {}))))