From 2a96c2baa6adb4e75c245f0abdba64c177d8cfbd Mon Sep 17 00:00:00 2001 From: Nikita Prokopov Date: Mon, 19 Jan 2015 11:20:38 +0600 Subject: [PATCH] support for :db/isComponent (closes #3) --- CHANGELOG.md | 1 + src/datascript.cljs | 14 +++++- src/datascript/core.cljs | 18 ++++++-- src/datascript/impl/entity.cljs | 20 +++++++-- test/test/datascript.cljs | 76 +++++++++++++++++++++++++++++++++ 5 files changed, 120 insertions(+), 9 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b2955758..6e9b60c6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,7 @@ # WIP - Find specifications: collection `:find [?e ...]`, tuple `:find [?e ?v]`, and scalar `:find ?e .` +- Support for `:db/isComponent` (issue #3) - [ BREAKING ] Custom aggregate fns must be called via special syntax (`aggregate` keyword): `(q '[:find (aggregate ?myfn ?e) :in $ ?myfn ...])`. Built-in aggregates work as before: `(q '[:find (count ?e) ...]` - Return nil from `entity` when passed nil eid (issue #47) diff --git a/src/datascript.cljs b/src/datascript.cljs index b1bf8d68..980eb9cf 100644 --- a/src/datascript.cljs +++ b/src/datascript.cljs @@ -22,9 +22,19 @@ acc)) #{} schema)) +(defn- validate-schema [schema] + (doseq [[a kv] schema] + (let [v (:db/isComponent kv false)] + (when-not (or (= false v) (= true v)) + (throw (js/Error. (str "Bad attribute specification for " a ": :db/isComponent should have boolean value")))) + (when (and (= true v) (not= (:db/valueType kv) :db.type/ref)) + (throw (js/Error. (str "Bad attribute specification for " a ": {:db/isComponent true} should also have {:db/valueType :db.type/ref}"))))) + ) + schema) + (defn empty-db [& [schema]] (dc/map->DB { - :schema schema + :schema (validate-schema schema) :eavt (btset/btset-by dc/cmp-datoms-eavt) :aevt (btset/btset-by dc/cmp-datoms-aevt) :avet (btset/btset-by dc/cmp-datoms-avet) @@ -41,7 +51,7 @@ avet (btset/-btset-from-sorted-arr (.sort datoms dc/cmp-datoms-avet-quick) dc/cmp-datoms-avet) max-tx (transduce (map #(.-tx %)) max tx0 datoms)] (dc/map->DB { - :schema schema + :schema (validate-schema schema) :eavt eavt :aevt aevt :avet avet diff --git a/src/datascript/core.cljs b/src/datascript/core.cljs index 8de8499c..1f47ba03 100644 --- a/src/datascript/core.cljs +++ b/src/datascript/core.cljs @@ -238,12 +238,15 @@ (defrecord TxReport [db-before db-after tx-data tempids tx-meta]) -(defn multival? [db attr] +(defn ^boolean multival? [db attr] (= (get-in (-schema db) [attr :db/cardinality]) :db.cardinality/many)) -(defn ref? [db attr] +(defn ^boolean ref? [db attr] (contains? (-refs db) attr)) +(defn ^boolean component? [db attr] + (get-in (-schema db) [attr :db/isComponent] false)) + ;;;;;;;;;; Transacting (defn- current-tx [report] @@ -328,6 +331,11 @@ (or (= e :db/current-tx) (= e ":db/current-tx"))) ;; for datascript.js interop +(defn- retract-components [db datoms] + (into #{} (comp + (filter #(component? db (.-a %))) + (map #(vector :db.fn/retractEntity (.-v %)))) datoms)) + (defn- transact-tx-data [report [entity & entities :as es]] (let [db (:db-after report)] (cond @@ -394,9 +402,11 @@ (= op :db.fn/retractAttribute) (let [datoms (-search db [e a])] - (recur (reduce transact-retract-datom report datoms) entities)) + (recur (reduce transact-retract-datom report datoms) + (concat (retract-components db datoms) entities))) (= op :db.fn/retractEntity) (let [e-datoms (-search db [e]) v-datoms (mapcat (fn [a] (-search db [nil a e])) (-refs db))] - (recur (reduce transact-retract-datom report (concat e-datoms v-datoms)) entities))))))) + (recur (reduce transact-retract-datom report (concat e-datoms v-datoms)) + (concat (retract-components db e-datoms) entities)))))))) diff --git a/src/datascript/impl/entity.cljs b/src/datascript/impl/entity.cljs index 2fa92e19..4603ce1b 100644 --- a/src/datascript/impl/entity.cljs +++ b/src/datascript/impl/entity.cljs @@ -2,7 +2,7 @@ (:require [datascript.core :as dc])) -(declare Entity) +(declare Entity touch) (defn entity [db eid] {:pre [(satisfies? dc/IDB db) (satisfies? dc/ISearch db)]} @@ -24,16 +24,30 @@ (assoc acc a (entity-attr db a part)))) {} (partition-by :a datoms))) +(defn touch-components [db a->v] + (reduce-kv (fn [acc a v] + (assoc acc a + (if (dc/component? db a) + (if (dc/multival? db a) + (set (map touch v)) + (touch v)) + v))) + {} a->v)) + (defn touch [e] (when-not (.-touched e) (when-let [datoms (not-empty (dc/-search (.-db e) [(.-eid e)]))] (set! (.-touched e) true) - (set! (.-cache e) (datoms->cache (.-db e) datoms)))) + (set! (.-cache e) (->> datoms + (datoms->cache (.-db e)) + (touch-components (.-db e)))))) e) (defn- -lookup-backwards [db eid attr not-found] (if-let [datoms (not-empty (dc/-search db [nil attr eid]))] - (reduce #(conj %1 (entity db (.-e %2))) #{} datoms) + (if (dc/component? db attr) + (entity db (.-e (first datoms))) + (reduce #(conj %1 (entity db (.-e %2))) #{} datoms)-) not-found)) (defn- multival->js [val] diff --git a/test/test/datascript.cljs b/test/test/datascript.cljs index 5fe803a6..0afa264a 100644 --- a/test/test/datascript.cljs +++ b/test/test/datascript.cljs @@ -266,6 +266,82 @@ (is (= (-> (e 100) :_children first :_children) #{(e 1)})) ))) +(deftest test-components + (is (thrown-with-msg? js/Error #"Bad attribute specification for :profile" + (d/empty-db {:profile {:db/isComponent true}}))) + (is (thrown-with-msg? js/Error #"Bad attribute specification for :profile" + (d/empty-db {:profile {:db/isComponent "aaa" :db/valueType :db.type/ref}}))) + + (let [db (d/db-with + (d/empty-db {:profile {:db/valueType :db.type/ref + :db/isComponent true}}) + [{:db/id 1 :name "Ivan" :profile 3} + {:db/id 3 :email "@3"} + {:db/id 4 :email "@4"}]) + visible #(cljs.reader/read-string (pr-str %)) + touched #(visible (d/touch %))] + + (testing "touch" + (is (= (touched (d/entity db 1)) + {:db/id 1 + :name "Ivan" + :profile {:db/id 3 + :email "@3"}})) + (is (= (touched (d/entity (d/db-with db [[:db/add 3 :profile 4]]) 1)) + {:db/id 1 + :name "Ivan" + :profile {:db/id 3 + :email "@3" + :profile {:db/id 4 + :email "@4"}}}))) + (testing "retractEntity" + (let [db (d/db-with db [[:db.fn/retractEntity 1]])] + (is (= (d/q '[:find ?a ?v :where [1 ?a ?v]] db) + #{})) + (is (= (d/q '[:find ?a ?v :where [3 ?a ?v]] db) + #{})))) + + (testing "retractAttribute" + (let [db (d/db-with db [[:db.fn/retractAttribute 1 :profile]])] + (is (= (d/q '[:find ?a ?v :where [3 ?a ?v]] db) + #{})))) + + (testing "reverse navigation" + (is (= (visible (:_profile (d/entity db 3))) + {:db/id 1}))))) + +(deftest test-components-multival + (let [db (d/db-with + (d/empty-db {:profile {:db/valueType :db.type/ref + :db/cardinality :db.cardinality/many + :db/isComponent true}}) + [{:db/id 1 :name "Ivan" :profile [3 4]} + {:db/id 3 :email "@3"} + {:db/id 4 :email "@4"}]) + visible #(cljs.reader/read-string (pr-str %)) + touched #(visible (d/touch %))] + + (testing "touch" + (is (= (touched (d/entity db 1)) + {:db/id 1 + :name "Ivan" + :profile #{{:db/id 3 :email "@3"} + {:db/id 4 :email "@4"}}}))) + + (testing "retractEntity" + (let [db (d/db-with db [[:db.fn/retractEntity 1]])] + (is (= (d/q '[:find ?a ?v :in $ [?e ....] :where [?e ?a ?v]] db [1 3 4]) + #{})))) + + (testing "retractAttribute" + (let [db (d/db-with db [[:db.fn/retractAttribute 1 :profile]])] + (is (= (d/q '[:find ?a ?v :in $ [?e ...] :where [?e ?a ?v]] db [3 4]) + #{})))) + + (testing "reverse navigation" + (is (= (visible (:_profile (d/entity db 3))) + {:db/id 1}))))) + (deftest test-listen! (let [conn (d/create-conn) reports (atom [])]