From 1ab772657dc960e2fc321879b040e59f773479f1 Mon Sep 17 00:00:00 2001 From: Brian Marco Date: Mon, 8 Jan 2018 13:04:52 -0500 Subject: [PATCH] transactional schema middleware --- src/datahike/core.cljc | 8 +- src/datahike/db.cljc | 93 +++++++++------ src/datahike/impl/entity.cljc | 3 +- src/datahike/middleware.cljc | 172 ++++++++++++++++++++++++++++ src/datahike/query.cljc | 22 ++-- test/datahike/test/entity.cljc | 2 +- test/datahike/test/lookup_refs.cljc | 109 +++++++++++------- test/datahike/test/middleware.cljc | 79 +++++++++++++ 8 files changed, 396 insertions(+), 92 deletions(-) create mode 100644 src/datahike/middleware.cljc create mode 100644 test/datahike/test/middleware.cljc diff --git a/src/datahike/core.cljc b/src/datahike/core.cljc index 5d554ad8c..fe84765a2 100644 --- a/src/datahike/core.cljc +++ b/src/datahike/core.cljc @@ -75,9 +75,11 @@ :tempids {} :tx-meta tx-meta}) tx-data)))) -(defn db-with [db tx-data] - {:pre [(db/db? db)]} - (:db-after (with db tx-data))) +(defn db-with + ([db tx-data] (db-with db tx-data nil)) + ([db tx-data tx-meta] + {:pre [(db/db? db)]} + (:db-after (with db tx-data tx-meta)))) (defn datoms ([db index] {:pre [(db/db? db)]} (db/-datoms db index [])) diff --git a/src/datahike/db.cljc b/src/datahike/db.cljc index 3ffe797e8..993552429 100644 --- a/src/datahike/db.cljc +++ b/src/datahike/db.cljc @@ -30,7 +30,7 @@ data (last fragments)] `(throw (ex-info (str ~@(map (fn [m#] (if (string? m#) m# (list 'pr-str m#))) msgs)) ~data))))) -(defn #?@(:clj [^Boolean seqable?] +(defn #?@(:clj [^Boolean seqable?] :cljs [^boolean seqable?]) [x] (and (not (string? x)) @@ -147,7 +147,7 @@ IIndexed (-nth [this i] (nth-datom this i)) (-nth [this i not-found] (nth-datom this i not-found)) - + IAssociative (-assoc [d k v] (assoc-datom d k v)) @@ -172,7 +172,7 @@ (empty [d] (throw (UnsupportedOperationException. "empty is not supported on Datom"))) (count [d] 5) (cons [d [k v]] (assoc-datom d k v)) - + clojure.lang.Indexed (nth [this i] (nth-datom this i)) (nth [this i not-found] (nth-datom this i not-found)) @@ -191,7 +191,7 @@ ([e a v] (Datom. e a v tx0 true)) ([e a v tx] (Datom. e a v tx true)) ([e a v tx added] (Datom. e a v tx added))) - + (defn datom? [x] (instance? Datom x)) (defn- hash-datom [^Datom d] @@ -442,7 +442,7 @@ (or (> (hc/compare i e) 0) (> (hc/compare j f) 0) (> (hc/compare k g) 0) - (> (hc/compare l h) 0)) + (> (hc/compare l h) 0)) (and e f g) (or (> (hc/compare i e) 0) @@ -749,10 +749,10 @@ (defn ^DB init-db ([datoms] (init-db datoms default-schema)) - ([datoms schema] + ([datoms schema & {:as options :keys [validate?] :or {validate? true}}] (if (empty? datoms) (empty-db schema) - (let [_ (validate-schema schema) + (let [_ (when validate? (validate-schema schema)) rschema (rschema schema) indexed (:db/index rschema) #?@(:cljs @@ -919,25 +919,37 @@ (defn entid [db eid] {:pre [(db? db)]} (cond - (number? eid) eid + (number? eid) + eid + (sequential? eid) - (cond - (not= (count eid) 2) - (raise "Lookup ref should contain 2 elements: " eid - {:error :lookup-ref/syntax, :entity-id eid}) - (not (is-attr? db (first eid) :db/unique)) - (raise "Lookup ref attribute should be marked as :db/unique: " eid - {:error :lookup-ref/unique - :entity-id eid}) - (nil? (second eid)) - nil - :else - (:e (first (-datoms db :avet eid)))) - #?@(:cljs [(array? eid) (recur db (array-seq eid))]) + (cond + (not= (count eid) 2) + (raise "Lookup ref should contain 2 elements: " eid + {:error :lookup-ref/syntax, :entity-id eid}) + (not (is-attr? db (first eid) :db/unique)) + (if (= :db/ident (first eid)) + (raise "You must have :db/ident marked as :db/unique in your schema to use keyword refs" {:error :lookup-ref/db-ident + :entity-id eid}) + (raise "Lookup ref attribute should be marked as :db/unique: " eid + {:error :lookup-ref/unique + :entity-id eid})) + (nil? (second eid)) + nil + :else + (:e (first (-datoms db :avet eid)))) + + #?@(:cljs + [(array? eid) + (recur db (array-seq eid))]) + + (keyword? eid) + (recur db [:db/ident eid]) + :else - (raise "Expected number or lookup ref for entity id, got " eid - {:error :entity-id/syntax - :entity-id eid}))) + (raise "Expected number or lookup ref for entity id, got " eid + {:error :entity-id/syntax + :entity-id eid}))) (defn entid-strict [db eid] (or (entid db eid) @@ -1064,10 +1076,10 @@ (cond (keyword? attr) (= \_ (nth (name attr) 0)) - + (string? attr) (boolean (re-matches #"(?:([^/]+)/)?_([^/]+)" attr)) - + :else (raise "Bad attribute type: " attr ", expected keyword or string" {:error :transact/syntax, :attribute attr}))) @@ -1084,7 +1096,7 @@ (if (= \_ (nth name 0)) (if ns (str ns "/" (subs name 1)) (subs name 1)) (if ns (str ns "/_" name) (str "_" name)))) - + :else (raise "Bad attribute type: " attr ", expected keyword or string" {:error :transact/syntax, :attribute attr}))) @@ -1143,12 +1155,12 @@ (not (or (da/array? vs) (and (coll? vs) (not (map? vs))))) [vs] - + ;; probably lookup ref (and (= (count vs) 2) (is-attr? db (first vs) :db.unique/identity)) [vs] - + :else vs)) @@ -1225,7 +1237,7 @@ (transact-tx-data (assoc-in report [:tempids tempid] upserted-eid) es))) -(defn transact-tx-data [initial-report initial-es] +(defn transact-tx-data* [initial-report initial-es] (when-not (or (nil? initial-es) (sequential? initial-es)) (raise "Bad transaction data " initial-es ", expected sequential collection" @@ -1251,13 +1263,13 @@ (let [id (current-tx report)] (recur (allocate-eid report old-eid id) (cons (assoc entity :db/id id) entities))) - + ;; lookup-ref => resolved | error (sequential? old-eid) (let [id (entid-strict db old-eid)] (recur report (cons (assoc entity :db/id id) entities))) - + ;; upserted => explode | error [upserted-eid (upsert-eid db entity)] (if (and (neg-number? old-eid) @@ -1266,7 +1278,7 @@ (retry-with-tempid initial-report initial-es old-eid upserted-eid) (recur (allocate-eid report old-eid upserted-eid) (concat (explode db (assoc entity :db/id upserted-eid)) entities))) - + ;; resolved | allocated-tempid | tempid | nil => explode (or (number? old-eid) (nil? old-eid)) @@ -1275,10 +1287,10 @@ (neg? old-eid) (or (get (:tempids report) old-eid) (next-eid db)) :else old-eid) - new-entity (assoc entity :db/id new-eid)] + new-entity (assoc entity :db/id new-eid)] (recur (allocate-eid report old-eid new-eid) (concat (explode db new-entity) entities))) - + ;; trash => error :else (raise "Expected number or lookup ref for :db/id, got " old-eid @@ -1366,7 +1378,7 @@ :else (raise "Unknown operation at " entity ", expected :db/add, :db/retract, :db.fn/call, :db.fn/retractAttribute or :db.fn/retractEntity" {:error :transact/syntax, :operation op, :tx-data entity}))) - + (datom? entity) (let [[e a v tx added] entity] (if added @@ -1378,6 +1390,15 @@ {:error :transact/syntax, :tx-data entity}) )))) +(defn transact-tx-data [{:as initial-report :keys [tx-meta]} initial-es] + (let [middleware (or + (when (map? tx-meta) + (::tx-middleware tx-meta)) + identity)] + ((middleware transact-tx-data*) + initial-report + initial-es))) + (comment diff --git a/src/datahike/impl/entity.cljc b/src/datahike/impl/entity.cljc index 30fd8a968..6167edb2d 100644 --- a/src/datahike/impl/entity.cljc +++ b/src/datahike/impl/entity.cljc @@ -12,7 +12,8 @@ (defn- entid [db eid] (when (or (number? eid) - (sequential? eid)) + (sequential? eid) + (keyword? eid)) (db/entid db eid))) (defn entity [db eid] diff --git a/src/datahike/middleware.cljc b/src/datahike/middleware.cljc new file mode 100644 index 000000000..48161125c --- /dev/null +++ b/src/datahike/middleware.cljc @@ -0,0 +1,172 @@ +(ns datahike.middleware + (:require + [datahike.core :as d] + [datahike.db :as db :refer [-datoms -search init-db entid-strict empty-db]] + #?(:cljs [datahike.db :refer [DB]])) + #?(:clj + (:import [datahike.db DB]))) + +;;; +;;; Metadata +;;; + +(defn keep-meta-middleware + "tx-middleware to keep any meta-data on the db-value after a transaction. Assumes all metadata is in {:map :format}." + [transact] + (fn [report txs] + (let [{:as report :keys [db-after db-before]} (transact report txs)] + (update-in + report + [:db-after] + with-meta + (into + (or (meta db-before) {}) + (meta db-after)))))) + +(def keep-meta-meta + {:datahike.db/tx-middleware keep-meta-middleware}) + +;;; +;;; Transactional Schema +;;; + +(def bare-bones-schema + {:db/ident {:db/unique :db.unique/identity} + :db/unique {:db/valueType :db.type/ref} + :db/valueType {:db/valueType :db.type/ref} + :db/cardinality {:db/valueType :db.type/ref}}) + +(def enum-idents + [{:db/ident :db.cardinality/many} + {:db/ident :db.cardinality/one} + + {:db/ident :db.unique/identity} + {:db/ident :db.unique/value} + + {:db/ident :db.type/keyword} + {:db/ident :db.type/string} + {:db/ident :db.type/boolean} + {:db/ident :db.type/long} + {:db/ident :db.type/bigint} + {:db/ident :db.type/float} + {:db/ident :db.type/double} + {:db/ident :db.type/bigdec} + {:db/ident :db.type/ref} + {:db/ident :db.type/instant} + {:db/ident :db.type/uuid} + {:db/ident :db.type/uri} + {:db/ident :db.type/bytes} + + {:db/ident :db.part/db} + {:db/ident :db.part/user} + {:db/ident :db.part/tx}]) + +(def schema-idents + [{:db/ident :db/ident + :db/valueType :db.type/keyword + :db/unique :db.unique/identity} + {:db/ident :db/cardinality + :db/valueType :db.type/ref} + {:db/ident :db/unique + :db/valueType :db.type/ref} + {:db/ident :db/valueType + :db/valueType :db.type/ref} + {:db/ident :db/doc + :db/valueType :db.type/string} + {:db/ident :db/index + :db/valueType :db.type/boolean} + {:db/ident :db/fulltext + :db/valueType :db.type/boolean} + {:db/ident :db/isComponent + :db/valueType :db.type/boolean} + {:db/ident :db/noHistory + :db/valueType :db.type/boolean} + + {:db/ident :db.install/attribute + :db/valueType :db.type/ref} + {:db/ident :db.alter/attribute + :db/valueType :db.type/ref} + {:db/ident :db.install/partition + :db/valueType :db.type/ref} + + ]) + + +(defn validate-schema-change [db-before db-after] + ;; TODO: insert optimized version of alexandergunnarson validation from posh + ;; ???: should we call from full databases or schema and datoms? + ) + +(defn- ^DB replace-schema + [db schema & {:as options :keys [validate?] :or {validate? true}}] + ;; ???: Can we make more performant by only updating :avet datom set when :db/index becomes active, rather than doing an entire init-db? +;; (prn "replacing-schema" schema) + (let [db-after (init-db (-datoms db :eavt []) schema)] + (when validate? + (validate-schema-change db db-after)) + db-after)) + +(def schema-attrs #{:db/ident :db/cardinality :db/unique :db/index :db/isComponent :db/valueType}) + +(defn- schema-datom? [[e a v tx add?]] + (schema-attrs a)) + +(defn- supported-schema-value? [a v] + (case a + :db/valueType (= v :db.type/ref) + true)) + +(defn- resolve-ident [db ident-eid] + ;; TODO: use existing function + (let [resolved-eid (entid-strict db ident-eid)] + (-> (-search db [resolved-eid :db/ident]) + first + :v))) + +(defn- resolve-enum [db attr value] + ;; FIXME: hardcoded enums + (if (#{:db/cardinality :db/unique :db/valueType} attr) + (let [rident (resolve-ident db value)] + rident) + value)) + +(defn- conj-schema-datom + ;; TODO: handle retractions + ([] (empty-db)) + ([db] db) + ([db [eid attr value _ _]] + (let [attr-ident (resolve-ident db eid) + resolved-value (resolve-enum db attr value)] + (if (supported-schema-value? attr resolved-value) + (assoc-in db [:schema attr-ident attr] + resolved-value) + db)))) + +(defn schema-middleware + "Takes schema transactions and puts them into the simplified schema map." + [transact] + (fn [report txs] + (let [{:as report :keys [db-after tx-data]} (transact report txs) + db-after' (transduce + (filter schema-datom?) + conj-schema-datom + db-after + tx-data)] + (if (= (:schema db-after) (:schema db-after')) + report + (assoc report + :db-after (replace-schema db-after (:schema db-after'))))))) + +(def schema-meta {:datahike.db/tx-middleware schema-middleware}) + +(defn create-schema-conn + "Creates a conn that has all the necessary base schema to be used with transactional schema. You should also use schema-meta whenever you use any of d/transact! d/with d/db-with" + [] + (-> (d/conn-from-db (d/empty-db bare-bones-schema)) + (d/db-with enum-idents schema-meta) + (d/db-with schema-idents schema-meta))) + +;;; +;;; Combined Meta +;;; +(def kitchen-sink-meta {:datahike.db/tx-middleware (comp keep-meta-middleware schema-middleware)}) diff --git a/src/datahike/query.cljc b/src/datahike/query.cljc index f3af35ab5..bd5d063de 100644 --- a/src/datahike/query.cljc +++ b/src/datahike/query.cljc @@ -145,7 +145,7 @@ (defn- and-fn [& args] (reduce (fn [a b] (if b b (reduced b))) true args)) - + (defn- or-fn [& args] (reduce (fn [a b] (if b (reduced b) b)) nil args)) @@ -163,8 +163,8 @@ 'str str, 'pr-str pr-str, 'print-str print-str, 'println-str println-str, 'prn-str prn-str, 'subs subs, 're-find re-find, 're-matches re-matches, 're-seq re-seq, '-differ? -differ?, 'get-else -get-else, 'get-some -get-some, 'missing? -missing?, 'ground identity}) - -(def built-in-aggregates + +(def built-in-aggregates (letfn [(sum [coll] (reduce + 0 coll)) (avg [coll] (/ (sum coll) (count coll))) (median @@ -183,8 +183,8 @@ :let [delta (- x mean)]] (* delta delta)))] (/ sum (count coll)))) - (stddev - [coll] + (stddev + [coll] (#?(:cljs js/Math.sqrt :clj Math/sqrt) (variance coll)))] {'avg avg 'median median @@ -249,11 +249,11 @@ BindIgnore (in->rel [_ _] (prod-rel)) - + BindScalar (in->rel [binding value] (Relation. {(get-in binding [:variable :symbol]) 0} [(into-array [value])])) - + BindColl (in->rel [binding coll] (cond @@ -265,7 +265,7 @@ :else (reduce sum-rel (map #(in->rel (:binding binding) %) coll)))) - + BindTuple (in->rel [binding coll] (cond @@ -430,7 +430,7 @@ tuples-args (da/make-array len)] (dotimes [i len] (let [arg (nth args i)] - (if (symbol? arg) + (if (symbol? arg) (if-let [source (get sources arg)] (da/aset static-args i source) (da/aset tuples-args i (get attrs arg))) @@ -596,9 +596,9 @@ (if (satisfies? db/IDB source) (let [[e a v tx] pattern] (-> - [(if (lookup-ref? e) (db/entid-strict source e) e) + [(if (or (lookup-ref? e) (attr? e)) (db/entid-strict source e) e) a - (if (and v (attr? a) (db/ref? source a) (lookup-ref? v)) (db/entid-strict source v) v) + (if (and v (attr? a) (db/ref? source a) (or (lookup-ref? v) (attr? v))) (db/entid-strict source v) v) (if (lookup-ref? tx) (db/entid-strict source tx) tx)] (subvec 0 (count pattern)))) pattern)) diff --git a/test/datahike/test/entity.cljc b/test/datahike/test/entity.cljc index 1c0dc5a3f..d6781fd78 100644 --- a/test/datahike/test/entity.cljc +++ b/test/datahike/test/entity.cljc @@ -86,7 +86,7 @@ {:db/id 2, :name "Oleg"}]))] (is (nil? (d/entity db nil))) (is (nil? (d/entity db "abc"))) - (is (nil? (d/entity db :keyword))) + (is (thrown-with-msg? ExceptionInfo #"You must have :db/ident marked as :db/unique in your schema to use keyword refs" (d/entity db :keyword))) (is (nil? (d/entity db [:name "Petr"]))) (is (= 777 (:db/id (d/entity db 777)))) (is (thrown-with-msg? ExceptionInfo #"Lookup ref attribute should be marked as :db/unique" diff --git a/test/datahike/test/lookup_refs.cljc b/test/datahike/test/lookup_refs.cljc index b48a7ea79..4b849578c 100644 --- a/test/datahike/test/lookup_refs.cljc +++ b/test/datahike/test/lookup_refs.cljc @@ -15,13 +15,13 @@ :email { :db/unique :db.unique/value }}) [{:db/id 1 :name "Ivan" :email "@1" :age 35} {:db/id 2 :name "Petr" :email "@2" :age 22}])] - + (are [eid res] (= (tdc/entity-map db eid) res) [:name "Ivan"] {:db/id 1 :name "Ivan" :email "@1" :age 35} [:email "@1"] {:db/id 1 :name "Ivan" :email "@1" :age 35} [:name "Sergey"] nil [:name nil] nil) - + (are [eid msg] (thrown-with-msg? ExceptionInfo msg (d/entity db eid)) [:name] #"Lookup ref should contain 2 elements" [:name 1 2] #"Lookup ref should contain 2 elements" @@ -36,59 +36,59 @@ ;; Additions [[:db/add [:name "Ivan"] :age 35]] {:db/id 1 :name "Ivan" :age 35} - + [{:db/id [:name "Ivan"] :age 35}] {:db/id 1 :name "Ivan" :age 35} - + [[:db/add 1 :friend [:name "Petr"]]] {:db/id 1 :name "Ivan" :friend {:db/id 2}} [[:db/add 1 :friend [:name "Petr"]]] {:db/id 1 :name "Ivan" :friend {:db/id 2}} - + [{:db/id 1 :friend [:name "Petr"]}] {:db/id 1 :name "Ivan" :friend {:db/id 2}} - + [{:db/id 2 :_friend [:name "Ivan"]}] {:db/id 1 :name "Ivan" :friend {:db/id 2}} - + ;; lookup refs are resolved at intermediate DB value [[:db/add 3 :name "Oleg"] [:db/add 1 :friend [:name "Oleg"]]] {:db/id 1 :name "Ivan" :friend {:db/id 3}} - + ;; CAS [[:db.fn/cas [:name "Ivan"] :name "Ivan" "Oleg"]] {:db/id 1 :name "Oleg"} - + [[:db/add 1 :friend 1] [:db.fn/cas 1 :friend [:name "Ivan"] 2]] {:db/id 1 :name "Ivan" :friend {:db/id 2}} - + [[:db/add 1 :friend 1] [:db.fn/cas 1 :friend 1 [:name "Petr"]]] {:db/id 1 :name "Ivan" :friend {:db/id 2}} - + ;; Retractions [[:db/add 1 :age 35] [:db/retract [:name "Ivan"] :age 35]] {:db/id 1 :name "Ivan"} - + [[:db/add 1 :friend 2] [:db/retract 1 :friend [:name "Petr"]]] {:db/id 1 :name "Ivan"} - + [[:db/add 1 :age 35] [:db.fn/retractAttribute [:name "Ivan"] :age]] {:db/id 1 :name "Ivan"} - + [[:db.fn/retractEntity [:name "Ivan"]]] {:db/id 1}) - + (are [tx msg] (thrown-with-msg? ExceptionInfo msg (d/db-with db tx)) [{:db/id [:name "Oleg"], :age 10}] #"Nothing found for entity id \[:name \"Oleg\"\]" - + [[:db/add [:name "Oleg"] :age 10]] #"Nothing found for entity id \[:name \"Oleg\"\]") )) @@ -109,13 +109,13 @@ [[:db/add 1 :friends [:name "Petr"]] [:db/add 1 :friends [:name "Oleg"]]] {:db/id 1 :name "Ivan" :friends #{{:db/id 2} {:db/id 3}}} - + [{:db/id 1 :friends [:name "Petr"]}] {:db/id 1 :name "Ivan" :friends #{{:db/id 2}}} [{:db/id 1 :friends [[:name "Petr"]]}] {:db/id 1 :name "Ivan" :friends #{{:db/id 2}}} - + [{:db/id 1 :friends [[:name "Petr"] [:name "Oleg"]]}] {:db/id 1 :name "Ivan" :friends #{{:db/id 2} {:db/id 3}}} @@ -124,7 +124,7 @@ [{:db/id 1 :friends [[:name "Petr"] 3]}] {:db/id 1 :name "Ivan" :friends #{{:db/id 2} {:db/id 3}}} - + ;; reverse refs [{:db/id 2 :_friends [:name "Ivan"]}] {:db/id 1 :name "Ivan" :friends #{{:db/id 2}}} @@ -146,45 +146,45 @@ (are [index attrs datoms] (= (map (juxt :e :a :v) (apply d/datoms db index attrs)) datoms) :eavt [[:name "Ivan"]] [[1 :friends 2] [1 :friends 3] [1 :name "Ivan"]] - + :eavt [[:name "Ivan"] :friends] [[1 :friends 2] [1 :friends 3]] - + :eavt [[:name "Ivan"] :friends [:name "Petr"]] [[1 :friends 2]] - + :aevt [:friends [:name "Ivan"]] [[1 :friends 2] [1 :friends 3]] - + :aevt [:friends [:name "Ivan"] [:name "Petr"]] [[1 :friends 2]] - + :avet [:friends [:name "Oleg"]] [[1 :friends 3] [2 :friends 3]] - + :avet [:friends [:name "Oleg"] [:name "Ivan"]] [[1 :friends 3]]) - + (are [index attrs resolved-attrs] (= (vec (apply d/seek-datoms db index attrs)) (vec (apply d/seek-datoms db index resolved-attrs))) :eavt [[:name "Ivan"]] [1] :eavt [[:name "Ivan"] :name] [1 :name] :eavt [[:name "Ivan"] :friends [:name "Oleg"]] [1 :friends 3] - + :aevt [:friends [:name "Petr"]] [:friends 2] :aevt [:friends [:name "Ivan"] [:name "Oleg"]] [:friends 1 3] - + :avet [:friends [:name "Oleg"]] [:friends 3] :avet [:friends [:name "Oleg"] [:name "Petr"]] [:friends 3 2] ) - + (are [attr start end datoms] (= (map (juxt :e :a :v) (d/index-range db attr start end)) datoms) :friends [:name "Oleg"] [:name "Oleg"] [[1 :friends 3] [2 :friends 3]] - + :friends [:name "Petr"] [:name "Petr"] [[1 :friends 2]] - + :friends [:name "Petr"] [:name "Oleg"] [[1 :friends 2] [1 :friends 3] [2 :friends 3]]) )) @@ -201,31 +201,31 @@ :where [?e :age ?v]] db [:name "Ivan"])) #{[[:name "Ivan"] 11]})) - + (is (= (set (d/q '[:find [?v ...] :in $ [?e ...] :where [?e :age ?v]] db [[:name "Ivan"] [:name "Petr"]])) #{11 22})) - + (is (= (set (d/q '[:find [?e ...] :in $ ?v :where [?e :friend ?v]] db [:name "Petr"])) #{1})) - + (is (= (set (d/q '[:find [?e ...] :in $ [?v ...] :where [?e :friend ?v]] db [[:name "Petr"] [:name "Oleg"]])) #{1 2})) - + (is (= (d/q '[:find ?e ?v :in $ ?e ?v :where [?e :friend ?v]] db [:name "Ivan"] [:name "Petr"]) #{[[:name "Ivan"] [:name "Petr"]]})) - + (is (= (d/q '[:find ?e ?v :in $ [?e ...] [?v ...] :where [?e :friend ?v]] @@ -240,7 +240,7 @@ :where [?e :friend 3]] db [1 2 3 "A"]) #{[2]})) - + (let [db2 (d/db-with (d/empty-db schema) [{:db/id 3 :name "Ivan" :id 3} {:db/id 1 :name "Petr" :id 1} @@ -253,18 +253,18 @@ #{[[:name "Ivan"] 1 3] [[:name "Petr"] 2 1] [[:name "Oleg"] 3 2]}))) - + (testing "inline refs" (is (= (d/q '[:find ?v :where [[:name "Ivan"] :friend ?v]] db) #{[2]})) - + (is (= (d/q '[:find ?e :where [?e :friend [:name "Petr"]]] db) #{[1]})) - + (is (thrown-with-msg? ExceptionInfo #"Nothing found" (d/q '[:find ?e :where [[:name "Valery"] :friend ?e]] @@ -273,4 +273,33 @@ ) )) +(deftest test-keyword-refs + (let [schema {:db/ident {:db/unique :db.unique/identity} + :db/valueType {:db/valueType :db.type/ref}} + db (d/db-with (d/empty-db schema) + [{:db/id 1 + :db/ident :db.type/string} + {:db/id 2 + :db/ident :name + :db/valueType 1}])] + (is (= (d/q '[:find ?v + :where [2 :db/valueType ?v]] db) + #{[1]})) + (is (= (d/q '[:find ?v + :where [[:db/ident :name] :db/valueType ?v]] db) + #{[1]})) + (is (= (d/q '[:find ?v + :where [:name :db/valueType ?v]] db) + #{[1]})) + + (is (= (d/q '[:find ?f + :where [?f :db/valueType 1]] db) + #{[2]})) + (is (= (d/q '[:find ?f + :where [?f :db/valueType [:db/ident :db.type/string]]] db) + #{[2]})) + (is (= (d/q '[:find ?f + :where [?f :db/valueType :db.type/string]] db) + #{[2]})))) + #_(test-lookup-refs-query) diff --git a/test/datahike/test/middleware.cljc b/test/datahike/test/middleware.cljc new file mode 100644 index 000000000..a121abee5 --- /dev/null +++ b/test/datahike/test/middleware.cljc @@ -0,0 +1,79 @@ +(ns datahike.test.middleware + (:require + [datahike.core :as d] + #?(:cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]) + [datahike.db :as db] + [datahike.middleware :as mw] + [datahike.test.core :as tdc]) + #?(:clj + (:import [clojure.lang ExceptionInfo]))) + +(defn reset-meta + "" + [new-meta] + (fn [transact] + (fn [report txs] + (let [report (transact report txs)] + (update-in + report + [:db-after] + with-meta + new-meta))))) + +;; Theoretically something could happen where the meta is not preserved during the transaction. +(def eat-meta (reset-meta nil)) + +(deftest test-keep-meta + (let [db (-> (d/empty-db {:aka {:db/cardinality :db.cardinality/many}}) + (with-meta {:has-meta true}))] + + (is (not + (-> + db + (d/db-with [[:db/add 1 :name "Ivan"]] {:datahike.db/tx-middleware eat-meta}) + meta + :has-meta))) + + ;; keep-meta-middleware should come first when you compose + (is (not + (-> + db + (d/db-with [[:db/add 1 :name "Ivan"]] + {:datahike.db/tx-middleware (comp eat-meta mw/keep-meta-middleware)}) + meta + :has-meta))) + + (is (-> + db + (d/db-with [[:db/add 1 :name "Ivan"]] + {:datahike.db/tx-middleware (comp mw/keep-meta-middleware eat-meta)}) + meta + :has-meta)) + + (is (-> + db + (d/db-with [[:db/add 1 :name "Ivan"]] + {:datahike.db/tx-middleware (comp mw/keep-meta-middleware (reset-meta {:different-meta true}))}) + + meta + (#(and (:has-meta %) (:different-meta %) (not (:unknown-meta %)))))))) + +(deftest test-schema + (let [schema-mw {:datahike.db/tx-middleware mw/schema-middleware} + db (-> (d/empty-db mw/bare-bones-schema) + (d/db-with mw/enum-idents schema-mw) + (d/db-with mw/schema-idents schema-mw) + (d/db-with [{:db/id 100 + :db/ident :name + :db/valueType :db.type/string} + {:db/id 102 + :db/ident :aka + :db/cardinality :db.cardinality/many} + {:db/id 103 + :db/ident :friend + :db/valueType [:db/ident :db.type/ref]}] + schema-mw) + )] + (is (= (get-in db [:schema :friend :db/valueType]) :db.type/ref)) + (is (= (get-in db [:schema :aka :db/cardinality]) :db.cardinality/many))))