support for :db/isComponent (closes #3)

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)
 

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

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

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]

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 [])]