greg/mentat
1
0
Fork 0
Code Issues 294 Pull requests Projects Releases 9 Packages Wiki Activity

Add :tx and :txInstant to TxReport; accept :db/tx in transactor; allow to set :db/txInstant.

Browse source 
The implementation of :db/tx is special and may need to change over
time.  We add it as a special ident, with value the current transaction
entity ID, specified per-transaction.  This works well right now but
introduces some (internal) ordering requirements that may need to be
loosened.
This commit is contained in:
Nick Alexander 2016-08-03 20:24:02 -07:00
parent 417ae1ed92
commit 38545f6efc
2 changed files with 196 additions and 128 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

118
src/datomish/db.cljc
View file

@ -35,6 +35,11 @@
(uncaughtException [_ thread ex] (uncaughtException [_ thread ex]
(println ex "Uncaught exception on" (.getName thread)))))) (println ex "Uncaught exception on" (.getName thread))))))
(defprotocol IClock
(now
[clock]
"Return integer milliseconds since the Unix epoch."))
(defprotocol IDB (defprotocol IDB
(query-context (query-context
[db]) [db])
@ -72,7 +77,8 @@
"TODO: document this interface.")) "TODO: document this interface."))
(defn db? [x] (defn db? [x]
(and (satisfies? IDB x))) (and (satisfies? IDB x)
(satisfies? IClock x)))
(defn- row->Datom [schema row] (defn- row->Datom [schema row]
(let [e (:e row) (let [e (:e row)
@ -186,7 +192,14 @@
(update db :current-tx inc)))) (update db :current-tx inc))))
;; ) ;; )
(close-db [db] (s/close (.-sqlite-connection db)))) (close-db [db] (s/close (.-sqlite-connection db)))
IClock
(now [db]
#?(:clj
(System/currentTimeMillis)
:cljs
(.getTime (js/Date.)))))
(defprotocol IConnection (defprotocol IConnection
(close (close
@ -238,6 +251,7 @@
(defrecord TxReport [db-before ;; The DB before the transaction. (defrecord TxReport [db-before ;; The DB before the transaction.
db-after ;; The DB after the transaction. db-after ;; The DB after the transaction.
current-tx ;; The tx ID represented by the transaction in this report.
entities ;; The set of entities (like [:db/add e a v tx]) processed. entities ;; The set of entities (like [:db/add e a v tx]) processed.
tx-data ;; The set of datoms applied to the database, like (Datom. e a v tx added). tx-data ;; The set of datoms applied to the database, like (Datom. e a v tx added).
tempids ;; The map from id-literal -> numeric entid. tempids ;; The map from id-literal -> numeric entid.
@ -496,11 +510,15 @@
(defrecord Transaction [db tempids entities]) (defrecord Transaction [db tempids entities])
(defn- tx-entity [db] (defn- tx-entity [db report]
(let [tx (current-tx db)] {:pre [(db? db) (report? report)]}
[:db/add tx :db/txInstant 0xdeadbeef tx])) ;; TODO: now. (let [tx (:tx report)
txInstant (:txInstant report)]
;; n.b., this must not be symbolic -- it's inserted after we map idents -> entids.
[:db/add tx (get-in db [:idents :db/txInstant]) txInstant]))
(defn maybe-add-current-tx [current-tx entity] ;; TODO: never accept incoming tx, throughout.
(defn maybe-add-tx [current-tx entity]
(let [[op e a v tx] entity] (let [[op e a v tx] entity]
[op e a v (or tx current-tx)])) [op e a v (or tx current-tx)]))
@ -533,10 +551,31 @@
true true
entity)) entity))
(defn- tx-instant? [db [op e a & _]]
(and (= op :db/add)
(= e (get-in db [:idents :db/tx]))
(= a (get-in db [:idents :db/txInstant]))))
(defn- update-txInstant [db report]
"Extract [:db/add :db/tx :db/txInstant ...], and update :txInstant with that value."
{:pre [(db? db) (report? report)]}
;; TODO: be more efficient here: don't iterate all entities.
(if-let [[_ _ _ txInstant] (first (filter (partial tx-instant? db) (:entities report)))]
(assoc report :txInstant txInstant)
report))
(defn preprocess [db report] (defn preprocess [db report]
{:pre [(db? db) (report? report)]} {:pre [(db? db) (report? report)]}
(let [initial-es (or (:entities report) [])] (let [initial-es (or (:entities report) [])
;; :db/tx is a "dynamic enum ident" that maps to the current transaction ID. This approach
;; mimics DataScript's :db/current-tx. (We don't follow DataScript because
;; current-txInstant is awkward.) It's much simpler than Datomic's approach, which appears
;; to unify all id-literals in :db.part/tx to the current transaction value, but also seems
;; inconsistent.
tx (:tx report)
db* (assoc-in db [:idents :db/tx] tx)]
(when-not (sequential? initial-es) (when-not (sequential? initial-es)
(raise "Bad transaction data " initial-es ", expected sequential collection" (raise "Bad transaction data " initial-es ", expected sequential collection"
{:error :transact/syntax, :tx-data initial-es})) {:error :transact/syntax, :tx-data initial-es}))
@ -545,8 +584,6 @@
(-> (->
report report
(update :entities conj (tx-entity db))
;; Normalize Datoms into :db/add or :db/retract vectors. ;; Normalize Datoms into :db/add or :db/retract vectors.
(update :entities (partial map maybe-datom->entity)) (update :entities (partial map maybe-datom->entity))
@ -557,11 +594,21 @@
(update :entities (partial map ensure-entity-form)) (update :entities (partial map ensure-entity-form))
;; Replace idents with entids where possible. ;; Replace idents with entids where possible, using db* to capture :db/tx.
(update :entities (partial map (partial maybe-ident->entid db))) (update :entities (partial map (partial maybe-ident->entid db*)))
;; If an explicit [:db/add :db/tx :db/txInstant] is not given, add one. Use db* to
;; capture :db/tx.
(update :entities (fn [entities]
(if (first (filter (partial tx-instant? db*) entities))
entities
(conj entities (tx-entity db report)))))
;; Extract the current txInstant for the report.
(->> (update-txInstant db*))
;; Add tx if not given. ;; Add tx if not given.
(update :entities (partial map (partial maybe-add-current-tx (current-tx db))))))) (update :entities (partial map (partial maybe-add-tx tx))))))
(defn- lookup-ref? [x] (defn- lookup-ref? [x]
(and (sequential? x) (and (sequential? x)
@ -811,7 +858,7 @@
{:error :transact/syntax, :operation op, :tx-data entity}))))))) {:error :transact/syntax, :operation op, :tx-data entity})))))))
(defn <transact-tx-data (defn <transact-tx-data
[db now report] [db report]
{:pre [(db? db) (report? report)]} {:pre [(db? db) (report? report)]}
(go-pair (go-pair
@ -922,18 +969,23 @@
(go-pair (go-pair
(let [report (->> (let [report (->>
(map->TxReport (map->TxReport
{:db-before db {:db-before db
:db-after db :db-after db
;; :current-tx current-tx ;; This mimics DataScript. It's convenient to be able to extract the
:entities tx-data ;; transaction ID and transaction timestamp directly from the report; Datomic
:tx-data [] ;; makes this surprisingly difficult: one needs a :db.part/tx temporary and an
:tempids {} ;; explicit upsert of that temporary.
:added-parts {} :tx (current-tx db)
:added-idents {} :txInstant (now db)
:added-attributes {} :entities tx-data
:tx-data []
:tempids {}
:added-parts {}
:added-idents {}
:added-attributes {}
}) })
(<transact-tx-data db 0xdeadbeef) ;; TODO: timestamp properly. (<transact-tx-data db)
(<?) (<?)
(collect-db-ident-assertions db) (collect-db-ident-assertions db)
@ -975,14 +1027,12 @@
(:db-after (<? (<with db tx-data))))) (:db-after (<? (<with db tx-data)))))
(defn <transact! (defn <transact!
([conn tx-data] [conn tx-data]
(<transact! conn tx-data 0xdeadbeef)) ;; TODO: timestamp! {:pre [(conn? conn)]}
([conn tx-data now] (let [db (db conn)] ;; TODO: be careful with swapping atoms.
{:pre [(conn? conn)]} (s/in-transaction!
(let [db (db conn)] ;; TODO: be careful with swapping atoms. (:sqlite-connection db)
(s/in-transaction! #(go-pair
(:sqlite-connection db) (let [report (<? (<with db tx-data))]
#(go-pair (reset! (:current-db conn) (:db-after report))
(let [report (<? (<with db tx-data))] ;; TODO: timestamp! report)))))
(reset! (:current-db conn) (:db-after report))
report))))))

206
test/datomish/db_test.cljc
View file

@ -76,9 +76,6 @@
(<?) (<?)
(mapv #(vector (:rowid %) (:text %)))))) (mapv #(vector (:rowid %) (:text %))))))
(defn tx [report]
(get-in report [:db-after :current-tx]))
;; TODO: use reverse refs! ;; TODO: use reverse refs!
(def test-schema (def test-schema
[{:db/id (dm/id-literal :test -1) [{:db/id (dm/id-literal :test -1)
@ -121,18 +118,15 @@
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema)) db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db) conn (dm/connection-with-db db)]
now 0xdeadbeef]
(try (try
(let [tx0 (tx (<? (dm/<transact! conn test-schema now)))] (let [{tx0 :tx} (<? (dm/<transact! conn test-schema))]
(let [;; TODO: drop now, allow to set :db/txInstant. (let [{:keys [tx txInstant]} (<? (dm/<transact! conn [[:db/add 0 :name "valuex"]]))]
report (<? (dm/<transact! conn [[:db/add 0 :name "valuex"]] now))
tx (tx report)]
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (dm/db conn) tx0))
#{[0 :name "valuex"]})) #{[0 :name "valuex"]}))
(is (= (<? (<transactions-after (dm/db conn) tx0)) (is (= (<? (<transactions-after (dm/db conn) tx0))
[[0 :name "valuex" tx 1] ;; TODO: true, not 1. [[0 :name "valuex" tx 1] ;; TODO: true, not 1.
[tx :db/txInstant now tx 1]])))) [tx :db/txInstant txInstant tx 1]]))))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
@ -140,14 +134,13 @@
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema)) db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db) conn (dm/connection-with-db db)]
now 0xdeadbeef]
(try (try
(let [tx0 (tx (<? (dm/<transact! conn test-schema now))) (let [{tx0 :tx} (<? (dm/<transact! conn test-schema))
tx1 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Ivan"]] now))) {tx1 :tx txInstant1 :txInstant} (<? (dm/<transact! conn [[:db/add 1 :name "Ivan"]]))
tx2 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Petr"]] now))) {tx2 :tx txInstant2 :txInstant} (<? (dm/<transact! conn [[:db/add 1 :name "Petr"]]))
tx3 (tx (<? (dm/<transact! conn [[:db/add 1 :aka "Tupen"]] now))) {tx3 :tx txInstant3 :txInstant} (<? (dm/<transact! conn [[:db/add 1 :aka "Tupen"]]))
tx4 (tx (<? (dm/<transact! conn [[:db/add 1 :aka "Devil"]] now)))] {tx4 :tx txInstant4 :txInstant} (<? (dm/<transact! conn [[:db/add 1 :aka "Devil"]]))]
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (dm/db conn) tx0))
#{[1 :name "Petr"] #{[1 :name "Petr"]
[1 :aka "Tupen"] [1 :aka "Tupen"]
@ -155,36 +148,34 @@
(is (= (<? (<transactions-after (dm/db conn) tx0)) (is (= (<? (<transactions-after (dm/db conn) tx0))
[[1 :name "Ivan" tx1 1] ;; TODO: true, not 1. [[1 :name "Ivan" tx1 1] ;; TODO: true, not 1.
[tx1 :db/txInstant now tx1 1] [tx1 :db/txInstant txInstant1 tx1 1]
[1 :name "Ivan" tx2 0] [1 :name "Ivan" tx2 0]
[1 :name "Petr" tx2 1] [1 :name "Petr" tx2 1]
[tx2 :db/txInstant now tx2 1] [tx2 :db/txInstant txInstant2 tx2 1]
[1 :aka "Tupen" tx3 1] [1 :aka "Tupen" tx3 1]
[tx3 :db/txInstant now tx3 1] [tx3 :db/txInstant txInstant3 tx3 1]
[1 :aka "Devil" tx4 1] [1 :aka "Devil" tx4 1]
[tx4 :db/txInstant now tx4 1]]))) [tx4 :db/txInstant txInstant4 tx4 1]])))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
;; TODO: fail multiple :add and :retract of the same datom in the same transaction.
(deftest-async test-retract (deftest-async test-retract
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema)) db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db) conn (dm/connection-with-db db)]
now 0xdeadbeef]
(try (try
(let [tx0 (tx (<? (dm/<transact! conn test-schema now))) (let [{tx0 :tx} (<? (dm/<transact! conn test-schema))
txa (tx (<? (dm/<transact! conn [[:db/add 0 :x 123]] now))) {tx1 :tx txInstant1 :txInstant} (<? (dm/<transact! conn [[:db/add 0 :x 123]]))
txb (tx (<? (dm/<transact! conn [[:db/retract 0 :x 123]] now)))] {tx2 :tx txInstant2 :txInstant} (<? (dm/<transact! conn [[:db/retract 0 :x 123]]))]
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (dm/db conn) tx0))
#{})) #{}))
(is (= (<? (<transactions-after (dm/db conn) tx0)) (is (= (<? (<transactions-after (dm/db conn) tx0))
[[0 :x 123 txa 1] ;; TODO: true, not 1. [[0 :x 123 tx1 1]
[txa :db/txInstant now txa 1] [tx1 :db/txInstant txInstant1 tx1 1]
[0 :x 123 txb 0] [0 :x 123 tx2 0]
[txb :db/txInstant now txb 1]]))) [tx2 :db/txInstant txInstant2 tx2 1]])))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
@ -192,14 +183,13 @@
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema)) db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db) conn (dm/connection-with-db db)]
now -1]
(try (try
(let [tx0 (tx (<? (dm/<transact! conn test-schema now))) (let [tx0 (:tx (<? (dm/<transact! conn test-schema)))
report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :x 0] report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :x 0]
[:db/add (dm/id-literal :db.part/user -1) :y 1] [:db/add (dm/id-literal :db.part/user -1) :y 1]
[:db/add (dm/id-literal :db.part/user -2) :y 2] [:db/add (dm/id-literal :db.part/user -2) :y 2]
[:db/add (dm/id-literal :db.part/user -2) :y 3]] now))] [:db/add (dm/id-literal :db.part/user -2) :y 3]]))]
(is (= (keys (:tempids report)) ;; TODO: include values. (is (= (keys (:tempids report)) ;; TODO: include values.
[(dm/id-literal :db.part/user -1) [(dm/id-literal :db.part/user -1)
(dm/id-literal :db.part/user -2)])) (dm/id-literal :db.part/user -2)]))
@ -219,21 +209,20 @@
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema)) db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db) conn (dm/connection-with-db db)]
now -1]
(try (try
(let [tx0 (tx (<? (dm/<transact! conn test-schema now)))] (let [tx0 (:tx (<? (dm/<transact! conn test-schema)))]
(testing "Multiple :db/unique values in tx-data violate unique constraint, no tempid" (testing "Multiple :db/unique values in tx-data violate unique constraint, no tempid"
(is (thrown-with-msg? (is (thrown-with-msg?
ExceptionInfo #"unique constraint" ExceptionInfo #"unique constraint"
(<? (dm/<transact! conn [[:db/add 1 :x 0] (<? (dm/<transact! conn [[:db/add 1 :x 0]
[:db/add 2 :x 0]] now))))) [:db/add 2 :x 0]])))))
(testing "Multiple :db/unique values in tx-data violate unique constraint, tempid" (testing "Multiple :db/unique values in tx-data violate unique constraint, tempid"
(is (thrown-with-msg? (is (thrown-with-msg?
ExceptionInfo #"unique constraint" ExceptionInfo #"unique constraint"
(<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :spouse "Dana"] (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :spouse "Dana"]
[:db/add (dm/id-literal :db.part/user -2) :spouse "Dana"]] now)))))) [:db/add (dm/id-literal :db.part/user -2) :spouse "Dana"]]))))))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
@ -242,32 +231,31 @@
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema)) db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db) conn (dm/connection-with-db db)]
now -1]
(try (try
(let [tx0 (tx (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) (let [tx0 (:tx (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1)
:db/ident :test/kw :db/ident :test/kw
:db/unique :db.unique/identity :db/unique :db.unique/identity
:db/valueType :db.type/keyword} :db/valueType :db.type/keyword}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :db.part/user -1)}] now)))] {:db/id :db.part/db :db.install/attribute (dm/id-literal :db.part/user -1)}])))]
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :test/kw :test/kw1]] now)) (let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :test/kw :test/kw1]]))
eid (get-in report [:tempids (dm/id-literal :db.part/user -1)])] eid (get-in report [:tempids (dm/id-literal :db.part/user -1)])]
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (dm/db conn) tx0))
#{[eid :test/kw ":test/kw1"]})) ;; Value is raw. #{[eid :test/kw ":test/kw1"]})) ;; Value is raw.
(testing "Adding the same value compares existing values correctly." (testing "Adding the same value compares existing values correctly."
(<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw1]] now)) (<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw1]]))
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (dm/db conn) tx0))
#{[eid :test/kw ":test/kw1"]}))) ;; Value is raw. #{[eid :test/kw ":test/kw1"]}))) ;; Value is raw.
(testing "Upserting retracts existing value correctly." (testing "Upserting retracts existing value correctly."
(<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw2]] now)) (<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw2]]))
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (dm/db conn) tx0))
#{[eid :test/kw ":test/kw2"]}))) ;; Value is raw. #{[eid :test/kw ":test/kw2"]}))) ;; Value is raw.
(testing "Retracting compares values correctly." (testing "Retracting compares values correctly."
(<? (dm/<transact! conn [[:db/retract eid :test/kw :test/kw2]] now)) (<? (dm/<transact! conn [[:db/retract eid :test/kw :test/kw2]]))
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (dm/db conn) tx0))
#{}))))) #{})))))
@ -279,18 +267,17 @@
(let [c (<? (s/<sqlite-connection t)) (let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema)) db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now 0xdeadbeef
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))] tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try (try
;; Not having DB-as-value really hurts us here. This test only works because all upserts ;; Not having DB-as-value really hurts us here. This test only works because all upserts
;; succeed on top of each other, so we never need to reset the underlying store. ;; succeed on top of each other, so we never need to reset the underlying store.
(<? (dm/<transact! conn test-schema now)) (<? (dm/<transact! conn test-schema))
(let [tx0 (tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"} (let [tx0 (:tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}] now)))] {:db/id 102 :name "Petr" :email "@2"}])))]
(testing "upsert with tempid" (testing "upsert with tempid"
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"] (let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"]
[:db/add (dm/id-literal :db.part/user -1) :age 12]] now))] [:db/add (dm/id-literal :db.part/user -1) :age 12]]))]
(is (= (<? (<shallow-entity (dm/db conn) 101)) (is (= (<? (<shallow-entity (dm/db conn) 101))
{:name "Ivan" :age 12 :email "@1"})) {:name "Ivan" :age 12 :email "@1"}))
(is (= (tempids report) (is (= (tempids report)
@ -298,7 +285,7 @@
(testing "upsert with tempid, order does not matter" (testing "upsert with tempid, order does not matter"
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :age 13] (let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :age 13]
[:db/add (dm/id-literal :db.part/user -1) :name "Petr"]] now))] [:db/add (dm/id-literal :db.part/user -1) :name "Petr"]]))]
(is (= (<? (<shallow-entity (dm/db conn) 102)) (is (= (<? (<shallow-entity (dm/db conn) 102))
{:name "Petr" :age 13 :email "@2"})) {:name "Petr" :age 13 :email "@2"}))
(is (= (tempids report) (is (= (tempids report)
@ -309,7 +296,7 @@
(<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"] (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"]
[:db/add (dm/id-literal :db.part/user -1) :age 35] [:db/add (dm/id-literal :db.part/user -1) :age 35]
[:db/add (dm/id-literal :db.part/user -1) :name "Petr"] [:db/add (dm/id-literal :db.part/user -1) :name "Petr"]
[:db/add (dm/id-literal :db.part/user -1) :age 36]] now)))))) [:db/add (dm/id-literal :db.part/user -1) :age 36]]))))))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
@ -318,38 +305,37 @@
(let [c (<? (s/<sqlite-connection t)) (let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema)) db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now 0xdeadbeef
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))] tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try (try
;; Not having DB-as-value really hurts us here. This test only works because all upserts ;; Not having DB-as-value really hurts us here. This test only works because all upserts
;; succeed on top of each other, so we never need to reset the underlying store. ;; succeed on top of each other, so we never need to reset the underlying store.
(<? (dm/<transact! conn test-schema now)) (<? (dm/<transact! conn test-schema))
(let [tx0 (tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"} (let [tx0 (:tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}] now)))] {:db/id 102 :name "Petr" :email "@2"}])))]
(testing "upsert with tempid" (testing "upsert with tempid"
(let [tx (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}] now))] (let [tx (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}]))]
(is (= (<? (<shallow-entity (dm/db conn) 101)) (is (= (<? (<shallow-entity (dm/db conn) 101))
{:name "Ivan" :email "@1" :age 35})) {:name "Ivan" :email "@1" :age 35}))
(is (= (tempids tx) (is (= (tempids tx)
{-1 101})))) {-1 101}))))
(testing "upsert by 2 attrs with tempid" (testing "upsert by 2 attrs with tempid"
(let [tx (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@1" :age 35}] now))] (let [tx (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@1" :age 35}]))]
(is (= (<? (<shallow-entity (dm/db conn) 101)) (is (= (<? (<shallow-entity (dm/db conn) 101))
{:name "Ivan" :email "@1" :age 35})) {:name "Ivan" :email "@1" :age 35}))
(is (= (tempids tx) (is (= (tempids tx)
{-1 101})))) {-1 101}))))
(testing "upsert with existing id" (testing "upsert with existing id"
(let [tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :age 36}] now))] (let [tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :age 36}]))]
(is (= (<? (<shallow-entity (dm/db conn) 101)) (is (= (<? (<shallow-entity (dm/db conn) 101))
{:name "Ivan" :email "@1" :age 36})) {:name "Ivan" :email "@1" :age 36}))
(is (= (tempids tx) (is (= (tempids tx)
{})))) {}))))
(testing "upsert by 2 attrs with existing id" (testing "upsert by 2 attrs with existing id"
(let [tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1" :age 37}] now))] (let [tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1" :age 37}]))]
(is (= (<? (<shallow-entity (dm/db conn) 101)) (is (= (<? (<shallow-entity (dm/db conn) 101))
{:name "Ivan" :email "@1" :age 37})) {:name "Ivan" :email "@1" :age 37}))
(is (= (tempids tx) (is (= (tempids tx)
@ -358,12 +344,12 @@
(testing "upsert to two entities, resolve to same tempid, fails due to overlapping writes" (testing "upsert to two entities, resolve to same tempid, fails due to overlapping writes"
(is (thrown-with-msg? Throwable #"cardinality constraint" (is (thrown-with-msg? Throwable #"cardinality constraint"
(<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35} (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}
{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 36}] now))))) {:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 36}])))))
(testing "upsert to two entities, two tempids, fails due to overlapping writes" (testing "upsert to two entities, two tempids, fails due to overlapping writes"
(is (thrown-with-msg? Throwable #"cardinality constraint" (is (thrown-with-msg? Throwable #"cardinality constraint"
(<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35} (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}
{:db/id (dm/id-literal :db.part/user -2) :name "Ivan" :age 36}] now)))))) {:db/id (dm/id-literal :db.part/user -2) :name "Ivan" :age 36}]))))))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
@ -373,32 +359,31 @@
(let [c (<? (s/<sqlite-connection t)) (let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema)) db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now 0xdeadbeef
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))] tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try (try
;; Not having DB-as-value really hurts us here. This test only works because all upserts ;; Not having DB-as-value really hurts us here. This test only works because all upserts
;; fail until the final one, so we never need to reset the underlying store. ;; fail until the final one, so we never need to reset the underlying store.
(<? (dm/<transact! conn test-schema now)) (<? (dm/<transact! conn test-schema))
(let [tx0 (tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"} (let [tx0 (:tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}] now)))] {:db/id 102 :name "Petr" :email "@2"}])))]
;; TODO: improve error message to refer to upsert inputs. ;; TODO: improve error message to refer to upsert inputs.
(testing "upsert conficts with existing id" (testing "upsert conficts with existing id"
(is (thrown-with-msg? Throwable #"unique constraint" (is (thrown-with-msg? Throwable #"unique constraint"
(<? (dm/<transact! conn [{:db/id 102 :name "Ivan" :age 36}] now))))) (<? (dm/<transact! conn [{:db/id 102 :name "Ivan" :age 36}])))))
;; TODO: improve error message to refer to upsert inputs. ;; TODO: improve error message to refer to upsert inputs.
(testing "upsert conficts with non-existing id" (testing "upsert conficts with non-existing id"
(is (thrown-with-msg? Throwable #"unique constraint" (is (thrown-with-msg? Throwable #"unique constraint"
(<? (dm/<transact! conn [{:db/id 103 :name "Ivan" :age 36}] now))))) (<? (dm/<transact! conn [{:db/id 103 :name "Ivan" :age 36}])))))
;; TODO: improve error message to refer to upsert inputs. ;; TODO: improve error message to refer to upsert inputs.
(testing "upsert by 2 conflicting fields" (testing "upsert by 2 conflicting fields"
(is (thrown-with-msg? Throwable #"Conflicting upsert: #datomish.db.TempId\{:part :db.part/user, :idx -\d+\} resolves both to \d+ and \d+" (is (thrown-with-msg? Throwable #"Conflicting upsert: #datomish.db.TempId\{:part :db.part/user, :idx -\d+\} resolves both to \d+ and \d+"
(<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@2" :age 35}] now))))) (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@2" :age 35}])))))
(testing "upsert by non-existing value resolves as update" (testing "upsert by non-existing value resolves as update"
(let [report (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@3" :age 35}] now))] (let [report (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@3" :age 35}]))]
(is (= (<? (<shallow-entity (dm/db conn) 101)) (is (= (<? (<shallow-entity (dm/db conn) 101))
{:name "Ivan" :email "@3" :age 35})) {:name "Ivan" :email "@3" :age 35}))
(is (= (tempids report) (is (= (tempids report)
@ -411,27 +396,26 @@
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema)) db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db) conn (dm/connection-with-db db)]
now -1]
(try (try
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/db -1) :db/ident :test/ident]] now)) (let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/db -1) :db/ident :test/ident]]))
db-after (:db-after report) db-after (:db-after report)
tx (:current-tx db-after)] tx (:tx db-after)]
(is (= (:test/ident (dm/idents db-after)) (get-in report [:tempids (dm/id-literal :db.part/db -1)])))) (is (= (:test/ident (dm/idents db-after)) (get-in report [:tempids (dm/id-literal :db.part/db -1)]))))
;; TODO: This should fail, but doesn't, due to stringification of :test/ident. ;; TODO: This should fail, but doesn't, due to stringification of :test/ident.
;; (is (thrown-with-msg? ;; (is (thrown-with-msg?
;; ExceptionInfo #"Retracting a :db/ident is not yet supported, got " ;; ExceptionInfo #"Retracting a :db/ident is not yet supported, got "
;; (<? (dm/<transact! conn [[:db/retract 44 :db/ident :test/ident]] now)))) ;; (<? (dm/<transact! conn [[:db/retract 44 :db/ident :test/ident]]))))
;; ;; Renaming looks like retraction and then assertion. ;; ;; Renaming looks like retraction and then assertion.
;; (is (thrown-with-msg? ;; (is (thrown-with-msg?
;; ExceptionInfo #"Retracting a :db/ident is not yet supported, got" ;; ExceptionInfo #"Retracting a :db/ident is not yet supported, got"
;; (<? (dm/<transact! conn [[:db/add 44 :db/ident :other-name]] now)))) ;; (<? (dm/<transact! conn [[:db/add 44 :db/ident :other-name]]))))
;; (is (thrown-with-msg? ;; (is (thrown-with-msg?
;; ExceptionInfo #"Re-asserting a :db/ident is not yet supported, got" ;; ExceptionInfo #"Re-asserting a :db/ident is not yet supported, got"
;; (<? (dm/<transact! conn [[:db/add 55 :db/ident :test/ident]] now)))) ;; (<? (dm/<transact! conn [[:db/add 55 :db/ident :test/ident]]))))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
@ -440,17 +424,16 @@
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema)) db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db) conn (dm/connection-with-db db)]
now -1]
(try (try
(let [es [[:db/add :db.part/db :db.install/attribute (dm/id-literal :db.part/db -1)] (let [es [[:db/add :db.part/db :db.install/attribute (dm/id-literal :db.part/db -1)]
{:db/id (dm/id-literal :db.part/db -1) {:db/id (dm/id-literal :db.part/db -1)
:db/ident :test/attr :db/ident :test/attr
:db/valueType :db.type/string :db/valueType :db.type/string
:db/cardinality :db.cardinality/one}] :db/cardinality :db.cardinality/one}]
report (<? (dm/<transact! conn es now)) report (<? (dm/<transact! conn es))
db-after (:db-after report) db-after (:db-after report)
tx (:current-tx db-after)] tx (:tx db-after)]
(testing "New ident is allocated" (testing "New ident is allocated"
(is (some? (get-in db-after [:idents :test/attr])))) (is (some? (get-in db-after [:idents :test/attr]))))
@ -474,7 +457,6 @@
(let [c (<? (s/<sqlite-connection t)) (let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema)) db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now 0xdeadbeef
schema [{:db/id (dm/id-literal :db.part/db -1) schema [{:db/id (dm/id-literal :db.part/db -1)
:db/ident :test/fulltext :db/ident :test/fulltext
:db/valueType :db.type/string :db/valueType :db.type/string
@ -488,10 +470,10 @@
:db/cardinality :db.cardinality/one} :db/cardinality :db.cardinality/one}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :db.part/db -2)} {:db/id :db.part/db :db.install/attribute (dm/id-literal :db.part/db -2)}
] ]
tx0 (tx (<? (dm/<transact! conn schema now)))] tx0 (:tx (<? (dm/<transact! conn schema)))]
(try (try
(testing "Can add fulltext indexed datoms" (testing "Can add fulltext indexed datoms"
(let [r (<? (dm/<transact! conn [[:db/add 101 :test/fulltext "test this"]] now))] (let [r (<? (dm/<transact! conn [[:db/add 101 :test/fulltext "test this"]]))]
(is (= (<? (<fulltext-values (dm/db conn))) (is (= (<? (<fulltext-values (dm/db conn)))
[[1 "test this"]])) [[1 "test this"]]))
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (dm/db conn) tx0))
@ -499,7 +481,7 @@
)) ))
(testing "Can replace fulltext indexed datoms" (testing "Can replace fulltext indexed datoms"
(let [r (<? (dm/<transact! conn [[:db/add 101 :test/fulltext "alternate thing"]] now))] (let [r (<? (dm/<transact! conn [[:db/add 101 :test/fulltext "alternate thing"]]))]
(is (= (<? (<fulltext-values (dm/db conn))) (is (= (<? (<fulltext-values (dm/db conn)))
[[1 "test this"] [[1 "test this"]
[2 "alternate thing"]])) [2 "alternate thing"]]))
@ -508,7 +490,7 @@
)) ))
(testing "Can upsert keyed by fulltext indexed datoms" (testing "Can upsert keyed by fulltext indexed datoms"
(let [r (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user) :test/fulltext "alternate thing" :test/other "other"}] now))] (let [r (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user) :test/fulltext "alternate thing" :test/other "other"}]))]
(is (= (<? (<fulltext-values (dm/db conn))) (is (= (<? (<fulltext-values (dm/db conn)))
[[1 "test this"] [[1 "test this"]
[2 "alternate thing"] [2 "alternate thing"]
@ -519,7 +501,7 @@
)) ))
(testing "Can re-use fulltext indexed datoms" (testing "Can re-use fulltext indexed datoms"
(let [r (<? (dm/<transact! conn [[:db/add 102 :test/other "test this"]] now))] (let [r (<? (dm/<transact! conn [[:db/add 102 :test/other "test this"]]))]
(is (= (<? (<fulltext-values (dm/db conn))) (is (= (<? (<fulltext-values (dm/db conn)))
[[1 "test this"] [[1 "test this"]
[2 "alternate thing"] [2 "alternate thing"]
@ -531,7 +513,7 @@
)) ))
(testing "Can retract fulltext indexed datoms" (testing "Can retract fulltext indexed datoms"
(let [r (<? (dm/<transact! conn [[:db/retract 101 :test/fulltext "alternate thing"]] now))] (let [r (<? (dm/<transact! conn [[:db/retract 101 :test/fulltext "alternate thing"]]))]
(is (= (<? (<fulltext-values (dm/db conn))) (is (= (<? (<fulltext-values (dm/db conn)))
[[1 "test this"] [[1 "test this"]
[2 "alternate thing"] [2 "alternate thing"]
@ -543,3 +525,39 @@
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
(deftest-async test-txInstant
(with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
{tx0 :tx} (<? (dm/<transact! conn test-schema))]
(try
(let [{txa :tx txInstantA :txInstant} (<? (dm/<transact! conn []))]
(testing ":db/txInstant is set by default"
(is (= (<? (<transactions-after (dm/db conn) tx0))
[[txa :db/txInstant txInstantA txa 1]])))
;; TODO: range check txInstant values against DB clock.
(testing ":db/txInstant can be set explicitly"
(let [{txb :tx txInstantB :txInstant} (<? (dm/<transact! conn [[:db/add :db/tx :db/txInstant (+ txInstantA 1)]]))]
(is (= txInstantB (+ txInstantA 1)))
(is (= (<? (<transactions-after (dm/db conn) txa))
[[txb :db/txInstant txInstantB txb 1]]))
(testing ":db/txInstant can be set explicitly, with additional datoms"
(let [{txc :tx txInstantC :txInstant} (<? (dm/<transact! conn [[:db/add :db/tx :db/txInstant (+ txInstantB 2)]
[:db/add :db/tx :x 123]]))]
(is (= txInstantC (+ txInstantB 2)))
(is (= (<? (<transactions-after (dm/db conn) txb))
[[txc :db/txInstant txInstantC txc 1]
[txc :x 123 txc 1]]))
(testing "additional datoms can be added, without :db/txInstant explicitly"
(let [{txd :tx txInstantD :txInstant} (<? (dm/<transact! conn [[:db/add :db/tx :x 456]]))]
(is (= (<? (<transactions-after (dm/db conn) txc))
[[txd :db/txInstant txInstantD txd 1]
[txd :x 456 txd 1]])))))))))
(finally
(<? (dm/close-db db)))))))