Misc minor optimizations, housekeeping
This commit is contained in:
Peter Taoussanis
parent
f4521f78b3
commit
773180ef65
4 changed files with 139 additions and 96 deletions
|
|
@ -28,6 +28,8 @@
|
|||
(set! *unchecked-math* false)
|
||||
(thaw (freeze stress-data)))
|
||||
|
||||
;; Performance would benefit from ^:static support / direct linking / etc.
|
||||
|
||||
;;;; Nippy data format
|
||||
;; * 4-byte header (Nippy v2.x+) (may be disabled but incl. by default) [1]
|
||||
;; { * 1-byte type id
|
||||
|
|
@ -40,7 +42,7 @@
|
|||
;; * Supports :auto freeze compressor (since this depends on :auto thaw
|
||||
;; compressor)
|
||||
;;
|
||||
;; [2] See `Freezable` protocol for type-specific payload formats,
|
||||
;; [2] See `IFreezable1` protocol for type-specific payload formats,
|
||||
;; `thaw-from-in!` for reference type-specific thaw implementations
|
||||
;;
|
||||
(def ^:private ^:const charset "UTF-8")
|
||||
|
|
@ -234,6 +236,8 @@
|
|||
;;;; Dynamic config
|
||||
;; See also `nippy.tools` ns for further dynamic config support
|
||||
|
||||
;; TODO Switch to thread-local proxies?
|
||||
|
||||
(enc/defonce* ^:dynamic *freeze-fallback* "(fn [data-output x]), nil => default" nil)
|
||||
(enc/defonce* ^:dynamic *custom-readers* "{<hash-or-byte-id> (fn [data-input])}" nil)
|
||||
(enc/defonce* ^:dynamic *auto-freeze-compressor*
|
||||
|
|
@ -249,11 +253,6 @@
|
|||
|
||||
;;;; Freezing
|
||||
|
||||
(defprotocol Freezable
|
||||
"Implementation detail. Be careful about extending to interfaces,
|
||||
Ref. http://goo.gl/6gGRlU."
|
||||
(-freeze-to-out! [this out]))
|
||||
|
||||
#_(do
|
||||
(defmacro write-id [out id] `(.writeByte ~out ~id))
|
||||
|
||||
|
|
@ -300,6 +299,26 @@
|
|||
(defmacro ^:private read-md-count [in] `(.readShort ~in))
|
||||
(defmacro ^:private read-lg-count [in] `(.readInt ~in)))
|
||||
|
||||
; We extend `IFreezable1` to supported types:
|
||||
(defprotocol IFreezable1 (-freeze-without-meta! [x data-output]))
|
||||
(defprotocol IFreezable2 (-freeze-with-meta! [x data-output]))
|
||||
(extend-protocol IFreezable2 ; Must be a separate protocol
|
||||
clojure.lang.IMeta
|
||||
(-freeze-with-meta! [x ^DataOutput data-output]
|
||||
(let [m (.meta x)]
|
||||
(when m
|
||||
(write-id data-output id-meta)
|
||||
(-freeze-without-meta! m data-output)))
|
||||
(-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)))
|
||||
|
||||
(defn- write-bytes-sm [^DataOutput out ^bytes ba]
|
||||
(let [len (alength ba)]
|
||||
;; (byte len)
|
||||
|
|
@ -438,8 +457,6 @@
|
|||
(defmacro ^:private -run! [proc coll] `(do (reduce #(~proc %2) nil ~coll) nil))
|
||||
(defmacro ^:private -run-kv! [proc m] `(do (reduce-kv #(~proc %2 %3) nil ~m) nil))
|
||||
|
||||
(declare freeze-to-out!)
|
||||
|
||||
(defn- write-vec [^DataOutput out v]
|
||||
(let [cnt (count v)]
|
||||
(if (zero? cnt)
|
||||
|
|
@ -462,7 +479,7 @@
|
|||
(do (write-id out id-vec-lg)
|
||||
(write-lg-count out cnt)))
|
||||
|
||||
(-run! (fn [in] (freeze-to-out! out in)) v)))))
|
||||
(-run! (fn [in] (-freeze-with-meta! in out)) v)))))
|
||||
|
||||
(defn- write-kvs
|
||||
([^DataOutput out id-lg coll]
|
||||
|
|
@ -471,8 +488,8 @@
|
|||
(write-lg-count out cnt)
|
||||
(-run-kv!
|
||||
(fn [k v]
|
||||
(freeze-to-out! out k)
|
||||
(freeze-to-out! out v))
|
||||
(-freeze-with-meta! k out)
|
||||
(-freeze-with-meta! v out))
|
||||
coll)))
|
||||
|
||||
([^DataOutput out id-empty id-sm id-md id-lg coll]
|
||||
|
|
@ -495,8 +512,8 @@
|
|||
|
||||
(-run-kv!
|
||||
(fn [k v]
|
||||
(freeze-to-out! out k)
|
||||
(freeze-to-out! out v))
|
||||
(-freeze-with-meta! k out)
|
||||
(-freeze-with-meta! v out))
|
||||
coll))))))
|
||||
|
||||
(defn- write-counted-coll
|
||||
|
|
@ -505,7 +522,7 @@
|
|||
;; (assert (counted? coll))
|
||||
(write-id out id-lg)
|
||||
(write-lg-count out cnt)
|
||||
(-run! (fn [in] (freeze-to-out! out in)) coll)))
|
||||
(-run! (fn [in] (-freeze-with-meta! in out)) coll)))
|
||||
|
||||
([^DataOutput out id-empty id-sm id-md id-lg coll]
|
||||
(let [cnt (count coll)]
|
||||
|
|
@ -526,14 +543,14 @@
|
|||
(do (write-id out id-lg)
|
||||
(write-lg-count out cnt)))
|
||||
|
||||
(-run! (fn [in] (freeze-to-out! out in)) coll))))))
|
||||
(-run! (fn [in] (-freeze-with-meta! in out)) coll))))))
|
||||
|
||||
(defn- write-uncounted-coll
|
||||
([^DataOutput out id-lg coll]
|
||||
;; (assert (not (counted? coll)))
|
||||
(let [bas (ByteArrayOutputStream. 32)
|
||||
sout (DataOutputStream. bas)
|
||||
^long cnt (reduce (fn [^long cnt in] (freeze-to-out! sout in) (unchecked-inc cnt)) 0 coll)
|
||||
^long cnt (reduce (fn [^long cnt in] (-freeze-with-meta! in sout) (unchecked-inc cnt)) 0 coll)
|
||||
ba (.toByteArray bas)]
|
||||
|
||||
(write-id out id-lg)
|
||||
|
|
@ -543,7 +560,7 @@
|
|||
([^DataOutput out id-empty id-sm id-md id-lg coll]
|
||||
(let [bas (ByteArrayOutputStream. 32)
|
||||
sout (DataOutputStream. bas)
|
||||
^long cnt (reduce (fn [^long cnt in] (freeze-to-out! sout in) (unchecked-inc cnt)) 0 coll)
|
||||
^long cnt (reduce (fn [^long cnt in] (-freeze-with-meta! in sout) (unchecked-inc cnt)) 0 coll)
|
||||
ba (.toByteArray bas)]
|
||||
|
||||
(if (zero? cnt)
|
||||
|
|
@ -597,8 +614,8 @@
|
|||
|
||||
(-run-kv!
|
||||
(fn [k v]
|
||||
(freeze-to-out! out k)
|
||||
(freeze-to-out! out v))
|
||||
(-freeze-with-meta! k out)
|
||||
(-freeze-with-meta! v out))
|
||||
m)))))
|
||||
|
||||
;; Micro-optimization:
|
||||
|
|
@ -621,7 +638,7 @@
|
|||
(do (write-id out id-set-lg)
|
||||
(write-lg-count out cnt)))
|
||||
|
||||
(-run! (fn [in] (freeze-to-out! out in)) s)))))
|
||||
(-run! (fn [in] (-freeze-with-meta! in out)) s)))))
|
||||
|
||||
(defn- write-serializable [^DataOutput out x]
|
||||
(when-debug (println (str "write-serializable: " (type x))))
|
||||
|
|
@ -680,7 +697,7 @@
|
|||
(catch Throwable _ :nippy/unprintable)))))
|
||||
|
||||
(defn write-unfreezable [out x]
|
||||
(-freeze-to-out!
|
||||
(-freeze-without-meta!
|
||||
{:type (type x)
|
||||
:nippy/unfreezable (try-pr-edn x)}
|
||||
out))
|
||||
|
|
@ -691,40 +708,47 @@
|
|||
{:type (type x)
|
||||
:as-str (try-pr-edn x)})))
|
||||
|
||||
;; Public `-freeze-with-meta!` with different arg order
|
||||
(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."
|
||||
;; Basically just wraps `-freeze-to-out!` with different arg order + metadata support
|
||||
[^DataOutput data-output x]
|
||||
(when (.isInstance clojure.lang.IMeta x) ; Rare
|
||||
(when-let [m (meta x)]
|
||||
(write-id data-output id-meta)
|
||||
(-freeze-to-out! m data-output)))
|
||||
(-freeze-to-out! x data-output))
|
||||
[^DataOutput data-output x] (-freeze-with-meta! x data-output))
|
||||
|
||||
(defmacro ^:private freezer [type & body]
|
||||
`(extend-type ~type Freezable
|
||||
(~'-freeze-to-out! [~'x ~(with-meta 'out {:tag 'DataOutput})]
|
||||
`(extend-type ~type IFreezable1
|
||||
(~'-freeze-without-meta! [~'x ~(with-meta 'out {:tag 'DataOutput})]
|
||||
~@body)))
|
||||
|
||||
(defmacro ^:private id-freezer [type id & body]
|
||||
`(extend-type ~type Freezable
|
||||
(~'-freeze-to-out! [~'x ~(with-meta 'out {:tag 'DataOutput})]
|
||||
`(extend-type ~type IFreezable1
|
||||
(~'-freeze-without-meta! [~'x ~(with-meta 'out {:tag 'DataOutput})]
|
||||
(write-id ~'out ~id)
|
||||
~@body)))
|
||||
|
||||
;;;; Caching ; Experimental
|
||||
;; How much point is there in offering this feature if we already have LZ4?
|
||||
|
||||
(def ^:dynamic ^:private *cache_* "{<x> <cache-idx>}" nil)
|
||||
(defmacro ^:private with-cache [& body]
|
||||
`(binding [*cache_* (enc/-vol! nil)] ~@body))
|
||||
;; Nb: don't use an auto initialValue; can cause thread-local state to
|
||||
;; accidentally hang around with the use of `freeze-to-out!`, etc.
|
||||
;; Safer to require explicit activation through `with-cache`.
|
||||
(def ^ThreadLocal -cache-proxy (proxy [ThreadLocal] []))
|
||||
|
||||
(defrecord CacheWrapped [value])
|
||||
(defmacro ^:private with-cache
|
||||
"Experimental! Executes body with support for freezing and thawing
|
||||
cached values. See also `cache`."
|
||||
[& body]
|
||||
`(try
|
||||
(.set -cache-proxy (enc/-vol! nil))
|
||||
(do ~@body)
|
||||
(finally (.remove -cache-proxy))))
|
||||
|
||||
(deftype CacheWrapped [val])
|
||||
(defn cache
|
||||
"Experimental! Wraps value so that future writes of the same wrapped
|
||||
value will be efficiently encoded as references to this one.
|
||||
|
||||
**NB**: Ignores metadata!
|
||||
|
||||
(freeze [(cache \"foo\") (cache \"foo\") (cache \"foo\")])
|
||||
will incl. a single \"foo\", plus 2x single-byte references to \"foo\"."
|
||||
[x]
|
||||
|
|
@ -733,8 +757,8 @@
|
|||
(comment (cache "foo"))
|
||||
|
||||
(freezer CacheWrapped
|
||||
(let [x-val (:value x)]
|
||||
(if-let [cache_ *cache_*]
|
||||
(let [x-val (.-val x)]
|
||||
(if-let [cache_ (.get -cache-proxy)]
|
||||
(let [cache @cache_
|
||||
?idx (get cache x-val)
|
||||
^int idx (or ?idx
|
||||
|
|
@ -748,41 +772,45 @@
|
|||
(sm-count? idx)
|
||||
(case (int idx)
|
||||
0 (do (write-id out id-cached-0)
|
||||
(when first-occurance? (-freeze-to-out! x-val out)))
|
||||
(when first-occurance? (-freeze-without-meta! x-val out)))
|
||||
1 (do (write-id out id-cached-1)
|
||||
(when first-occurance? (-freeze-to-out! x-val out)))
|
||||
(when first-occurance? (-freeze-without-meta! x-val out)))
|
||||
2 (do (write-id out id-cached-2)
|
||||
(when first-occurance? (-freeze-to-out! x-val out)))
|
||||
(when first-occurance? (-freeze-without-meta! x-val out)))
|
||||
3 (do (write-id out id-cached-3)
|
||||
(when first-occurance? (-freeze-to-out! x-val out)))
|
||||
(when first-occurance? (-freeze-without-meta! x-val out)))
|
||||
4 (do (write-id out id-cached-4)
|
||||
(when first-occurance? (-freeze-to-out! x-val out)))
|
||||
(when first-occurance? (-freeze-without-meta! x-val out)))
|
||||
|
||||
(do (write-id out id-cached-sm)
|
||||
(write-sm-count out idx)
|
||||
(when first-occurance? (-freeze-to-out! x-val out))))
|
||||
(when first-occurance? (-freeze-without-meta! x-val out))))
|
||||
|
||||
(md-count? idx)
|
||||
(do (write-id out id-cached-md)
|
||||
(write-md-count out idx)
|
||||
(when first-occurance? (-freeze-to-out! x-val out)))
|
||||
(when first-occurance? (-freeze-without-meta! x-val out)))
|
||||
|
||||
:else
|
||||
;; (throw (ex-info "Max cache size exceeded" {:idx idx}))
|
||||
(-freeze-to-out! x-val out) ; Just freeze uncached
|
||||
(-freeze-without-meta! x-val out) ; Just freeze uncached
|
||||
))
|
||||
|
||||
(-freeze-to-out! x-val out))))
|
||||
(-freeze-without-meta! x-val out))))
|
||||
|
||||
(declare thaw-from-in!)
|
||||
(defn- thaw-cached [idx in]
|
||||
(if-let [cache_ *cache_*]
|
||||
(if-let [e (find @cache_ idx)]
|
||||
(val e)
|
||||
(let [x (thaw-from-in! in)]
|
||||
(enc/-vol-swap! cache_ assoc idx x)
|
||||
x))
|
||||
(throw (ex-info "No *cache_* binding established, can't thaw" {}))))
|
||||
(def ^:private thaw-cached
|
||||
(let [not-found (Object.)]
|
||||
(fn [idx in]
|
||||
(if-let [cache_ (.get -cache-proxy)]
|
||||
(let [v (get @cache_ idx not-found)]
|
||||
(if (identical? v not-found)
|
||||
(let [x (thaw-from-in! in)]
|
||||
(enc/-vol-swap! cache_ assoc idx x)
|
||||
x)
|
||||
v))
|
||||
(throw (ex-info "No cache_ established, can't thaw. See `with-cache`."
|
||||
{}))))))
|
||||
|
||||
(comment (thaw (freeze [(cache "foo") (cache "foo") (cache "foo")])))
|
||||
|
||||
|
|
@ -845,7 +873,7 @@
|
|||
(do (write-id out id-record-md)
|
||||
(write-bytes-md out cname-ba)))
|
||||
|
||||
(-freeze-to-out! (into {} x) out)))
|
||||
(-freeze-without-meta! (into {} x) out)))
|
||||
|
||||
(freezer Object
|
||||
(when-debug (println (str "freeze-fallback: " (type x))))
|
||||
|
|
@ -897,7 +925,7 @@
|
|||
[x]
|
||||
(let [baos (ByteArrayOutputStream. 64)
|
||||
dos (DataOutputStream. baos)]
|
||||
(with-cache (freeze-to-out! dos x))
|
||||
(with-cache (-freeze-with-meta! x dos))
|
||||
(.toByteArray baos)))
|
||||
|
||||
(defn freeze
|
||||
|
|
@ -909,7 +937,8 @@
|
|||
encryptor aes128-encryptor}
|
||||
:as opts}]
|
||||
(let [;; Intentionally undocumented:
|
||||
no-header? (or (:no-header? opts) (:skip-header? opts))
|
||||
no-header? (or (get opts :no-header?)
|
||||
(get opts :skip-header?))
|
||||
encryptor (when password encryptor)
|
||||
baos (ByteArrayOutputStream. 64)
|
||||
dos (DataOutputStream. baos)]
|
||||
|
|
@ -919,11 +948,11 @@
|
|||
(when-not no-header? ; Avoid `wrap-header`'s array copy:
|
||||
(let [head-ba (get-head-ba {:compressor-id nil :encryptor-id nil})]
|
||||
(.write dos head-ba 0 4)))
|
||||
(with-cache (freeze-to-out! dos x))
|
||||
(with-cache (-freeze-with-meta! x dos))
|
||||
(.toByteArray baos))
|
||||
|
||||
(do
|
||||
(with-cache (freeze-to-out! dos x))
|
||||
(with-cache (-freeze-with-meta! x dos))
|
||||
(let [ba (.toByteArray baos)
|
||||
|
||||
compressor
|
||||
|
|
@ -1179,15 +1208,16 @@
|
|||
(throw (ex-info (str "Thaw failed against type-id: " type-id)
|
||||
{:type-id type-id} e))))))
|
||||
|
||||
(defn- try-parse-header [^bytes ba]
|
||||
(let [len (alength ba)]
|
||||
(when (> len 4)
|
||||
(let [-head-sig (java.util.Arrays/copyOf ba 3)]
|
||||
(when (java.util.Arrays/equals -head-sig ^bytes head-sig)
|
||||
;; Header appears to be well-formed
|
||||
(let [meta-id (aget ba 3)
|
||||
data-ba (java.util.Arrays/copyOfRange ba 4 len)]
|
||||
[data-ba (get head-meta meta-id {:unrecognized-meta? true})]))))))
|
||||
(let [head-sig head-sig] ; Not ^:const
|
||||
(defn- try-parse-header [^bytes ba]
|
||||
(let [len (alength ba)]
|
||||
(when (> len 4)
|
||||
(let [-head-sig (java.util.Arrays/copyOf ba 3)]
|
||||
(when (java.util.Arrays/equals -head-sig ^bytes head-sig)
|
||||
;; Header appears to be well-formed
|
||||
(let [meta-id (aget ba 3)
|
||||
data-ba (java.util.Arrays/copyOfRange ba 4 len)]
|
||||
[data-ba (get head-meta meta-id {:unrecognized-meta? true})])))))))
|
||||
|
||||
(defn- get-auto-compressor [compressor-id]
|
||||
(case compressor-id
|
||||
|
|
@ -1246,17 +1276,17 @@
|
|||
encryptor :auto}
|
||||
:as opts}]
|
||||
|
||||
(assert (not (:headerless-meta opts))
|
||||
(assert (not (get opts :headerless-meta))
|
||||
":headerless-meta `thaw` opt removed in Nippy v2.7+")
|
||||
|
||||
(let [v2+? (not v1-compatibility?)
|
||||
no-header? (:no-header? opts) ; Intentionally undocumented
|
||||
no-header? (get opts :no-header?) ; Intentionally undocumented
|
||||
ex (fn ex
|
||||
([ msg] (ex nil msg))
|
||||
([e msg] (throw (ex-info (str "Thaw failed: " msg)
|
||||
{:opts (merge opts
|
||||
{:compressor compressor
|
||||
:encryptor encryptor})}
|
||||
{:opts (assoc opts
|
||||
:compressor compressor
|
||||
:encryptor encryptor)}
|
||||
e))))
|
||||
|
||||
thaw-data
|
||||
|
|
@ -1353,16 +1383,18 @@
|
|||
* Keyword - 2 byte overhead, resistent to id collisions
|
||||
* Integer ∈[1, 128] - no overhead, subject to id collisions
|
||||
|
||||
(defrecord MyType [data])
|
||||
(extend-freeze MyType :foo/my-type [x data-output] ; Keyword id
|
||||
NB: be careful about extending to interfaces, Ref. http://goo.gl/6gGRlU.
|
||||
|
||||
(defrecord MyRec [data])
|
||||
(extend-freeze MyRec :foo/my-type [x data-output] ; Keyword id
|
||||
(.writeUTF [data-output] (:data x)))
|
||||
;; or
|
||||
(extend-freeze MyType 1 [x data-output] ; Byte id
|
||||
(extend-freeze MyRec 1 [x data-output] ; Byte id
|
||||
(.writeUTF [data-output] (:data x)))"
|
||||
[type custom-type-id [x out] & body]
|
||||
(assert-custom-type-id custom-type-id)
|
||||
`(extend-type ~type Freezable
|
||||
(~'-freeze-to-out! [~x ~(with-meta out {:tag 'java.io.DataOutput})]
|
||||
`(extend-type ~type IFreezable1
|
||||
(~'-freeze-without-meta! [~x ~(with-meta out {:tag 'java.io.DataOutput})]
|
||||
(if-not ~(keyword? custom-type-id)
|
||||
;; Unprefixed [cust byte id][payload]:
|
||||
(write-id ~out ~(coerce-custom-type-id custom-type-id))
|
||||
|
|
@ -1374,10 +1406,10 @@
|
|||
(defmacro extend-thaw
|
||||
"Extends Nippy to support thawing of a custom type with given id:
|
||||
(extend-thaw :foo/my-type [data-input] ; Keyword id
|
||||
(MyType. (.readUTF data-input)))
|
||||
(MyRec. (.readUTF data-input)))
|
||||
;; or
|
||||
(extend-thaw 1 [data-input] ; Byte id
|
||||
(MyType. (.readUTF data-input)))"
|
||||
(MyRec. (.readUTF data-input)))"
|
||||
[custom-type-id [in] & body]
|
||||
(assert-custom-type-id custom-type-id)
|
||||
`(do
|
||||
|
|
@ -1393,10 +1425,10 @@
|
|||
|
||||
(comment
|
||||
*custom-readers*
|
||||
(defrecord MyType [data])
|
||||
(extend-freeze MyType 1 [x out] (.writeUTF out (:data x)))
|
||||
(extend-thaw 1 [in] (MyType. (.readUTF in)))
|
||||
(thaw (freeze (MyType. "Joe"))))
|
||||
(defrecord MyRec [data])
|
||||
(extend-freeze MyRec 1 [x out] (.writeUTF out (:data x)))
|
||||
(extend-thaw 1 [in] (MyRec. (.readUTF in)))
|
||||
(thaw (freeze (MyRec. "Joe"))))
|
||||
|
||||
;;;; Stress data
|
||||
|
||||
|
|
|
|||
|
|
@ -62,6 +62,11 @@
|
|||
;; (bench {:reader? true :lzma2? true :fressian? true :laps 2})
|
||||
;; (bench {:laps 2})
|
||||
|
||||
;;; 2016 Jul 17, v2.12.0-RC2, minor final optimizations
|
||||
{:encrypted {:round 4527, :freeze 2651, :thaw 1876, :size 16324}}
|
||||
{:default {:round 3998, :freeze 2226, :thaw 1772, :size 16297}}
|
||||
{:fast {:round 3408, :freeze 1745, :thaw 1663, :size 17069}}
|
||||
|
||||
;;; 2016 Apr 14, v2.12.0-SNAPSHOT, refactor + larger data + new hardware
|
||||
{:reader {:round 52380, :freeze 17817, :thaw 34563, :size 27861}}
|
||||
{:lzma2 {:round 43321, :freeze 28312, :thaw 15009, :size 11260}}
|
||||
|
|
|
|||
|
|
@ -70,7 +70,7 @@
|
|||
|
||||
(comment (destructure-typed-pwd [:salted "foo"]))
|
||||
|
||||
(defrecord AES128Encryptor [header-id keyfn cached-keyfn]
|
||||
(deftype AES128Encryptor [header-id keyfn cached-keyfn]
|
||||
IEncryptor
|
||||
(header-id [_] header-id)
|
||||
(encrypt [_ typed-pwd data-ba]
|
||||
|
|
|
|||
|
|
@ -3,40 +3,46 @@
|
|||
Used by Carmine, Faraday, etc."
|
||||
(:require [taoensso.nippy :as nippy]))
|
||||
|
||||
;; TODO Switch to thread-local proxies?
|
||||
|
||||
(def ^:dynamic *freeze-opts* nil)
|
||||
(def ^:dynamic *thaw-opts* nil)
|
||||
|
||||
(defmacro with-freeze-opts [opts & body] `(binding [*freeze-opts* ~opts] ~@body))
|
||||
(defmacro with-thaw-opts [opts & body] `(binding [*thaw-opts* ~opts] ~@body))
|
||||
|
||||
(defrecord WrappedForFreezing [value opts])
|
||||
(deftype WrappedForFreezing [val opts])
|
||||
(defn wrapped-for-freezing? [x] (instance? WrappedForFreezing x))
|
||||
(defn wrap-for-freezing
|
||||
(defn wrap-for-freezing
|
||||
"Ensures that given arg (any freezable data type) is wrapped so that
|
||||
(tools/freeze <wrapped-arg>) will serialize as
|
||||
(nippy/freeze <unwrapped-arg> <opts>)."
|
||||
([x ] (wrap-for-freezing x nil))
|
||||
([x opts]
|
||||
(if (wrapped-for-freezing? x)
|
||||
(if (= (:opts x) opts)
|
||||
x
|
||||
(WrappedForFreezing. (:value x) opts))
|
||||
(if (instance? WrappedForFreezing x)
|
||||
(let [^WrappedForFreezing x x]
|
||||
(if (= (.-opts x) opts)
|
||||
x
|
||||
(WrappedForFreezing. (.-val x) opts)))
|
||||
(WrappedForFreezing. x opts))))
|
||||
|
||||
(defn freeze
|
||||
"Like `nippy/freeze` but merges opts from *freeze-opts*, `wrap-for-freezing`."
|
||||
([x ] (freeze x nil))
|
||||
([x default-opts]
|
||||
(let [default-opts (or (:default-opts default-opts) default-opts)] ; Back compat
|
||||
(if (wrapped-for-freezing? x)
|
||||
(nippy/freeze (:value x) (merge default-opts *freeze-opts* (:opts x)))
|
||||
(let [;; For back compatibility:
|
||||
default-opts (get default-opts :default-opts default-opts)]
|
||||
(if (instance? WrappedForFreezing x)
|
||||
(let [^WrappedForFreezing x x]
|
||||
(nippy/freeze (.-val x) (merge default-opts *freeze-opts* (.-opts x))))
|
||||
(nippy/freeze x default-opts)))))
|
||||
|
||||
(defn thaw
|
||||
"Like `nippy/thaw` but merges opts from `*thaw-opts*`."
|
||||
([ba ] (thaw ba nil))
|
||||
([ba default-opts]
|
||||
(let [default-opts (or (:default-opts default-opts) default-opts)] ; Back compat
|
||||
(let [;; For back compatibility:
|
||||
default-opts (get default-opts :default-opts default-opts)]
|
||||
(nippy/thaw ba (merge default-opts *thaw-opts*)))))
|
||||
|
||||
(comment (thaw (freeze (wrap-for-freezing "wrapped"))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue