Created new examples of how to use pretty print dispatch functions

2 files changed, 259 insertions, 0 deletions

diff --git a/src/clojure/contrib/pprint/examples/json.clj b/src/clojure/contrib/pprint/examples/json.clj
new file mode 100644
index 00000000..ca11231d
--- /dev/null
+++ b/src/clojure/contrib/pprint/examples/json.clj
@@ -0,0 +1,143 @@
+;;; json.clj: A pretty printing version of the JavaScript Object Notation (JSON) generator
+
+;; by Tom Faulhaber, based on the version by Stuart Sierra (clojure.contrib.json.write)
+;; May 9, 2009
+
+;; Copyright (c) Tom Faulhaber/Stuart Sierra, 2009. 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 "Tom Faulhaber (based on the version by Stuart Sierra)",
+     :doc "Pretty printing JavaScript Object Notation (JSON) generator.
+
+This is an example of using a pretty printer dispatch function to generate JSON output",
+     :see-also [["http://json.org/", "JSON Home Page"]]}
+  clojure.contrib.pprint.examples.json
+  (:require [clojure.contrib.java-utils :as j])
+  (:use [clojure.contrib.test-is :only (deftest- is)]
+        [clojure.contrib.pprint :only (write formatter-out)]))
+
+
+
+(defmulti dispatch-json
+  "The dispatch function for printing objects as JSON"
+  {:arglists '[[x]]} 
+  (fn [x] (cond
+            (nil? x) nil ;; prevent NullPointerException on next line
+            (.isArray (class x)) ::array
+            :else (type x))))
+
+;; Primitive types can be printed with Clojure's pr function.
+(derive java.lang.Boolean ::pr)
+(derive java.lang.Byte ::pr)
+(derive java.lang.Short ::pr)
+(derive java.lang.Integer ::pr)
+(derive java.lang.Long ::pr)
+(derive java.lang.Float ::pr)
+(derive java.lang.Double ::pr)
+
+;; Collection types can be printed as JSON objects or arrays.
+(derive java.util.Map ::object)
+(derive java.util.Collection ::array)
+
+;; Symbols and keywords are converted to strings.
+(derive clojure.lang.Symbol ::symbol)
+(derive clojure.lang.Keyword ::symbol)
+
+
+(defmethod dispatch-json ::pr [x] (pr x))
+
+(defmethod dispatch-json nil [x] (print "null"))
+
+(defmethod dispatch-json ::symbol [x] (pr (name x)))
+
+(defmethod dispatch-json ::array [s] 
+  ((formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>") s))
+
+(defmethod dispatch-json ::object [m]
+  ((formatter-out "~<{~;~@{~<~w:~_~w~:>~^, ~_~}~;}~:>") 
+   (for [[k v] m] [(j/as-str k) v])))
+
+(defmethod dispatch-json java.lang.CharSequence [s]
+  (print \")
+  (dotimes [i (count s)]
+    (let [cp (Character/codePointAt s i)]
+      (cond
+        ;; Handle printable JSON escapes before ASCII
+        (= cp 34) (print "\\\"")
+        (= cp 92) (print "\\\\")
+        (= cp 47) (print "\\/")
+        ;; Print simple ASCII characters
+        (< 31 cp 127) (print (.charAt s i))
+        ;; Handle non-printable JSON escapes
+        (= cp 8) (print "\\b")
+        (= cp 12) (print "\\f")
+        (= cp 10) (print "\\n")
+        (= cp 13) (print "\\r")
+        (= cp 9) (print "\\t")
+        ;; Any other character is printed as Hexadecimal escape
+        :else (printf "\\u%04x" cp))))
+  (print \"))
+
+(defn print-json 
+  "Prints x as JSON.  Nil becomes JSON null.  Keywords become
+  strings, without the leading colon.  Maps become JSON objects, all
+  other collection types become JSON arrays.  Java arrays become JSON
+  arrays.  Unicode characters in strings are escaped as \\uXXXX.
+  Numbers print as with pr."
+  [x] 
+  (write x :dispatch dispatch-json))
+
+(defn json-str
+  "Converts x to a JSON-formatted string."
+  [x]
+  (with-out-str (print-json x)))
+
+
+
+;;; TESTS
+
+;; Run these tests with
+;; (clojure.contrib.test-is/run-tests 'clojure.contrib.print-json)
+
+;; Bind clojure.contrib.test-is/*load-tests* to false to omit these
+;; tests from production code.
+
+(deftest- can-print-json-strings
+  (is (= "\"Hello, World!\"" (json-str "Hello, World!")))
+  (is (= "\"\\\"Embedded\\\" Quotes\"" (json-str "\"Embedded\" Quotes"))))
+
+(deftest- can-print-unicode
+  (is (= "\"\\u1234\\u4567\"" (json-str "\u1234\u4567"))))
+
+(deftest- can-print-json-null
+  (is (= "null" (json-str nil))))
+
+(deftest- can-print-json-arrays
+  (is (= "[1, 2, 3]" (json-str [1 2 3])))
+  (is (= "[1, 2, 3]" (json-str (list 1 2 3))))
+  (is (= "[1, 2, 3]" (json-str (sorted-set 1 2 3))))
+  (is (= "[1, 2, 3]" (json-str (seq [1 2 3])))))
+
+(deftest- can-print-java-arrays
+  (is (= "[1, 2, 3]" (json-str (into-array [1 2 3])))))
+
+(deftest- can-print-empty-arrays
+  (is (= "[]" (json-str [])))
+  (is (= "[]" (json-str (list))))
+  (is (= "[]" (json-str #{}))))
+
+(deftest- can-print-json-objects
+  (is (= "{\"a\":1, \"b\":2}" (json-str (sorted-map :a 1 :b 2)))))
+
+(deftest- object-keys-must-be-strings
+  (is (= "{\"1\":1, \"2\":2}" (json-str (sorted-map 1 1 2 2)))))
+
+(deftest- can-print-empty-objects
+  (is (= "{}" (json-str {}))))
diff --git a/src/clojure/contrib/pprint/examples/xml.clj b/src/clojure/contrib/pprint/examples/xml.clj
new file mode 100644
index 00000000..4bf92c14
--- /dev/null
+++ b/src/clojure/contrib/pprint/examples/xml.clj
@@ -0,0 +1,116 @@
+;;; xml.clj -- a pretty print dispatch version of prxml.clj -- a compact syntax for generating XML
+
+;; by Tom Faulhaber, based on the original by Stuart Sierra, http://stuartsierra.com/
+;; May 13, 2009
+
+;; Copyright (c) 2009 Tom Faulhaber/Stuart Sierra. 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.
+
+
+;; See function "prxml" at the bottom of this file for documentation.
+
+
+(ns 
+  #^{:author "Tom Faulhaber, based on the original by Stuart Sierra",
+     :doc "A version of prxml that uses a pretty print dispatch function."}
+  clojure.contrib.pprint.examples.xml
+  (:use [clojure.contrib.lazy-xml :only (escape-xml)]
+        [clojure.contrib.java-utils :only (as-str)]
+        [clojure.contrib.pprint :only (formatter-out write)]
+        [clojure.contrib.pprint.utilities :only (prlabel)]))
+
+(def
+ #^{:doc "If true, empty tags will have a space before the closing />"}
+ *html-compatible* false)
+
+(def
+ #^{:doc "The number of spaces to indent sub-tags."}
+ *prxml-indent* 2)
+
+(defmulti #^{:private true} print-xml-tag (fn [tag attrs content] tag))
+
+(defmethod print-xml-tag :raw! [tag attrs contents]
+  (doseq [c contents] (print c)))
+
+(defmethod print-xml-tag :comment! [tag attrs contents]
+  (print "<!-- ")
+  (doseq [c contents] (print c))
+  (print " -->"))
+
+(defmethod print-xml-tag :decl! [tag attrs contents]
+  (let [attrs (merge {:version "1.0" :encoding "UTF-8"}
+                     attrs)]
+    ;; Must enforce ordering of pseudo-attributes:
+    ((formatter-out "<?xml version=\"~a\" encoding=\"~a\"~@[ standalone=\"~a\"~]?>") 
+     (:version attrs) (:encoding attrs) (:standalone attrs))))
+
+(defmethod print-xml-tag :cdata! [tag attrs contents]
+  ((formatter-out "<[!CDATA[~{~a~}]]>") contents))
+
+(defmethod print-xml-tag :doctype! [tag attrs contents]
+  ((formatter-out "<[!DOCTYPE [~{~a~}]]>") contents))
+
+(defmethod print-xml-tag :default [tag attrs contents]
+  (let [tag-name (as-str tag)]
+    (if (seq? contents)
+      ((formatter-out "~<~<<~a~1:i~{ ~:_~{~a=\"~a\"~}~}>~:>~vi~{~_~w~}~0i~_</~a>~:>")
+       [[tag-name (map #(vector (as-str (key %)) (as-str (val %))) attrs)] *prxml-indent* contents tag-name])
+      ((formatter-out "~<<~a~1:i~{~:_ ~{~a=\"~a\"~}~}/>~:>") [tag-name attrs]))))
+
+
+(defmulti #^{:private true} print-xml class)
+
+(defmethod print-xml clojure.lang.IPersistentVector [x]
+  (let [[tag & contents] x
+        [attrs content] (if (map? (first contents))
+                          [(first contents) (rest contents)]
+                          [{} contents])]
+    (print-xml-tag tag attrs content)))
+
+(defmethod print-xml clojure.lang.ISeq [x]
+  ;; Recurse into sequences, so we can use (map ...) inside prxml.
+  (doseq [c x] (print-xml c)))
+
+(defmethod print-xml clojure.lang.Keyword [x]
+  (print-xml-tag x {} nil))
+
+(defmethod print-xml String [x]
+  (print (escape-xml x)))
+
+(defmethod print-xml nil [x])
+
+(defmethod print-xml :default [x]
+  (print x))
+
+
+(defn prxml
+  "Print XML to *out*.  Vectors become XML tags: the first item is the
+  tag name; optional second item is a map of attributes.
+
+  Sequences are processed recursively, so you can use map and other
+  sequence functions inside prxml.
+
+    (prxml [:p {:class \"greet\"} [:i \"Ladies & gentlemen\"]])
+    ; => <p class=\"greet\"><i>Ladies &amp; gentlemen</i></p>
+
+  PSEUDO-TAGS: some keywords have special meaning:
+
+    :raw!      do not XML-escape contents
+    :comment!  create an XML comment
+    :decl!     create an XML declaration, with attributes
+    :cdata!    create a CDATA section
+    :doctype!  create a DOCTYPE!
+
+    (prxml [:p [:raw! \"<i>here & gone</i>\"]])
+    ; => <p><i>here & gone</i></p>
+
+    (prxml [:decl! {:version \"1.1\"}])
+    ; => <?xml version=\"1.1\" encoding=\"UTF-8\"?>"
+  [& args]
+  (doseq [arg args] (write arg :dispatch print-xml))
+  (when (pos? (count args)) (newline)))