- Preserve metadata on sorted collections in Fressian SerDe hanlders

src/main/clojure/clara/rules/durability.clj

@@ -405,7 +405,8 @@
   (@#'com/create-get-alphas-fn type ancestors rulebase))
 
 (defn assemble-restored-session
-  "Builds a Clara session from the given rulebase and memory components.
+  "Builds a Clara session from the given rulebase and memory components.  When no memory is given a new 
+   one is created with all of the defaults of eng/local-memory.
    Note!  This function should not typically be used.  It is left public to assist in ISessionSerializer 
           durability implementations.  Use clara.rules/mk-session typically to make rule sessions.
    
@@ -421,40 +422,48 @@
 
    Note!  Currently this only supports the clara.rules.memory.PersistentLocalMemory implementation
           of memory."
-  [rulebase memory opts]
-  (let [opts (-> opts
-                 (assoc :rulebase rulebase)
-                 ;; Right now activation fns do not serialize.
-                 (update :activation-group-sort-fn
-                         #(eng/options->activation-group-sort-fn {:activation-group-sort-fn %}))
-                 (update :activation-group-fn
-                         #(eng/options->activation-group-fn {:activation-group-fn %}))
-                 ;; TODO: Memory doesn't seem to ever need this or use it.  Can we just remove it from memory?
-                 (update :get-alphas-fn
-                         #(or % (create-default-get-alphas-fn rulebase))))
-
-        {:keys [listeners transport get-alphas-fn]} opts
-
-        memory-opts (select-keys opts
-                                 #{:rulebase
-                                   :activation-group-sort-fn
-                                   :activation-group-fn
-                                   :get-alphas-fn})
-
-        transport (or transport (clara.rules.engine.LocalTransport.))
-        listeners (or listeners [])
-
-        memory (-> memory
-                   (merge memory-opts)
-                   ;; Naming difference for some reason.
-                   (set/rename-keys {:get-alphas-fn :alphas-fn})
-                   mem/map->PersistentLocalMemory)]
-
-    (eng/assemble {:rulebase rulebase
-                   :memory memory
-                   :transport transport
-                   :listeners listeners
-                   :get-alphas-fn get-alphas-fn})))
+  ([rulebase opts]
+   (assemble-restored-session rulebase
+                              (eng/local-memory rulebase
+                                                (clara.rules.engine.LocalTransport.)
+                                                (eng/options->activation-group-sort-fn {})
+                                                (eng/options->activation-group-fn {})
+                                                (create-default-get-alphas-fn rulebase))
+                              opts))
+  ([rulebase memory opts]
+   (let [opts (-> opts
+                  (assoc :rulebase rulebase)
+                  ;; Right now activation fns do not serialize.
+                  (update :activation-group-sort-fn
+                          #(eng/options->activation-group-sort-fn {:activation-group-sort-fn %}))
+                  (update :activation-group-fn
+                          #(eng/options->activation-group-fn {:activation-group-fn %}))
+                  ;; TODO: Memory doesn't seem to ever need this or use it.  Can we just remove it from memory?
+                  (update :get-alphas-fn
+                          #(or % (create-default-get-alphas-fn rulebase))))
+
+         {:keys [listeners transport get-alphas-fn]} opts
+
+         memory-opts (select-keys opts
+                                  #{:rulebase
+                                    :activation-group-sort-fn
+                                    :activation-group-fn
+                                    :get-alphas-fn})
+
+         transport (or transport (clara.rules.engine.LocalTransport.))
+         listeners (or listeners [])
+
+         memory (-> memory
+                    (merge memory-opts)
+                    ;; Naming difference for some reason.
+                    (set/rename-keys {:get-alphas-fn :alphas-fn})
+                    mem/map->PersistentLocalMemory)]
+
+     (eng/assemble {:rulebase rulebase
+                    :memory memory
+                    :transport transport
+                    :listeners listeners
+                    :get-alphas-fn get-alphas-fn}))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Serialization protocols.

src/main/clojure/clara/rules/durability/fressian.clj

@@ -255,32 +255,49 @@
     :writer (reify WriteHandler
               (write [_ w o]
                 (let [cname (d/sorted-comparator-name o)]
-                  (.writeTag w "clj/treeset" 2)
+                  (.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))))
     :readers {"clj/treeset"
               (reify ReadHandler
                 (read [_ rdr tag component-count]
-                  (let [c (some-> rdr .readObject resolve deref)]
-                    (d/seq->sorted-set (.readObject rdr) c))))}}
-
+                  (let [c (some-> rdr .readObject resolve deref)
+                        m (.readObject rdr)
+                        s (-> (.readObject rdr)
+                              (d/seq->sorted-set c))]
+                    (if m
+                      (with-meta s m)
+                      s))))}}
+
    "clj/treemap"
    {:class clojure.lang.PersistentTreeMap
     :writer (reify WriteHandler
               (write [_ w o]
                 (let [cname (d/sorted-comparator-name o)]
-                  (.writeTag w "clj/treemap" 2)
+                  (.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))))
     :readers {"clj/treemap"
               (reify ReadHandler
                 (read [_ rdr tag component-count]
-                  (let [c (some-> rdr .readObject resolve deref)]
-                    (d/seq->sorted-map (.readObject rdr) c))))}}
+                  (let [c (some-> rdr .readObject resolve deref)
+                        m (.readObject rdr)
+                        s (d/seq->sorted-map (.readObject rdr) c)]
+                    (if m
+                      (with-meta s m)
+                      s))))}}
 
    "clj/mapentry"
    {:class clojure.lang.MapEntry

src/test/clojure/clara/test_durability.clj

@@ -254,4 +254,24 @@
             (check-fact expected-fact fact)))))))
 
 (deftest test-durability-fressian-serde
-  (durability-test :fressian))
+  (testing "SerDe of the rulebase along with working memory"
+    (durability-test :fressian))
+
+  (testing "Repeated SerDe of rulebase"
+    (let [rb-serde (fn [s]
+                     (with-open [baos (java.io.ByteArrayOutputStream.)]
+                       (d/serialize-rulebase s (df/create-session-serializer baos))
+                       (let [rb-data (.toByteArray baos)]
+                         (with-open [bais (java.io.ByteArrayInputStream. rb-data)]
+                           (d/deserialize-rulebase (df/create-session-serializer bais))))))
+
+          s (mk-session 'clara.durability-rules)
+          rb (-> s eng/components :rulebase)
+          deserialized1 (rb-serde s)
+          ;; Need a session to do the 2nd round of SerDe.
+          restored (d/assemble-restored-session deserialized1 {})
+          deserialized2 (rb-serde restored)]
+
+      (is (= (-> rb :id-to-node keys set)
+             (-> deserialized1 :id-to-node keys set)
+             (-> deserialized2 :id-to-node keys set))))))

src/test/clojure/clara/test_fressian.clj

@@ -0,0 +1,110 @@
+(ns clara.test-fressian
+  (:require [clara.rules.durability :as d]
+            [clara.rules.durability.fressian :as df]
+            [clojure.data.fressian :as fres]
+            [clojure.test :refer :all])
+  (:import [org.fressian
+            FressianWriter
+            FressianReader]))
+
+(defn custom-comparator [x y]
+  (> y x))
+
+(defrecord Tester [x])
+
+(defn serde1 [x]
+  (with-open [os (java.io.ByteArrayOutputStream.)
+              ^FressianWriter wtr (fres/create-writer os :handlers df/write-handler-lookup)]
+    ;; Write
+    (binding [d/*node-id->node-cache* (volatile! {})
+              d/*clj-record-holder* (java.util.IdentityHashMap.)]
+      (fres/write-object wtr x))
+
+    ;; Read
+    (let [data (.toByteArray os)]
+      (binding [d/*clj-record-holder* (java.util.ArrayList.)]
+        (with-open [is (java.io.ByteArrayInputStream. data)
+                    ^FressianReader rdr (fres/create-reader is :handlers df/read-handler-lookup)]
+          (fres/read-object rdr))))))
+
+(defn serde [x]
+  ;; Tests all serialization cases in a way that SerDe's 2 times to show that the serialization to
+  ;; deserialization process does not lose important details for the next time serializing it.
+  (-> x serde1 serde1))
+
+(defn test-serde [expected x]
+  (is (= expected (serde x))))
+
+(defn test-serde-with-meta [expected x]
+  (let [no-meta (serde x)
+        test-meta {:test :meta}
+        x-with-meta (vary-meta x merge test-meta)
+        ;; In case x already has metadata it needs to be added to the expectation
+        ;; along with the test metadata added in case it has none to test already.
+        expected-meta (meta x-with-meta)
+        has-meta (serde x-with-meta)]
+
+    (is (= expected
+           no-meta
+           has-meta))
+    (is (= expected-meta
+           (meta has-meta)))))
+
+(deftest test-handlers
+
+  (testing "class"
+    (test-serde String String))
+
+  (testing "set"
+    (test-serde-with-meta #{:x :y} #{:x :y}))
+
+  (testing "vec"
+    (test-serde-with-meta [1 2 3] [1 2 3]))
+
+  (testing "list"
+    (test-serde-with-meta (list "a" "b") (list "a" "b")))
+
+  (testing "aseq"
+    (test-serde-with-meta ['a 'b] (seq ['a 'b])))
+
+  (testing "lazy seq"
+    (test-serde-with-meta [2 3 4] (map inc [1 2 3])))
+
+  (testing "map"
+    (test-serde-with-meta {:x 1 :y 2} {:x 1 :y 2}))
+
+  (testing "map entry"
+    (let [e (first {:x 1})]
+      (test-serde [:x 1] e)
+      (is (instance? clojure.lang.MapEntry (serde e))
+          "preserves map entry type to be sure to still work with `key` and `val`")))
+
+  (testing "sym"
+    (test-serde-with-meta 't 't))
+
+  (testing "record"
+    (test-serde-with-meta (->Tester 10) (->Tester 10)))
+
+  (testing "sorted collections"
+    (let [ss (sorted-set 1 10)
+          ss-custom (with-meta (sorted-set-by custom-comparator 1 10)
+                      {:clara.rules.durability/comparator-name `custom-comparator})
+
+          sm (sorted-map 1 :x 10 :y)
+          sm-custom (with-meta (sorted-map-by custom-comparator 1 :x 10 :y)
+                      {:clara.rules.durability/comparator-name `custom-comparator})]
+
+      (testing "set"
+        (test-serde-with-meta ss ss)
+        (test-serde-with-meta ss-custom ss-custom)
+        (is (thrown? Exception
+                     (serde (with-meta ss-custom {})))
+            "cannot serialized custom sort comparators without name given in metadata"))
+
+      (testing "map"
+        (test-serde-with-meta sm sm)
+        (test-serde-with-meta sm-custom sm-custom)
+        (is (thrown? Exception
+                     (serde (with-meta sm-custom {})))
+            "cannot serialized custom sort comparators without name given in metadata")))))
+