Clojure Serialization With Fressian

clj-data-fressian-serde.clj

;;;; 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