Merge pull request #7 from thegeez/transact-fns

Add transaction functions

Author: tonsky

CHANGELOG.md

@@ -1,3 +1,7 @@
+# WIP
+
+- Transactor functions via :db.fn/call
+
 # 0.1.3
 
 - `entity` added

README.md

@@ -119,10 +119,13 @@ Interface differences:
 * Custom query functions and aggregates should be passed as source instead of being referenced by symbol (due to lack of `resolve` in CLJS)
 * Conn is just an atom storing last DB value, use `@conn` instead of `(d/db conn)`
 * Instead of `#db/id[:db.part/user -100]` just use `-100` in place of `:db/id` or entity id
+* Transactor functions can be called as `[:db.fn/call f args]` where `f` is a function reference and will take db as first argument
+* Additional `:db.fn/retractAttribute` shortcut
 
 Expected soon:
 
 * Better error reporting
+* Support for components in schema
 * Direct access to indexes
 * Passing DB to rule
 * Moar speed
@@ -136,7 +139,6 @@ Expected soon:
 * Any value can be used as entity id, attribute or value. It’s better if they are immutable and fast to compare
 * No `db/ident` attributes, keywords are _literally_ attribute values, no integer id behind them
 * AV index for all datoms
-* No transactor functions besides `:db.fn/retractEntity` and `:db.fn/retractAttribute`
 * No schema migrations
 * No history support, though history can be implemented on top of immutable DB values
 * No cache segments management, no laziness. Entire DB must reside in memory

src/datascript.cljs

@@ -81,7 +81,10 @@
                      vs
                      [vs])]
         [:db/add eid a v]))
-    [entity]))
+    (if (= (first entity) :db.fn/call)
+      (let [[_ f & args] entity]
+        (mapcat #(entity->ops db %) (apply f db args)))
+      [entity])))
 
 (defn- op->tx-data [db [op e a v]]
   (let [tx (inc (.-max-tx db))]
@@ -372,20 +375,29 @@
         db-before (atom nil)
         tx-data   (atom nil)
         tempids   (atom nil)
+        error     (atom nil)
         db-after  (swap! conn (fn [db]
-                                (let [raw-datoms (mapcat #(entity->tx-data db %) entities)
-                                      datoms     (map #(resolve-eid db %) raw-datoms)]
-                                  (reset! db-before db)
-                                  (reset! tx-data datoms)
-                                  (reset! tempids (->> raw-datoms
-                                                       (filter #(neg? (.-e %)))
-                                                       (map #(vector (.-e %) (-resolve-eid (.-e %) db)))
-                                                       (into {})))
-                                  (-with db datoms))))
-        report    (TxReport. @db-before db-after @tx-data)]
-    (doseq [[_ l] @(:listeners meta)]
-      (l report))
-    (assoc report :tempids @tempids)))
+                                (let [raw-datoms (try (mapcat #(entity->tx-data db %) entities)
+                                                      (catch js/Object e
+                                                        (reset! error e)))
+]
+                                  (if @error
+                                    db
+                                    (let [datoms (map #(resolve-eid db %) raw-datoms)]
+                                      (reset! db-before db)
+                                      (reset! tx-data datoms)
+                                      (reset! tempids (->> raw-datoms
+                                                           (filter #(neg? (.-e %)))
+                                                           (map #(vector (.-e %) (-resolve-eid (.-e %) db)))
+                                                           (into {})))
+                                      (-with db datoms)))
+)))]
+    (if-let [e @error]
+      (throw e)
+      (let [report (TxReport. @db-before db-after @tx-data)]
+        (doseq [[_ l] @(:listeners meta)]
+          (l report))
+        (assoc report :tempids @tempids)))))
 
 (defn listen!
   ([conn callback] (listen! conn (rand) callback))

test/test/datascript.cljs

@@ -84,6 +84,35 @@
                   :where [1 :aka ?v]] @conn)
            #{["Devil"] ["Tupen"]}))))
 
+(deftest test-db-fn
+  (let [conn (d/create-conn {:aka { :cardinality :many }})
+        inc-age (fn [db name]
+                  (if-let [[eid age] (first (d/q '{:find [?e ?age]
+                                                   :in [$ ?name]
+                                                   :where [[?e :name ?name]
+                                                           [?e :age ?age]]}
+                                                  db name))]
+                    [{:db/id eid :age (inc age)} [:db/add eid :had-birthday true]]
+                    (throw (js/Error. (str "No entity with name: " name)))
+))]
+    (d/transact! conn [{:db/id 1 :name "Ivan" :age 31}])
+    (d/transact! conn [[:db/add 1 :name "Petr"]])
+    (d/transact! conn [[:db/add 1 :aka  "Devil"]])
+    (d/transact! conn [[:db/add 1 :aka  "Tupen"]])
+    (is (= (d/q '[:find ?v ?a
+                  :where [?e :name ?v]
+                         [?e :age ?a]] @conn)
+           #{["Petr" 31]}))
+    (is (= (d/q '[:find ?v
+                  :where [?e :aka ?v]] @conn)
+           #{["Devil"] ["Tupen"]}))
+    (is (thrown-with-msg? js/Error #"No entity with name: Bob"
+                          (d/transact! conn [[:db.fn/call inc-age "Bob"]])))
+    (let [{:keys [db-after]} (d/transact! conn [[:db.fn/call inc-age "Petr"]])
+          e (d/entity db-after 1)]
+      (is (= (:age e) 32))
+      (is (:had-birthday e)))))
+
 
 (deftest test-resolve-eid
   (let [conn (d/create-conn)
@@ -457,6 +486,8 @@
                        #(reverse (sort %))))
              #{[:red [5 4 3 2 1]] [:blue [8 7]]})))))
 
+
+
 ;; (t/test-ns 'test.datomicscript)
 
 ;; Performance