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

90
src/datomish/db.cljc
View file

@ -35,6 +35,11 @@
(uncaughtException [_ thread ex]
(println ex "Uncaught exception on" (.getName thread))))))
(defprotocol IClock
(now
[clock]
"Return integer milliseconds since the Unix epoch."))
(defprotocol IDB
(query-context
[db])
@ -72,7 +77,8 @@
"TODO: document this interface."))
(defn db? [x]
(and (satisfies? IDB x)))
(and (satisfies? IDB x)
(satisfies? IClock x)))
(defn- row->Datom [schema row]
(let [e (:e row)
@ -186,7 +192,14 @@
(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
(close
@ -238,6 +251,7 @@
(defrecord TxReport [db-before ;; The DB before 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.
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.
@ -496,11 +510,15 @@
(defrecord Transaction [db tempids entities])
(defn- tx-entity [db]
(let [tx (current-tx db)]
[:db/add tx :db/txInstant 0xdeadbeef tx])) ;; TODO: now.
(defn- tx-entity [db report]
{:pre [(db? db) (report? report)]}
(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]
[op e a v (or tx current-tx)]))
@ -533,10 +551,31 @@
true
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]
{: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)
(raise "Bad transaction data " initial-es ", expected sequential collection"
{:error :transact/syntax, :tx-data initial-es}))
@ -545,8 +584,6 @@
(->
report
(update :entities conj (tx-entity db))
;; Normalize Datoms into :db/add or :db/retract vectors.
(update :entities (partial map maybe-datom->entity))
@ -557,11 +594,21 @@
(update :entities (partial map ensure-entity-form))
;; Replace idents with entids where possible.
(update :entities (partial map (partial maybe-ident->entid db)))
;; Replace idents with entids where possible, using db* to capture :db/tx.
(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.
(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]
(and (sequential? x)
@ -811,7 +858,7 @@
{:error :transact/syntax, :operation op, :tx-data entity})))))))
(defn <transact-tx-data
[db now report]
[db report]
{:pre [(db? db) (report? report)]}
(go-pair
@ -924,7 +971,12 @@
(map->TxReport
{:db-before db
:db-after db
;; :current-tx current-tx
;; This mimics DataScript. It's convenient to be able to extract the
;; transaction ID and transaction timestamp directly from the report; Datomic
;; makes this surprisingly difficult: one needs a :db.part/tx temporary and an
;; explicit upsert of that temporary.
:tx (current-tx db)
:txInstant (now db)
:entities tx-data
:tx-data []
:tempids {}
@ -933,7 +985,7 @@
:added-attributes {}
})
(<transact-tx-data db 0xdeadbeef) ;; TODO: timestamp properly.
(<transact-tx-data db)
(<?)
(collect-db-ident-assertions db)
@ -975,14 +1027,12 @@
(:db-after (<? (<with db tx-data)))))
(defn <transact!
([conn tx-data]
(<transact! conn tx-data 0xdeadbeef)) ;; TODO: timestamp!
([conn tx-data now]
[conn tx-data]
{:pre [(conn? conn)]}
(let [db (db conn)] ;; TODO: be careful with swapping atoms.
(s/in-transaction!
(:sqlite-connection db)
#(go-pair
(let [report (<? (<with db tx-data))] ;; TODO: timestamp!
(let [report (<? (<with db tx-data))]
(reset! (:current-db conn) (:db-after report))
report))))))
report)))))

200
test/datomish/db_test.cljc
View file

@ -76,9 +76,6 @@
(<?)
(mapv #(vector (:rowid %) (:text %))))))
(defn tx [report]
(get-in report [:db-after :current-tx]))
;; TODO: use reverse refs!
(def test-schema
[{:db/id (dm/id-literal :test -1)
@ -121,18 +118,15 @@
(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)
now 0xdeadbeef]
conn (dm/connection-with-db db)]
(try
(let [tx0 (tx (<? (dm/<transact! conn test-schema now)))]
(let [;; TODO: drop now, allow to set :db/txInstant.
report (<? (dm/<transact! conn [[:db/add 0 :name "valuex"]] now))
tx (tx report)]
(let [{tx0 :tx} (<? (dm/<transact! conn test-schema))]
(let [{:keys [tx txInstant]} (<? (dm/<transact! conn [[:db/add 0 :name "valuex"]]))]
(is (= (<? (<datoms-after (dm/db conn) tx0))
#{[0 :name "valuex"]}))
(is (= (<? (<transactions-after (dm/db conn) tx0))
[[0 :name "valuex" tx 1] ;; TODO: true, not 1.
[tx :db/txInstant now tx 1]]))))
[tx :db/txInstant txInstant tx 1]]))))
(finally
(<? (dm/close-db db)))))))
@ -140,14 +134,13 @@
(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)
now 0xdeadbeef]
conn (dm/connection-with-db db)]
(try
(let [tx0 (tx (<? (dm/<transact! conn test-schema now)))
tx1 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Ivan"]] now)))
tx2 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Petr"]] now)))
tx3 (tx (<? (dm/<transact! conn [[:db/add 1 :aka "Tupen"]] now)))
tx4 (tx (<? (dm/<transact! conn [[:db/add 1 :aka "Devil"]] now)))]
(let [{tx0 :tx} (<? (dm/<transact! conn test-schema))
{tx1 :tx txInstant1 :txInstant} (<? (dm/<transact! conn [[:db/add 1 :name "Ivan"]]))
{tx2 :tx txInstant2 :txInstant} (<? (dm/<transact! conn [[:db/add 1 :name "Petr"]]))
{tx3 :tx txInstant3 :txInstant} (<? (dm/<transact! conn [[:db/add 1 :aka "Tupen"]]))
{tx4 :tx txInstant4 :txInstant} (<? (dm/<transact! conn [[:db/add 1 :aka "Devil"]]))]
(is (= (<? (<datoms-after (dm/db conn) tx0))
#{[1 :name "Petr"]
[1 :aka "Tupen"]
@ -155,36 +148,34 @@
(is (= (<? (<transactions-after (dm/db conn) tx0))
[[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 "Petr" tx2 1]
[tx2 :db/txInstant now tx2 1]
[tx2 :db/txInstant txInstant2 tx2 1]
[1 :aka "Tupen" tx3 1]
[tx3 :db/txInstant now tx3 1]
[tx3 :db/txInstant txInstant3 tx3 1]
[1 :aka "Devil" tx4 1]
[tx4 :db/txInstant now tx4 1]])))
[tx4 :db/txInstant txInstant4 tx4 1]])))
(finally
(<? (dm/close-db db)))))))
;; TODO: fail multiple :add and :retract of the same datom in the same transaction.
(deftest-async test-retract
(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)
now 0xdeadbeef]
conn (dm/connection-with-db db)]
(try
(let [tx0 (tx (<? (dm/<transact! conn test-schema now)))
txa (tx (<? (dm/<transact! conn [[:db/add 0 :x 123]] now)))
txb (tx (<? (dm/<transact! conn [[:db/retract 0 :x 123]] now)))]
(let [{tx0 :tx} (<? (dm/<transact! conn test-schema))
{tx1 :tx txInstant1 :txInstant} (<? (dm/<transact! conn [[:db/add 0 :x 123]]))
{tx2 :tx txInstant2 :txInstant} (<? (dm/<transact! conn [[:db/retract 0 :x 123]]))]
(is (= (<? (<datoms-after (dm/db conn) tx0))
#{}))
(is (= (<? (<transactions-after (dm/db conn) tx0))
[[0 :x 123 txa 1] ;; TODO: true, not 1.
[txa :db/txInstant now txa 1]
[0 :x 123 txb 0]
[txb :db/txInstant now txb 1]])))
[[0 :x 123 tx1 1]
[tx1 :db/txInstant txInstant1 tx1 1]
[0 :x 123 tx2 0]
[tx2 :db/txInstant txInstant2 tx2 1]])))
(finally
(<? (dm/close-db db)))))))
@ -192,14 +183,13 @@
(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)
now -1]
conn (dm/connection-with-db db)]
(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]
[: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 3]] now))]
[:db/add (dm/id-literal :db.part/user -2) :y 3]]))]
(is (= (keys (:tempids report)) ;; TODO: include values.
[(dm/id-literal :db.part/user -1)
(dm/id-literal :db.part/user -2)]))
@ -219,21 +209,20 @@
(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)
now -1]
conn (dm/connection-with-db db)]
(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"
(is (thrown-with-msg?
ExceptionInfo #"unique constraint"
(<? (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"
(is (thrown-with-msg?
ExceptionInfo #"unique constraint"
(<? (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
(<? (dm/close-db db)))))))
@ -242,32 +231,31 @@
(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)
now -1]
conn (dm/connection-with-db db)]
(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/unique :db.unique/identity
: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)])]
(is (= (<? (<datoms-after (dm/db conn) tx0))
#{[eid :test/kw ":test/kw1"]})) ;; Value is raw.
(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))
#{[eid :test/kw ":test/kw1"]}))) ;; Value is raw.
(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))
#{[eid :test/kw ":test/kw2"]}))) ;; Value is raw.
(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))
#{})))))
@ -279,18 +267,17 @@
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
now 0xdeadbeef
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try
;; 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.
(<? (dm/<transact! conn test-schema now))
(let [tx0 (tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}] now)))]
(<? (dm/<transact! conn test-schema))
(let [tx0 (:tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}])))]
(testing "upsert with tempid"
(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))
{:name "Ivan" :age 12 :email "@1"}))
(is (= (tempids report)
@ -298,7 +285,7 @@
(testing "upsert with tempid, order does not matter"
(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))
{:name "Petr" :age 13 :email "@2"}))
(is (= (tempids report)
@ -309,7 +296,7 @@
(<? (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) :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
(<? (dm/close-db db)))))))
@ -318,38 +305,37 @@
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
now 0xdeadbeef
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try
;; 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.
(<? (dm/<transact! conn test-schema now))
(let [tx0 (tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}] now)))]
(<? (dm/<transact! conn test-schema))
(let [tx0 (:tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}])))]
(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))
{:name "Ivan" :email "@1" :age 35}))
(is (= (tempids tx)
{-1 101}))))
(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))
{:name "Ivan" :email "@1" :age 35}))
(is (= (tempids tx)
{-1 101}))))
(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))
{:name "Ivan" :email "@1" :age 36}))
(is (= (tempids tx)
{}))))
(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))
{:name "Ivan" :email "@1" :age 37}))
(is (= (tempids tx)
@ -358,12 +344,12 @@
(testing "upsert to two entities, resolve to same tempid, fails due to overlapping writes"
(is (thrown-with-msg? Throwable #"cardinality constraint"
(<? (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"
(is (thrown-with-msg? Throwable #"cardinality constraint"
(<? (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
(<? (dm/close-db db)))))))
@ -373,32 +359,31 @@
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
now 0xdeadbeef
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try
;; 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.
(<? (dm/<transact! conn test-schema now))
(let [tx0 (tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}] now)))]
(<? (dm/<transact! conn test-schema))
(let [tx0 (:tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}])))]
;; TODO: improve error message to refer to upsert inputs.
(testing "upsert conficts with existing id"
(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.
(testing "upsert conficts with non-existing id"
(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.
(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+"
(<? (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"
(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))
{:name "Ivan" :email "@3" :age 35}))
(is (= (tempids report)
@ -411,27 +396,26 @@
(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)
now -1]
conn (dm/connection-with-db db)]
(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)
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)]))))
;; TODO: This should fail, but doesn't, due to stringification of :test/ident.
;; (is (thrown-with-msg?
;; 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.
;; (is (thrown-with-msg?
;; 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?
;; 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
(<? (dm/close-db db)))))))
@ -440,17 +424,16 @@
(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)
now -1]
conn (dm/connection-with-db db)]
(try
(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/ident :test/attr
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one}]
report (<? (dm/<transact! conn es now))
report (<? (dm/<transact! conn es))
db-after (:db-after report)
tx (:current-tx db-after)]
tx (:tx db-after)]
(testing "New ident is allocated"
(is (some? (get-in db-after [:idents :test/attr]))))
@ -474,7 +457,6 @@
(let [c (<? (s/<sqlite-connection t))
db (<? (dm/<db-with-sqlite-connection c test-schema))
conn (dm/connection-with-db db)
now 0xdeadbeef
schema [{:db/id (dm/id-literal :db.part/db -1)
:db/ident :test/fulltext
:db/valueType :db.type/string
@ -488,10 +470,10 @@
:db/cardinality :db.cardinality/one}
{: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
(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)))
[[1 "test this"]]))
(is (= (<? (<datoms-after (dm/db conn) tx0))
@ -499,7 +481,7 @@
))
(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)))
[[1 "test this"]
[2 "alternate thing"]]))
@ -508,7 +490,7 @@
))
(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)))
[[1 "test this"]
[2 "alternate thing"]
@ -519,7 +501,7 @@
))
(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)))
[[1 "test this"]
[2 "alternate thing"]
@ -531,7 +513,7 @@
))
(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)))
[[1 "test this"]
[2 "alternate thing"]
@ -543,3 +525,39 @@
(finally
(<? (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)))))))