From ab8a0c5860d8167247fafe3b14254967bd4d7fd0 Mon Sep 17 00:00:00 2001
From: Jeremy Penner <jeremy@sporktania.com>
Date: Mon, 13 May 2013 18:04:13 -0400
Subject: [PATCH] Proper EDN serialization

---
 src/hottub/serialize.clj                 | 24 +++----
 src/net/information_superhighway/edn.clj | 80 ++++++++++++++++++++++++
 2 files changed, 93 insertions(+), 11 deletions(-)
 create mode 100644 src/net/information_superhighway/edn.clj

diff --git a/src/hottub/serialize.clj b/src/hottub/serialize.clj
index f399914..5e97bbc 100644
--- a/src/hottub/serialize.clj
+++ b/src/hottub/serialize.clj
@@ -1,21 +1,23 @@
 (ns hottub.serialize
-  (:require [clojure.edn :as edn]))
+  (:require [clojure.edn :as edn]
+            [net.information-superhighway.edn :as ednw]))
 
-(defmethod print-dup clojure.lang.PersistentQueue [o w]
-  (.append w "#hottub/queue ")
-  (print-dup (into [] o) w))
+(defn is-queue [q]          (isa? (type q) clojure.lang.PersistentQueue))
+(defn serialize-queue [q]   (into [] q))
+(defn deserialize-queue [l] (into clojure.lang.PersistentQueue/EMPTY l))
 
-(defn deserialize-queue [l]
-  (into clojure.lang.PersistentQueue/EMPTY l))
+(def writer-opts
+  {:tagged-serializers ['hottub.queue is-queue serialize-queue]})
+
+(def reader-opts
+  {:readers {'hottub.queue deserialize-queue}})
 
 (defn write
-  ([o] (with-open [w (java.io.StringWriter.)]
-        (write o w)
-        (.toString w)))
-  ([o w] (print-dup o w)))
+  ([o] (ednw/stringify o writer-opts))
+  ([o w] (ednw/write o w writer-opts)))
 
 (defmulti read class)
 (defmethod read String [s] (read (java.io.StringReader. s)))
 (defmethod read java.io.Reader [r]
   (with-open [pbr (java.io.PushbackReader. r)]
-    (edn/read {:readers {'hottub/queue deserialize-queue}} pbr)))
\ No newline at end of file
+    (edn/read reader-opts pbr)))
diff --git a/src/net/information_superhighway/edn.clj b/src/net/information_superhighway/edn.clj
new file mode 100644
index 0000000..f5329f3
--- /dev/null
+++ b/src/net/information_superhighway/edn.clj
@@ -0,0 +1,80 @@
+(ns net.information-superhighway.edn)
+
+(defn serialize-pr [val opts w]
+  "Serializes an arbitrary value to EDN using clojure.core/pr."
+  (binding [*out* w] (pr val)))
+
+(defn serialize-number [num opts w]
+  "Serialize a number to EDN.  Converts ratios to doubles."
+  (let [out (if (integer? num) num (double num))]
+    (.append w (str out))))
+
+(declare write)
+
+(defn- serialize-children [open close vals opts w]
+  (.append w open)
+  (loop [vals vals isfirst true]
+    (if (seq vals)
+      (do
+        (if-not isfirst (.append w " "))
+        (write (first vals) opts w)
+        (recur (next vals) false))))
+  (.append w close))
+
+(defn serialize-list [l opts w]
+  (serialize-children "(" ")" l opts w))
+
+(defn serialize-set [s opts w]
+  (serialize-children "#{" "}" s opts w))
+
+(defn serialize-vector [v opts w]
+  (serialize-children "[" "]" v opts w))
+
+(defn serialize-map [m opts w]
+  (serialize-children "{" "}" (mapcat identity m) opts w))
+
+(def default-serializers
+  [keyword? serialize-pr
+   string? serialize-pr
+   number? serialize-number
+   #(or (= % true) (= % false)) serialize-pr
+   map? serialize-map
+   vector? serialize-vector
+   nil? serialize-pr
+   symbol? serialize-pr
+   list? serialize-list
+   set? serialize-set
+   char? serialize-pr])
+
+(defn write-default [val opts w]
+  "Serialize to EDN using only the baseline serializers (no tagged values)"
+  (loop [serializers (partition 2 default-serializers)]
+    (if (seq serializers)
+      (let [[fntest fnserialize] (first serializers)]
+        (if (fntest val)
+          (fnserialize val opts w)
+          (recur (next serializers))))
+      (throw (Exception. (str "Could not serialize " val))))))
+
+(defn serialize-tagged [tag value opts w]
+  (.append w (str "#" tag " "))
+  (write-default value opts w))
+
+(def default-opts nil)
+(defn write
+  ([val w] (write val default-opts w))
+  ([val opts w]
+   (loop [tagged-serializers (partition 3 (:tagged-serializers opts))]
+     (if (seq tagged-serializers)
+       (let [[tag fntest fnserialize] (first tagged-serializers)]
+         (if (fntest val)
+           (serialize-tagged tag (fnserialize val) opts w)
+           (recur (next tagged-serializers))))
+       (write-default val opts w)))))
+
+(defn stringify
+  ([val] (stringify val default-opts))
+  ([val opts]
+    (with-open [w (java.io.StringWriter.)]
+      (write val opts w)
+      (.toString w))))