[new] [#171] Auto strip metadata protocol extensions

Allows serialization of next.jdbc results, etc.
This commit is contained in:
Peter Taoussanis 2024-04-08 19:11:11 +02:00
parent 92c4a83d61
commit 37cf415c02
2 changed files with 31 additions and 11 deletions

View file

@ -203,6 +203,8 @@
48 [:record-sm [[:bytes {:read 1}] [:elements 1]]] 48 [:record-sm [[:bytes {:read 1}] [:elements 1]]]
49 [:record-md [[:bytes {:read 2}] [:elements 1]]] 49 [:record-md [[:bytes {:read 2}] [:elements 1]]]
104 [:meta-protocol-key []]
;; Necessarily without size information ;; Necessarily without size information
81 [:type nil] 81 [:type nil]
82 [:prefixed-custom-md nil] 82 [:prefixed-custom-md nil]
@ -589,13 +591,15 @@
(defmacro write-id [out id] `(.writeByte ~out ~id)) (defmacro write-id [out id] `(.writeByte ~out ~id))
(declare write-map)
(extend-protocol IFreezableWithMeta (extend-protocol IFreezableWithMeta
clojure.lang.IObj ; IMeta => `meta` will work, IObj => `with-meta` will work clojure.lang.IObj ; IMeta => `meta` will work, IObj => `with-meta` will work
(-freeze-with-meta! [x ^DataOutput data-output] (-freeze-with-meta! [x ^DataOutput data-output]
(when-let [m (when *incl-metadata?* (meta x))] (when-let [m (when *incl-metadata?* (meta x))]
(write-id data-output id-meta) (write-id data-output id-meta)
(-freeze-without-meta! m data-output)) (write-map data-output m :is-metadata))
(-freeze-without-meta! x data-output)) (-freeze-without-meta! x data-output))
nil (-freeze-with-meta! [x 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))) Object (-freeze-with-meta! [x data-output] (-freeze-without-meta! x data-output)))
@ -815,7 +819,7 @@
;; Micro-optimization: ;; Micro-optimization:
;; As (write-kvs out id-map-0 id-map-sm id-map-md id-map-lg x) ;; As (write-kvs out id-map-0 id-map-sm id-map-md id-map-lg x)
(defn- write-map [^DataOutput out m] (defn- write-map [^DataOutput out m is-metadata?]
(let [cnt (count m)] (let [cnt (count m)]
(if (zero? cnt) (if (zero? cnt)
(write-id out id-map-0) (write-id out id-map-0)
@ -827,10 +831,19 @@
(-run-kv! (-run-kv!
(fn [k v] (fn [k v]
(-freeze-with-meta! k out) (if (and is-metadata? (fn? v) (qualified-symbol? k))
(-freeze-with-meta! v out)) (do
;; Strip Clojure v1.10+ metadata protocol extensions
;; (used by defprotocol `:extend-via-metadata`)
(write-id out id-meta-protocol-key)
(write-id out id-nil))
(do
(-freeze-with-meta! k out)
(-freeze-with-meta! v out))))
m))))) m)))))
(comment (meta (thaw (freeze (with-meta [] {:a :A, 'b/c (fn [])})))))
;; Micro-optimization: ;; Micro-optimization:
;; As (write-counted-coll out id-set-0 id-set-sm id-set-md id-set-lg x) ;; As (write-counted-coll out id-set-0 id-set-sm id-set-md id-set-lg x)
(defn- write-set [^DataOutput out s] (defn- write-set [^DataOutput out s]
@ -1078,7 +1091,7 @@
(freezer PersistentTreeMap nil true (write-kvs out id-sorted-map-lg x)) (freezer PersistentTreeMap nil true (write-kvs out id-sorted-map-lg x))
(freezer APersistentVector nil true (write-vec out x)) (freezer APersistentVector nil true (write-vec out x))
(freezer APersistentSet nil true (write-set out x)) (freezer APersistentSet nil true (write-set out x))
(freezer APersistentMap nil true (write-map out x)) (freezer APersistentMap nil true (write-map out x false))
(freezer PersistentList nil true (write-counted-coll out id-list-0 id-list-sm id-list-md id-list-lg x)) (freezer PersistentList nil true (write-counted-coll out id-list-0 id-list-sm id-list-md id-list-lg x))
(freezer LazySeq nil true (write-uncounted-coll out id-seq-0 id-seq-sm id-seq-md id-seq-lg x)) (freezer LazySeq nil true (write-uncounted-coll out id-seq-0 id-seq-sm id-seq-md id-seq-lg x))
(freezer ISeq nil true (write-coll out id-seq-0 id-seq-sm id-seq-md id-seq-lg x)) (freezer ISeq nil true (write-coll out id-seq-0 id-seq-sm id-seq-md id-seq-lg x))
@ -1519,10 +1532,13 @@
id-true true id-true true
id-false false id-false false
id-char (.readChar in) id-char (.readChar in)
id-meta (let [m (thaw-from-in! in)]
(if *incl-metadata?* id-meta-protocol-key ::meta-protocol-key
(with-meta (thaw-from-in! in) m) id-meta
(do (thaw-from-in! in)))) (let [m (thaw-from-in! in)]
(if *incl-metadata?*
(with-meta (thaw-from-in! in) (dissoc m ::meta-protocol-key))
(do (thaw-from-in! in))))
id-cached-0 (thaw-cached 0 in) id-cached-0 (thaw-cached 0 in)
id-cached-1 (thaw-cached 1 in) id-cached-1 (thaw-cached 1 in)

View file

@ -96,6 +96,10 @@
(is (enc/throws? :ex-info "Unfreezable type" (nippy/freeze (fn [])))) (is (enc/throws? :ex-info "Unfreezable type" (nippy/freeze (fn []))))
(testing "Clojure v1.10+ metadata protocol extensions"
[(is (= (meta (nippy/thaw (nippy/freeze (with-meta [] {:a :A, 'b/c (fn [])})))) {:a :A}))
(is (enc/throws? :ex-info "Unfreezable type" (nippy/freeze (with-meta [] {:a :A, 'b (fn [])}))))])
(is (gen-test 1600 [gen-data] (= gen-data (thaw (freeze gen-data)))) "Generative")]) (is (gen-test 1600 [gen-data] (= gen-data (thaw (freeze gen-data)))) "Generative")])
;;;; Custom types & records ;;;; Custom types & records