Last active
May 10, 2023 15:46
-
-
Save mrrodriguez/5b681b191e96ceb137f768b0942415de to your computer and use it in GitHub Desktop.
Clojure Serialization With Fressian
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;;; Fressian dependency used in these examples | |
;; [org.clojure/data.fressian "0.2.1"] | |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;;;; Using only `org.clojure/data.fressian` | |
(require '[clojure.data.fressian :as fres]) | |
(defn serde-obj | |
"Serializes and deserializes (aka 'serde') the object `obj`." | |
[obj] | |
;; Serialize | |
(with-open [baos (java.io.ByteArrayOutputStream.) | |
wtr (fres/create-writer baos)] | |
(fres/write-object wtr obj) | |
;; Deserialize | |
(with-open [bais (java.io.ByteArrayInputStream. (.toByteArray baos)) | |
rdr (fres/create-reader bais)] | |
(fres/read-object rdr)))) | |
;;;; A few examples: | |
;;;; Persistent set | |
(serde-obj #{1 2 3}) | |
;;= #{1 2 3} | |
(type (serde-obj #{1 2 3})) | |
;;= java.util.HashSet | |
(set? (serde-obj #{1 2 3})) | |
;;;; Persistent sorted (tree) set | |
(serde-obj (sorted-set 1 2 3)) | |
;;= #{1 2 3} | |
(type (serde-obj (sorted-set 1 2 3))) | |
;;= java.util.HashSet | |
(set? (serde-obj (sorted-set 1 2 3))) | |
;;= false | |
(sorted? (serde-obj (sorted-set 1 2 3))) | |
;;= false | |
;;;; Lazy seq | |
(serde-obj (lazy-seq '(1))) | |
;;= [] | |
(type (serde-obj (lazy-seq '(1)))) | |
;;= java.util.Arrays$ArrayList | |
(seq? (serde-obj (lazy-seq '(1)))) | |
;;= false | |
;;;; Metadata | |
(meta (serde-obj (with-meta #{1} {:hello :world}))) | |
;;= nil | |
;;;; Java Class | |
(serde-obj String) | |
;; IllegalArgumentException Cannot write class java.lang.String as tag null <...etc...> | |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;;;; Implementation of custom read/write handlers | |
(import '[org.fressian Writer Reader StreamingWriter]) | |
(defn write-with-meta | |
"Writes the object to the writer under the given tag. If the record has metadata, the metadata | |
will also be written. The optional `write-fn` will be used to write the object if given. If | |
not given, the default is Writer.writeList(). | |
`read-with-meta` (below) will associated this metadata back with the object when reading." | |
([w tag o] | |
(write-with-meta w tag o (fn [^Writer w o] (.writeList w o)))) | |
([^Writer w tag o write-fn] | |
(let [m (meta o)] | |
(do | |
(.writeTag w tag 2) | |
(write-fn w o) | |
(if m | |
(.writeObject w m) | |
(.writeNull w)))))) | |
(defn- read-meta [^Reader rdr] | |
(some->> rdr | |
.readObject | |
(into {}))) | |
(defn read-with-meta | |
"Reads an object from the reader that was written via `write-with-meta` (above). If the object | |
was written with metadata the metadata will be associated on the object returned. The `build-fn` | |
is called on the read object and is used to do any additional construnction necessary for | |
data structure." | |
[^Reader rdr build-fn] | |
(let [o (build-fn (.readObject rdr)) | |
m (read-meta rdr)] | |
(cond-> o | |
m (with-meta m)))) | |
(defn write-map | |
"Writes a map as Fressian with the tag 'map' and all keys cached." | |
[^Writer w m] | |
(.writeTag w "map" 1) | |
(.beginClosedList ^StreamingWriter w) | |
(reduce-kv | |
(fn [^Writer w k v] | |
(.writeObject w k true) | |
(.writeObject w v)) | |
w | |
m) | |
(.endList ^StreamingWriter w)) | |
(require '[clojure.main :as cm]) | |
;;; Use this map to cache the symbol for the map->RecordNameHere factory function created for | |
;;; every Clojure record to improve serialization performance. | |
;;; See https://github.com/cerner/clara-rules/issues/245 for more extensive discussion. | |
(def ^:private ^java.util.Map class->factory-fn-sym | |
(java.util.Collections/synchronizedMap | |
(java.util.WeakHashMap.))) | |
(defn record-map-constructor-name | |
"Return the 'map->' prefix, factory constructor function for a Clojure record." | |
[rec] | |
(let [klass (class rec)] | |
(if-let [cached-sym (.get class->factory-fn-sym klass)] | |
cached-sym | |
(let [class-name (.getName ^Class klass) | |
idx (.lastIndexOf class-name (int \.)) | |
ns-nom (.substring class-name 0 idx) | |
nom (.substring class-name (inc idx)) | |
factory-fn-sym (symbol (str (cm/demunge ns-nom) | |
"/map->" | |
(cm/demunge nom)))] | |
(.put class->factory-fn-sym klass factory-fn-sym) | |
factory-fn-sym)))) | |
(defn write-record | |
"Same as `write-with-meta`, but with Clojure record support. The type of the record will | |
be preserved." | |
[^Writer w tag rec] | |
(let [m (meta rec)] | |
(.writeTag w tag 3) | |
(.writeObject w (record-map-constructor-name rec) true) | |
(write-map w rec) | |
(if m | |
(.writeObject w m) | |
(.writeNull w)))) | |
(defn read-record | |
"Same as `read-with-meta`, but with Clojure record support. The type of the record will | |
be preserved." | |
[^Reader rdr] | |
(let [builder (-> (.readObject rdr) resolve deref) | |
build-map (.readObject rdr) | |
m (read-meta rdr)] | |
(cond-> (builder build-map) | |
m (with-meta m)))) | |
(defn sorted-comparator-name | |
"Sorted collections are not easily serializable since they have an opaque function object instance | |
associated with them. To deal with that, the sorted collection can provide a | |
:fressian.custom/comparator-name in the metadata that indicates a symbolic name for the function | |
used as the comparator. With this name the function can be looked up and associated to the | |
sorted collection again during deserialization time. | |
* If the sorted collection metadata has a :fressian.custom/comparator-name, then the symbol value is returned. | |
* If the sorted collection has the clojure.lang.RT/DEFAULT_COMPARATOR, returns nil. | |
* If neither of the above are true, an exception is thrown indicating that there is no way to provide a useful | |
name for this sorted collection, so it won't be able to be serialized." | |
[^clojure.lang.Sorted s] | |
(let [cname (-> s meta :fressian.custom/comparator-name)] | |
;; Fail if reliable serialization of this sorted coll isn't possible. | |
(when (and (not cname) | |
(not= (.comparator s) clojure.lang.RT/DEFAULT_COMPARATOR)) | |
(throw (ex-info (str "Cannot serialize sorted collection with non-default" | |
" comparator because no :fressian.custom/comparator-name provided in metadata.") | |
{:sorted-coll s | |
:comparator (.comparator s)}))) | |
cname)) | |
(defn seq->sorted-set | |
"Helper to create a sorted set from a seq given an optional comparator." | |
[s ^java.util.Comparator c] | |
(if c | |
(clojure.lang.PersistentTreeSet/create c (seq s)) | |
(clojure.lang.PersistentTreeSet/create (seq s)))) | |
(defn seq->sorted-map | |
"Helper to create a sorted map from a seq given an optional comparator." | |
[s ^java.util.Comparator c] | |
(if c | |
(clojure.lang.PersistentTreeMap/create c ^clojure.lang.ISeq (sequence cat s)) | |
(clojure.lang.PersistentTreeMap/create ^clojure.lang.ISeq (sequence cat s)))) | |
(import '[org.fressian.handlers WriteHandler]) | |
(def write-handlers | |
{;; Persistent set | |
clojure.lang.APersistentSet | |
{"clj/set" | |
(reify WriteHandler | |
(write [_ w o] | |
(write-with-meta w "clj/set" o)))} | |
;; Persistent sorted (tree) set | |
clojure.lang.PersistentTreeSet | |
{"clj/treeset" (reify WriteHandler | |
(write [_ w o] | |
(let [cname (sorted-comparator-name o)] | |
(.writeTag w "clj/treeset" 3) | |
(if cname | |
(.writeObject w cname true) | |
(.writeNull w)) | |
;; Preserve metadata. | |
(if-let [m (meta o)] | |
(.writeObject w m) | |
(.writeNull w)) | |
(.writeList w o))))} | |
;; Persistent sorted (tree) map | |
clojure.lang.PersistentTreeMap | |
{"clj/treemap" (reify WriteHandler | |
(write [_ w o] | |
(let [cname (sorted-comparator-name o)] | |
(.writeTag w "clj/treemap" 3) | |
(if cname | |
(.writeObject w cname true) | |
(.writeNull w)) | |
;; Preserve metadata. | |
(if-let [m (meta o)] | |
(.writeObject w m) | |
(.writeNull w)) | |
(write-map w o))))} | |
;; Persistent vector | |
clojure.lang.APersistentVector | |
{"clj/vector" (reify WriteHandler | |
(write [_ w o] | |
(write-with-meta w "clj/vector" o)))} | |
;; Persistent list | |
;; NOTE: The empty list is a different data type in Clojure and has to be handled separately. | |
clojure.lang.PersistentList | |
{"clj/list" (reify WriteHandler | |
(write [_ w o] | |
(write-with-meta w "clj/list" o)))} | |
clojure.lang.PersistentList$EmptyList | |
{"clj/emptylist" (reify WriteHandler | |
(write [_ w o] | |
(let [m (meta o)] | |
(do | |
(.writeTag w "clj/emptylist" 1) | |
(if m | |
(.writeObject w m) | |
(.writeNull w))))))} | |
;; Persistent seq & lazy seqs | |
clojure.lang.ASeq | |
{"clj/aseq" (reify WriteHandler | |
(write [_ w o] | |
(write-with-meta w "clj/aseq" o)))} | |
clojure.lang.LazySeq | |
{"clj/lazyseq" (reify WriteHandler | |
(write [_ w o] | |
(write-with-meta w "clj/lazyseq" o)))} | |
;; java.lang.Class type | |
Class | |
{"java/class" (reify WriteHandler | |
(write [_ w c] | |
(.writeTag w "java/class" 1) | |
(.writeObject w (symbol (.getName ^Class c)) true)))}}) | |
(import '[org.fressian.handlers ReadHandler]) | |
(def read-handlers | |
{;; Persistent set | |
"clj/set" (reify ReadHandler | |
(read [_ rdr tag component-count] | |
(read-with-meta rdr set))) | |
;; Persistent sorted (tree) set | |
"clj/treeset" (reify ReadHandler | |
(read [_ rdr tag component-count] | |
(let [c (some-> rdr .readObject resolve deref) | |
m (.readObject rdr) | |
s (-> (.readObject rdr) | |
(seq->sorted-set c))] | |
(if m | |
(with-meta s m) | |
s)))) | |
;; Persistent sorted (tree) map | |
"clj/treemap" (reify ReadHandler | |
(read [_ rdr tag component-count] | |
(let [c (some-> rdr .readObject resolve deref) | |
m (.readObject rdr) | |
s (seq->sorted-map (.readObject rdr) c)] | |
(if m | |
(with-meta s m) | |
s)))) | |
;; Persistent vector | |
"clj/vector" (reify ReadHandler | |
(read [_ rdr tag component-count] | |
(read-with-meta rdr vec))) | |
;; Persistent list | |
;; NOTE: The empty list is a different data type in Clojure and has to be handled separately. | |
"clj/list" (reify ReadHandler | |
(read [_ rdr tag component-count] | |
(read-with-meta rdr #(apply list %)))) | |
"clj/emptylist" (reify ReadHandler | |
(read [_ rdr tag component-count] | |
(let [m (read-meta rdr)] | |
(cond-> '() | |
m (with-meta m))))) | |
;; Persistent seq & lazy seqs | |
"clj/aseq" (reify ReadHandler | |
(read [_ rdr tag component-count] | |
(read-with-meta rdr sequence))) | |
"clj/lazyseq" (reify ReadHandler | |
(read [_ rdr tag component-count] | |
(read-with-meta rdr sequence))) | |
;; java.lang.Class type | |
"java/class" (reify ReadHandler | |
(read [_ rdr tag component-count] | |
(resolve (.readObject rdr))))}) | |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
;;;; Results | |
(require '[clojure.data.fressian :as fres]) | |
(def write-handler-lookup | |
(-> write-handlers | |
fres/associative-lookup | |
fres/inheritance-lookup)) | |
(def read-handler-lookup | |
(fres/associative-lookup read-handlers)) | |
(defn serde-obj | |
"Serializes and deserializes (aka 'serde') the object `obj`." | |
[obj] | |
;; Serialize | |
(with-open [baos (java.io.ByteArrayOutputStream.) | |
wtr (fres/create-writer baos :handlers write-handler-lookup)] | |
(fres/write-object wtr obj) | |
;; Deserialize | |
(with-open [bais (java.io.ByteArrayInputStream. (.toByteArray baos)) | |
rdr (fres/create-reader bais :handlers read-handler-lookup)] | |
(fres/read-object rdr)))) | |
;;;; A few examples: | |
;;;; Persistent set | |
(serde-obj #{1 2 3}) | |
;;= #{1 2 3} | |
(type (serde-obj #{1 2 3})) | |
;;= clojure.lang.PersistentHashSet | |
(set? (serde-obj #{1 2 3})) | |
;;= true | |
;;;; Persistent sorted (tree) set | |
(serde-obj (sorted-set 1 2 3)) | |
;;= #{1 2 3} | |
(type (serde-obj (sorted-set 1 2 3))) | |
;;= clojure.lang.PersistentTreeSet | |
(set? (serde-obj (sorted-set 1 2 3))) | |
;;= true | |
(sorted? (serde-obj (sorted-set 1 2 3))) | |
;;= true | |
;;;; Lazy seq | |
(serde-obj (lazy-seq ())) | |
;;= [] | |
(type (serde-obj (lazy-seq '(1)))) | |
;;= clojure.lang.LazySeq | |
(seq? (serde-obj (lazy-seq '(1)))) | |
;;= true | |
;;;; Metadata | |
(meta (serde-obj (with-meta #{1} {:hello :world}))) | |
;;= {:hello :world} | |
;;;; Java Class | |
(serde-obj String) | |
;;= java.lang.String | |
(type (serde-obj String)) | |
;;= java.lang.Class | |
(class? (serde-obj String)) | |
;;= true |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment