Refactor fallback stuff for extra flexibility

src/taoensso/nippy.clj

@@ -223,12 +223,14 @@
 ;;;; Dynamic config
 ;; See also `nippy.tools` ns for further dynamic config support
 
-(enc/defonce* ^:dynamic *allow-serializable-fallback?* true)
-(enc/defonce* ^:dynamic *allow-readable-fallback?*     true)
-(enc/defonce* ^:dynamic *final-freeze-fallback*
-  "(fn [data-output x]), nil => default (throw)"
+(enc/defonce* ^:dynamic *freeze-fallback*
+  "(fn [data-output x]), nil => default"
   nil)
 
+(defn set-freeze-fallback! [f]
+  (assert (fn? f))
+  (alter-var-root #'*freeze-fallback* (constantly f)))
+
 (enc/defonce* ^:dynamic *auto-freeze-compressor*
   "(fn [byte-array])->compressor used by `(freeze <x> {:compressor :auto}),
   nil => default"
@@ -570,6 +572,70 @@
 
         (-run! (fn [in] (freeze-to-out! out in)) s)))))
 
+(defn write-serializable [^DataOutput out x]
+  (when-debug (println (str "write-serializable: " (type x))))
+  (let [cname    (.getName (class x)) ; Reflect
+        cname-ba (.getBytes cname "UTF-8")
+        len      (alength cname-ba)]
+    (cond
+      (byte-sized? len)
+      (do (.writeByte     out id-serializable-sm)
+          (write-bytes-sm out cname-ba))
+
+      :else
+      (do (.writeByte     out id-serializable-md)
+          (write-bytes-md out cname-ba)))
+
+    (.writeObject (ObjectOutputStream. out) x)))
+
+(defn write-readable [^DataOutput out x]
+  (when-debug (println (str "write-readable: " (type x))))
+  (let [edn    (enc/pr-edn x)
+        edn-ba (.getBytes ^String edn "UTF-8")
+        len    (alength edn-ba)]
+    (cond
+      (byte-sized? len)
+      (do (.writeByte     out id-reader-sm)
+          (write-bytes-sm out edn-ba))
+
+      (short-sized? len)
+      (do (.writeByte     out id-reader-md)
+          (write-bytes-md out edn-ba))
+
+      :else
+      (do (.writeByte     out id-reader-lg)
+          (write-bytes-lg out edn-ba)))))
+
+(defn try-write-serializable [out x]
+  (when (utils/serializable? x)
+    (try (write-serializable out x) true
+         (catch Throwable _ nil))))
+
+(defn try-write-readable [out x]
+  (when (utils/readable? x)
+    (try (write-readable out x) true
+         (catch Throwable _ nil))))
+
+(defn- try-pr-edn [x]
+  (try
+    (enc/pr-edn x)
+    (catch Throwable _
+      (try
+        (str x)
+        (catch Throwable _ :nippy/unprintable)))))
+
+(defn write-unfreezable [out x]
+  (-freeze-to-out!
+    {:type (type x)
+     :nippy/unfreezable (try-pr-edn x)}
+    out))
+
+(defn throw-unfreezable [x]
+  (throw
+    (ex-info (str "Unfreezable type: " (type x))
+      {:type   (type x)
+       :as-str (try-pr-edn x)})))
+
 (defn freeze-to-out!
   "Serializes arg (any Clojure data type) to a DataOutput. Please note that
   this is a low-level util: in most cases you'll want `freeze` instead."
@@ -659,65 +725,15 @@
 
     (-freeze-to-out! (into {} x) out)))
 
-(defn freeze-fallback-as-str [out x]
-  (-freeze-to-out! {:nippy/unfreezable (enc/pr-edn x) :type (type x)} out))
-
-(comment
-  (require '[clojure.core.async :as async])
-  (binding [*final-freeze-fallback* freeze-fallback-as-str]
-    (-> (async/chan) (freeze) (thaw))))
-
-;; Fallbacks. Note that we'll extend *only* to (lowly) Object to prevent
-;; interfering with higher-level implementations, Ref. http://goo.gl/6f7SKl
-(extend-type Object
-  Freezable
-  (-freeze-to-out! [x ^DataOutput out]
-    (cond
-      ;; Fallback #1: Java's Serializable interface
-      (and *allow-serializable-fallback?* (utils/serializable? x))
-      (do
-        (when-debug (println (str "DEBUG - Serializable fallback: " (type x))))
-        (let [cname    (.getName (class x)) ; Reflect
-              cname-ba (.getBytes cname "UTF-8")
-              len      (alength cname-ba)]
-          (cond
-            (byte-sized? len)
-            (do (.writeByte     out id-serializable-sm)
-                (write-bytes-sm out cname-ba))
-
-            :else
-            (do (.writeByte     out id-serializable-md)
-                (write-bytes-md out cname-ba)))
-
-          (.writeObject (ObjectOutputStream. out) x)))
-
-      ;; Fallback #2: Clojure's Reader
-      (and *allow-readable-fallback?* (utils/readable? x))
-      (do
-        (when-debug (println (str "DEBUG - Reader fallback: " (type x))))
-        (let [edn    (enc/pr-edn x)
-              edn-ba (.getBytes ^String edn "UTF-8")
-              len    (alength edn-ba)]
-          (cond
-            (byte-sized? len)
-            (do (.writeByte     out id-reader-sm)
-                (write-bytes-sm out edn-ba))
-
-            (short-sized? len)
-            (do (.writeByte     out id-reader-md)
-                (write-bytes-md out edn-ba))
-
-            :else
-            (do (.writeByte     out id-reader-lg)
-                (write-bytes-lg out edn-ba)))))
-
-      :else ; Fallback #3: *final-freeze-fallback*
-      (if-let [ffb *final-freeze-fallback*]
-        (ffb out x)
-        (throw
-          (ex-info (str "Unfreezable type: " (type x))
-            {:type   (type x)
-             :as-str (enc/pr-edn x)}))))))
+(freezer* Object
+  (when-debug (println (str "freeze-fallback: " (type x))))
+  (if-let [ff *freeze-fallback*]
+    (ff out x)
+    (or
+      (try-write-serializable out x)
+      (try-write-readable     out x)
+      ;; (write-unfreezable   out x)
+      (throw-unfreezable          x))))
 
 (def ^:private head-meta-id (reduce-kv #(assoc %1 %3 %2) {} head-meta))
 (def ^:private get-head-ba
@@ -897,7 +913,7 @@
   [^DataInput data-input]
   (let [in      data-input
         type-id (.readByte in)]
-    (when-debug (println (str "DEBUG - thawing type-id: " type-id)))
+    (when-debug (println (str "thaw-from-in!: " type-id)))
     (try
       (enc/case-eval type-id
 
@@ -1323,6 +1339,8 @@
 
 ;;;; Deprecated
 
+(def freeze-fallback-as-str write-unfreezable)
+
 (defn set-default-freeze-compressor-selector!
   "DEPRECATED, please use `set-auto-freeze-compressor!`"
   [f] (set-auto-freeze-compressor! f))