From 2ec6c613f91e1ef08fe272fd434d14d07fa066f5 Mon Sep 17 00:00:00 2001 From: MR027750 Date: Thu, 13 Oct 2016 14:18:31 -0500 Subject: [PATCH] - Preserve metadata on sorted collections in Fressian SerDe hanlders - Improve clara.rules.durability/assemble-restored-session to -- properly support session options and -- optionanlly be called with no init memory --- src/main/clojure/clara/rules/durability.clj | 100 +++++++----- .../clara/rules/durability/fressian.clj | 31 +++- src/test/clojure/clara/test_durability.clj | 142 ++++++++++++++++-- src/test/clojure/clara/test_fressian.clj | 110 ++++++++++++++ 4 files changed, 327 insertions(+), 56 deletions(-) create mode 100644 src/test/clojure/clara/test_fressian.clj diff --git a/src/main/clojure/clara/rules/durability.clj b/src/main/clojure/clara/rules/durability.clj index 1326d30e..9626b056 100644 --- a/src/main/clojure/clara/rules/durability.clj +++ b/src/main/clojure/clara/rules/durability.clj @@ -401,60 +401,84 @@ :activation-group-fn :alphas-fn)))) -(defn create-default-get-alphas-fn [rulebase] - (@#'com/create-get-alphas-fn type ancestors rulebase)) +(def ^:private create-get-alphas-fn @#'com/create-get-alphas-fn) + +(defn- opts->get-alphas-fn [rulebase opts] + (let [fact-type-fn (:fact-type-fn opts type) + ancestors-fn (:ancestors-fn opts ancestors)] + (create-get-alphas-fn fact-type-fn + ancestors-fn + 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. Options can be provided via opts. These include: + * :fact-type-fn + * :ancestors-fn * :activation-group-sort-fn * :activation-group-fn - * :get-alphas-fn If the options are not provided, they will default to the Clara session defaults. These are all described in detail in clara.rules/mk-session docs. 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] + (let [opts (assoc opts + :rulebase + rulebase + :get-alphas-fn + (opts->get-alphas-fn rulebase opts)) + {:keys [listeners transport get-alphas-fn]} opts] + + (eng/assemble {:rulebase rulebase + :memory (eng/local-memory rulebase + (clara.rules.engine.LocalTransport.) + (eng/options->activation-group-sort-fn opts) + (eng/options->activation-group-fn opts) + ;; TODO: Memory doesn't seem to ever need this or use + ;; it. Can we just remove it from memory? + get-alphas-fn) + :transport (or transport (clara.rules.engine.LocalTransport.)) + :listeners (or listeners []) + :get-alphas-fn get-alphas-fn}))) + + ([rulebase memory opts] + (let [opts (-> opts + (assoc :rulebase + rulebase + ;; Right now get alphas fn does not serialize. + :get-alphas-fn + (opts->get-alphas-fn rulebase opts)) + ;; 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 %}))) + + {:keys [listeners transport get-alphas-fn]} opts + + memory-opts (select-keys opts + #{:rulebase + :activation-group-sort-fn + :activation-group-fn + :get-alphas-fn})] + + (eng/assemble {:rulebase rulebase + :memory (-> memory + (merge memory-opts) + ;; Naming difference for some reason. + (set/rename-keys {:get-alphas-fn :alphas-fn}) + mem/map->PersistentLocalMemory) + :transport (or transport (clara.rules.engine.LocalTransport.)) + :listeners (or listeners []) + :get-alphas-fn get-alphas-fn})))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Serialization protocols. diff --git a/src/main/clojure/clara/rules/durability/fressian.clj b/src/main/clojure/clara/rules/durability/fressian.clj index 7369d06b..0fc30f62 100644 --- a/src/main/clojure/clara/rules/durability/fressian.clj +++ b/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 diff --git a/src/test/clojure/clara/test_durability.clj b/src/test/clojure/clara/test_durability.clj index 11e3a5b9..a253a82f 100644 --- a/src/test/clojure/clara/test_durability.clj +++ b/src/test/clojure/clara/test_durability.clj @@ -78,15 +78,8 @@ "expected fact: " expected-fact \newline "fact: " fact \newline))))))) -(defn durability-test - "Test runner to run different implementations of d/ISessionSerializer." - [serde-type] - (let [s (mk-session 'clara.durability-rules) - - ;; Testing identity relationships on the IWorkingMemorySerializer facts received to serialize. - ;; So this is a little weird, but we want to know the exact object identity of even these - ;; "primitive" values. - mci "MCI" +(defn session-test [s] + (let [mci "MCI" lax "LAX" san "SAN" chi "CHI" @@ -119,7 +112,66 @@ cold-res (query fired dr/cold-temp) hot-res (query fired dr/hot-temp) temp-his-res (query fired dr/temp-his) - temps-under-thresh-res (query fired dr/temps-under-thresh) + temps-under-thresh-res (query fired dr/temps-under-thresh)] + {:all-objs [mci + lax + san + chi + irk + ten + twenty + fifty + forty + thirty + thresh50 + temp50 + temp40 + temp30 + temp20 + ws50 + ws40 + ws10] + :fired-session fired + :query-results {:unpaired-res unpaired-res + :cold-res cold-res + :hot-res hot-res + :temp-his-res temp-his-res + :temps-under-thresh-res temps-under-thresh-res}})) + +(defn durability-test + "Test runner to run different implementations of d/ISessionSerializer." + [serde-type] + (let [s (mk-session 'clara.durability-rules) + results (session-test s) + ;; Testing identity relationships on the IWorkingMemorySerializer facts received to serialize. + ;; So this is a little weird, but we want to know the exact object identity of even these + ;; "primitive" values. + [mci + lax + san + chi + irk + ten + twenty + fifty + forty + thirty + thresh50 + temp50 + temp40 + temp30 + temp20 + ws50 + ws40 + ws10] (:all-objs results) + + fired (:fired-session results) + + {:keys [unpaired-res + cold-res + hot-res + temp-his-res + temps-under-thresh-res]} (:query-results results) create-serializer (fn [stream] ;; Currently only one. @@ -254,4 +306,72 @@ (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. + restored1 (d/assemble-restored-session deserialized1 {}) + deserialized2 (rb-serde restored1) + restored2 (d/assemble-restored-session deserialized2 {}) + + init-qresults (:query-results (session-test s)) + restored-qresults1 (:query-results (session-test restored1)) + restored-qresults2 (:query-results (session-test restored2))] + + (is (= init-qresults + restored-qresults1 + restored-qresults2))))) + +(deftest test-assemble-restored-session-opts + (let [orig (mk-session 'clara.durability-rules) + + test-assemble (fn [rulebase memory] + (let [activation-group-fn-called? (volatile! false) + activation-group-sort-fn-called? (volatile! false) + fact-type-fn-called? (volatile! false) + ancestors-fn-called? (volatile! false) + + opts {:activation-group-fn (fn [x] + (vreset! activation-group-fn-called? true) + (or (some-> x :props :salience) + 0)) + :activation-group-sort-fn (fn [x y] + (vreset! activation-group-sort-fn-called? true) + (> x y)) + :fact-type-fn (fn [x] + (vreset! fact-type-fn-called? true) + (type x)) + :ancestors-fn (fn [x] + (vreset! ancestors-fn-called? true) + (ancestors x))} + + restored (if memory + (d/assemble-restored-session rulebase memory opts) + (d/assemble-restored-session rulebase opts))] + + (is (= (:query-results (session-test orig)) + (:query-results (session-test restored)))) + + (is (true? @activation-group-sort-fn-called?)) + (is (true? @activation-group-fn-called?)) + (is (true? @fact-type-fn-called?)) + (is (true? @ancestors-fn-called?)))) + + {:keys [rulebase memory]} (eng/components orig)] + + (testing "restoring without given memory" + (test-assemble rulebase nil)) + + (testing "restoring with memory" + (test-assemble rulebase memory)))) diff --git a/src/test/clojure/clara/test_fressian.clj b/src/test/clojure/clara/test_fressian.clj new file mode 100644 index 00000000..8020b6a4 --- /dev/null +++ b/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"))))) +