~wip

Author: ptaoussanis

src/taoensso/nippy.clj

@@ -24,9 +24,7 @@
     APersistentMap APersistentVector APersistentSet
     IPersistentMap ; IPersistentVector IPersistentSet IPersistentList
     PersistentQueue PersistentTreeMap PersistentTreeSet PersistentList
-    MapEntry LazySeq IRecord ISeq IType]
-
-   [taoensso.nippy.impl Cached]))
+    MapEntry LazySeq IRecord ISeq IType]))
 
 (enc/assert-min-encore-version [3 160 1])
 
@@ -364,190 +362,6 @@
     (call-with-bindings :freeze {}                       (fn [] *freeze-fallback*))
     (call-with-bindings :freeze {:freeze-fallback "foo"} (fn [] *freeze-fallback*))))
 
-;;;; Freeze interface
-
-(defprotocol IFreezable
-  "Private implementation detail.
-  Protocol that types must implement to support native freezing by Nippy.
-  Don't use this directly, instead see `extend-freeze`."
-  (-freezable?           [_])
-  (-freeze-without-meta! [_ data-output]))
-
-(defprotocol IFreezableWithMeta
-  "Private implementation detail.
-  Wrapper protocol around `IFreezable` used to handle possible metadata."
-  (-freeze-with-meta! [_ data-output]))
-
-;;;; Freeze implementations
-
-(extend-protocol IFreezableWithMeta
-  clojure.lang.IObj ; IMeta => `meta` will work, IObj => `with-meta` will work
-  (-freeze-with-meta! [x ^DataOutput data-output]
-    (when-let [m (when *incl-metadata?* (not-empty (meta x)))]
-      (io/write-id  data-output sc/id-meta)
-      (io/write-map data-output m :is-metadata))
-    (-freeze-without-meta! x data-output))
-
-  nil    (-freeze-with-meta! [x data-output] (-freeze-without-meta! x data-output))
-  Object (-freeze-with-meta! [x data-output] (-freeze-without-meta! x data-output)))
-
-(defmacro ^:private freezer
-  "Convenience util / short-hand."
-  [atype id freezable? impl-form]
-  (let [atype   (or (when (symbol? atype) (when-let [r (resolve atype)] (when (var? r) @r))) atype)
-        x       (with-meta 'x   {:tag atype})
-        out     (with-meta 'out {:tag 'DataOutput})
-        id-form (when id `(io/write-id ~'out ~id))]
-
-    `(extend ~atype IFreezable
-       {:-freezable?           (fn [~x] ~freezable?)
-        :-freeze-without-meta! (fn [~x ~out] ~id-form ~impl-form)})))
-
-;; @TODO Inline, or move this stuff to io ns
-
-(freezer nil        sc/id-nil        true nil)
-(freezer (type ())  sc/id-list-0     true nil)
-(freezer Character  sc/id-char       true (.writeChar          out (int x)))
-(freezer Byte       sc/id-byte       true (.writeByte          out      x))
-(freezer Short      sc/id-short      true (.writeShort         out      x))
-(freezer Integer    sc/id-integer    true (.writeInt           out      x))
-(freezer BigInt     sc/id-bigint     true (io/write-biginteger out (.toBigInteger x)))
-(freezer BigInteger sc/id-biginteger true (io/write-biginteger out      x))
-(freezer Pattern    sc/id-regex      true (io/write-str        out (str x)))
-(freezer Float      sc/id-float      true (.writeFloat         out      x))
-(freezer BigDecimal sc/id-bigdec     true
-  (do
-    (io/write-biginteger out (.unscaledValue x))
-    (.writeInt           out (.scale         x))))
-
-(freezer Cached nil true
-  (let [x-val (.-val x)]
-    (if-let [cache_ (.get impl/tl:cache)]
-      (io/write-cached    out x-val cache_)
-      (-freeze-with-meta! x-val out))))
-
-(freezer Ratio sc/id-ratio true
-  (do
-    (io/write-biginteger out (.numerator   x))
-    (io/write-biginteger out (.denominator x))))
-
-(freezer MapEntry sc/id-map-entry true
-  (do
-    (-freeze-with-meta! (key x) out)
-    (-freeze-with-meta! (val x) out)))
-
-(freezer java.util.Date sc/id-util-date true (.writeLong   out (.getTime  x)))
-(freezer java.sql.Date  sc/id-sql-date  true (.writeLong   out (.getTime  x)))
-(freezer URI            sc/id-uri       true (io/write-str out (.toString x)))
-(freezer UUID           sc/id-uuid      true
-  (do
-    (.writeLong out (.getMostSignificantBits  x))
-    (.writeLong out (.getLeastSignificantBits x))))
-
-(freezer Boolean nil true (if (boolean x) (io/write-id out sc/id-true) (io/write-id out sc/id-false)))
-(freezer String  nil true (io/write-str   out x))
-(freezer Keyword nil true (io/write-kw    out x))
-(freezer Symbol  nil true (io/write-sym   out x))
-(freezer Long    nil true (io/write-long  out x))
-(freezer Double  nil true
-  (if (zero? ^double x)
-    (do (io/write-id out sc/id-double-0))
-    (do (io/write-id out sc/id-double) (.writeDouble out x))))
-
-(freezer impl/array-class-bytes     nil true (io/write-bytes    out x))
-(freezer impl/array-class-objects   nil true (io/write-array-lg out x (alength ^objects x) sc/id-object-array-lg))
-
-(when (impl/target-release>= 350)
-  (freezer impl/array-class-ints    nil true (io/write-array-lg out x (alength ^ints                  x) sc/id-int-array-lg))
-  (freezer impl/array-class-longs   nil true (io/write-array-lg out x (alength ^longs                 x) sc/id-long-array-lg))
-  (freezer impl/array-class-floats  nil true (io/write-array-lg out x (alength ^floats                x) sc/id-float-array-lg))
-  (freezer impl/array-class-doubles nil true (io/write-array-lg out x (alength ^doubles               x) sc/id-double-array-lg))
-  (freezer impl/array-class-strings nil true (io/write-array-lg out x (alength ^"[Ljava.lang.String;" x) sc/id-string-array-lg)))
-
-(freezer PersistentQueue    nil true (io/write-counted-coll   out sc/id-queue-lg      x))
-(freezer PersistentTreeSet  nil true (io/write-counted-coll   out sc/id-sorted-set-lg x))
-(freezer PersistentTreeMap  nil true (io/write-kvs            out sc/id-sorted-map-lg x))
-(freezer APersistentVector  nil true (io/write-vec            out                     x))
-(freezer APersistentSet     nil true (io/write-set            out                     x))
-(freezer APersistentMap     nil true (io/write-map            out                     x false))
-(freezer PersistentList     nil true (io/write-counted-coll   out sc/id-list-0 sc/id-list-sm sc/id-list-md sc/id-list-lg x))
-(freezer LazySeq            nil true (io/write-uncounted-coll out  sc/id-seq-0  sc/id-seq-sm  sc/id-seq-md  sc/id-seq-lg x))
-(freezer ISeq               nil true (io/write-coll           out  sc/id-seq-0  sc/id-seq-sm  sc/id-seq-md  sc/id-seq-lg x))
-(freezer IRecord            nil true
-  (let [class-name    (.getName (class x)) ; Reflect
-        class-name-ba (.getBytes class-name StandardCharsets/UTF_8)
-        len           (alength   class-name-ba)]
-    (enc/cond
-      (io/sm-count? len) (do (io/write-id out sc/id-record-sm) (io/write-bytes-sm out class-name-ba))
-      (io/md-count? len) (do (io/write-id out sc/id-record-md) (io/write-bytes-md out class-name-ba))
-      ;; :else           (do (io/write-id out sc/id-record-lg) (io/write-bytes-md out class-name-ba)) ; Unrealistic
-      :else             (truss/ex-info! "Record class name too long" {:name class-name}))
-
-    (-freeze-without-meta! (into {} x) out)))
-
-(freezer IType nil true
-  (let [c (class x)]
-    (io/write-id  out sc/id-type)
-    (io/write-str out (.getName c))
-    (run! (fn [^java.lang.reflect.Field f] (-freeze-without-meta! (.get f x) out))
-      (impl/get-basis-fields c))))
-
-(enc/compile-if java.time.Instant
-  (freezer      java.time.Instant sc/id-time-instant true
-    (do
-      (.writeLong out (.getEpochSecond x))
-      (.writeInt  out (.getNano        x)))))
-
-(enc/compile-if java.time.Duration
-  (freezer      java.time.Duration sc/id-time-duration true
-    (do
-      (.writeLong out (.getSeconds x))
-      (.writeInt  out (.getNano    x)))))
-
-(enc/compile-if java.time.Period
-  (freezer      java.time.Period sc/id-time-period true
-    (do
-      (.writeInt out (.getYears  x))
-      (.writeInt out (.getMonths x))
-      (.writeInt out (.getDays   x)))))
-
-(defn ^:no-doc ^:deprecated try-write-serializable [out x] (truss/catching :all (io/write-serializable out x)))
-(defn ^:no-doc ^:deprecated try-write-readable     [out x] (truss/catching :all (io/write-readable     out x)))
-
-(defn write-unfreezable [out x]
-  (-freeze-without-meta!
-    {:nippy/unfreezable
-     {:type    (type            x)
-      :content (impl/try-pr-edn x)}}
-    out))
-
-(freezer Object nil nil
-  (do
-    (impl/when-debug (println (str "freeze-fallback: " (type x))))
-    (if-let [ff *freeze-fallback*]
-      (if-not (identical? ff :write-unfreezable)
-        (ff out x) ; Modern approach with ff
-        (or        ; Legacy approach with ff
-          (try-write-serializable out x)
-          (try-write-readable     out x)
-          (write-unfreezable      out x)))
-
-      ;; Without ff
-      (enc/cond
-        :let [[r1 e1] (try [(io/write-serializable out x)] (catch Throwable t [nil t]))], r1 r1
-        :let [[r2 e2] (try [(io/write-readable     out x)] (catch Throwable t [nil t]))], r2 r2
-
-        :if-let [fff *final-freeze-fallback*] (fff out x) ; Deprecated
-        :else
-        (let [t (type x)]
-          (truss/ex-info! (str "Failed to freeze type: " t)
-            (enc/assoc-some
-              {:type   t
-               :as-str (impl/try-pr-edn x)}
-              {:serializable-error e1
-               :readable-error     e2})
-            (or e1 e2)))))))
-
 ;;;; Freeze API
 
 (defn freeze
@@ -576,11 +390,11 @@
              (when-not no-header? ; Avoid `wrap-header`'s array copy:
                (let [head-ba (sc/get-head-ba {:compressor-id nil :encryptor-id nil})]
                  (.write dos head-ba 0 4)))
-             (impl/with-cache (-freeze-with-meta! x dos))
+             (impl/with-cache (io/write-typed+meta x dos))
              (.toByteArray baos))
 
            (do
-             (impl/with-cache (-freeze-with-meta! x dos))
+             (impl/with-cache (io/write-typed+meta x dos))
              (let [ba (.toByteArray baos)
 
                    compressor
@@ -626,13 +440,13 @@
   ^bytes [x]
   (let [baos (ByteArrayOutputStream. 64)
         dos  (DataOutputStream. baos)]
-    (impl/with-cache (-freeze-with-meta! x dos))
+    (impl/with-cache (io/write-typed+meta x dos))
     (.toByteArray baos)))
 
 (defn freeze-to-out!
   "Low-level util. Serializes given arg (any Clojure data type) to given `DataOutput`.
   In most cases you want `freeze` instead."
-  [^DataOutput data-output x] (-freeze-with-meta! x data-output))
+  [^DataOutput data-output x] (io/write-typed+meta x data-output))
 
 (defn freeze-to-string
   "Like `freeze`, but returns a Base64-encoded string.
@@ -848,9 +662,8 @@
           `(io/write-id ~out ~(impl/coerce-custom-type-id custom-type-id)))]
 
     `(extend-type ~type
-       IFreezable
-       (~'-freezable?           [~'_] true)
-       (~'-freeze-without-meta! [~x ~(with-meta out {:tag 'java.io.DataOutput})] ~write-id-form ~@body))))
+       impl/IFreezable      (~'freezable?  [~'_] true)
+       io/IWriteTypedNoMeta (~'write-typed [~x ~(with-meta out {:tag 'java.io.DataOutput})] ~write-id-form ~@body))))
 
 (defmacro extend-thaw
   "Extends Nippy to support thawing of a custom type with given id:
@@ -901,7 +714,7 @@
 
    (or
      (and
-       (-freezable? x)
+       (impl/freezable? x)
        (and
          (or
            (not recursive?) (not (coll? x))
@@ -943,7 +756,7 @@
   (do            (inspect-ba (freeze "hello")))
   (seq (:data-ba (inspect-ba (freeze "hello")))))
 
-(enc/defaliases io/read-quarantined-serializable-object-unsafe!)
+(enc/defalias io/read-quarantined-serializable-object-unsafe!)
 
 (comment
   (read-quarantined-serializable-object-unsafe!
@@ -958,6 +771,11 @@
     (mapv meta
       (thaw (freeze [(cache v1) (cache v2) (cache v1) (cache v2)])))))
 
+(enc/defalias io/write-unfreezable)
+
+(defn ^:no-doc ^:deprecated try-write-serializable [dout x] (truss/catching :all (io/write-serializable dout x)))
+(defn ^:no-doc ^:deprecated try-write-readable     [dout x] (truss/catching :all (io/write-readable     dout x)))
+
 ;;;; Stress data (for tests, benching, etc.)
 
 (defrecord StressRecord [x])

src/taoensso/nippy/impl.clj

@@ -329,6 +329,8 @@
 
 ;;;;
 
+(defprotocol IFreezable (freezable? [_] "Returns truthy iff given arg has a native Nippy freeze implementation."))
+
 (def array-class-ints    (Class/forName "[I")) ; ^ints
 (def array-class-longs   (Class/forName "[J")) ; ^longs
 (def array-class-floats  (Class/forName "[F")) ; ^floats