Bootstrap DB schema; persist and restore schema from materialized views.
This commit is contained in:
Nick Alexander
parent
5d271454ac
commit
296c9cb436
5 changed files with 420 additions and 215 deletions
|
|
@ -209,7 +209,15 @@
|
|||
(defn id-literal? [x]
|
||||
(and (instance? TempId x)))
|
||||
|
||||
(defrecord TxReport [db-before db-after entities tx-data tempids])
|
||||
(defrecord TxReport [db-before ;; The DB before the transaction.
|
||||
db-after ;; The DB after the transaction.
|
||||
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.
|
||||
added-parts ;; The set of parts added during the transaction via :db.part/db :db.install/part.
|
||||
added-idents ;; The map of idents -> entid added during the transaction, via e :db/ident ident.
|
||||
added-attributes ;; The map of schema attributes (ident -> schema fragment) added during the transaction, via :db.part/db :db.install/attribute.
|
||||
])
|
||||
|
||||
(defn- report? [x]
|
||||
(and (instance? TxReport x)))
|
||||
|
|
@ -234,8 +242,10 @@
|
|||
;; TODO: implement support for DB parts?
|
||||
(def tx0 0x2000000)
|
||||
|
||||
(def default-schema
|
||||
{
|
||||
(def ^{:private true} bootstrap-symbolic-schema
|
||||
{:db/ident {:db/valueType :db.type/keyword
|
||||
:db/cardinality :db.cardinality/one
|
||||
:db/unique :db.unique/identity}
|
||||
:db.install/partition {:db/valueType :db.type/ref
|
||||
:db/cardinality :db.cardinality/many}
|
||||
:db.install/valueType {:db/valueType :db.type/ref
|
||||
|
|
@ -247,10 +257,7 @@
|
|||
;; :db/cardinality :db.cardinality/many}
|
||||
:db/txInstant {:db/valueType :db.type/integer
|
||||
:db/cardinality :db.cardinality/one
|
||||
:db/index true}
|
||||
:db/ident {:db/valueType :db.type/keyword
|
||||
:db/cardinality :db.cardinality/one
|
||||
:db/unique :db.unique/identity}
|
||||
} ;; :db/index true} TODO: Handle this using SQLite protocol.
|
||||
:db/valueType {:db/valueType :db.type/ref
|
||||
:db/cardinality :db.cardinality/one}
|
||||
:db/cardinality {:db/valueType :db.type/ref
|
||||
|
|
@ -267,13 +274,90 @@
|
|||
:db/cardinality :db.cardinality/one}
|
||||
})
|
||||
|
||||
(def ^{:private true} bootstrap-idents
|
||||
{:db/ident 1
|
||||
:db.part/db 2
|
||||
:db/txInstant 3
|
||||
:db.install/partition 4
|
||||
:db.install/valueType 5
|
||||
:db.install/attribute 6
|
||||
:db/valueType 7
|
||||
:db/cardinality 8
|
||||
:db/unique 9
|
||||
:db/isComponent 10
|
||||
:db/index 11
|
||||
:db/fulltext 12
|
||||
:db/noHistory 13
|
||||
:db/add 14
|
||||
:db/retract 15
|
||||
:db.part/tx 16
|
||||
:db.part/user 17
|
||||
:db/excise 18
|
||||
:db.excise/attrs 19
|
||||
:db.excise/beforeT 20
|
||||
:db.excise/before 21
|
||||
:db.alter/attribute 22
|
||||
:db.type/ref 23
|
||||
:db.type/keyword 24
|
||||
:db.type/integer 25 ;; TODO: :db.type/long, to match Datomic?
|
||||
:db.type/string 26
|
||||
:db.type/boolean 27
|
||||
:db.type/instant 28
|
||||
:db.type/bytes 29
|
||||
:db.cardinality/one 30
|
||||
:db.cardinality/many 31
|
||||
:db.unique/value 32
|
||||
:db.unique/identity 33})
|
||||
|
||||
(defn- bootstrap-tx-data []
|
||||
(concat
|
||||
(map (fn [[ident entid]] [:db/add entid :db/ident ident]) bootstrap-idents)
|
||||
(map (fn [[ident attrs]] (assoc attrs :db/id ident)) bootstrap-symbolic-schema)
|
||||
(map (fn [[ident attrs]] [:db/add :db.part/db :db.install/attribute (get bootstrap-idents ident)]) bootstrap-symbolic-schema) ;; TODO: fail if nil.
|
||||
))
|
||||
|
||||
(defn <idents [sqlite-connection]
|
||||
"Read the ident map materialized view from the given SQLite store.
|
||||
Returns a map (keyword ident) -> (integer entid), like {:db/ident 0}."
|
||||
|
||||
(let [<-SQLite (get-in ds/value-type-map [:db.type/keyword :<-SQLite])] ;; TODO: make this a protocol.
|
||||
(go-pair
|
||||
(let [rows (<? (->>
|
||||
{:select [:ident :entid] :from [:idents]}
|
||||
(sql/format)
|
||||
(s/all-rows sqlite-connection)))]
|
||||
(into {} (map (fn [row] [(<-SQLite (:ident row)) (:entid row)])) rows)))))
|
||||
|
||||
(defn <current-tx [sqlite-connection]
|
||||
"Find the largest tx written to the SQLite store.
|
||||
Returns an integer, -1 if no transactions have been written yet."
|
||||
|
||||
(go-pair
|
||||
(let [rows (<? (->>
|
||||
{:select [:e :v] :from [:datoms] :where [:= :a ":db/ident"]} ;; TODO: use raw entid.
|
||||
(sql/format)
|
||||
(s/all-rows sqlite-connection)))]
|
||||
(into {} (map #(-> {(keyword (:v %)) (:e %)})) rows))))
|
||||
(let [rows (<? (s/all-rows sqlite-connection ["SELECT COALESCE(MAX(tx), -1) AS current_tx FROM transactions"]))]
|
||||
(:current_tx (first rows)))))
|
||||
|
||||
(defn <symbolic-schema [sqlite-connection]
|
||||
"Read the schema map materialized view from the given SQLite store.
|
||||
Returns a map (keyword ident) -> (map (keyword attribute -> keyword value)), like
|
||||
{:db/ident {:db/cardinality :db.cardinality/one}}."
|
||||
|
||||
(let [<-SQLite (get-in ds/value-type-map [:db.type/keyword :<-SQLite])] ;; TODO: make this a protocol.
|
||||
(go-pair
|
||||
(->>
|
||||
(->>
|
||||
{:select [:ident :attr :value] :from [:schema]}
|
||||
(sql/format)
|
||||
(s/all-rows sqlite-connection))
|
||||
(<?)
|
||||
|
||||
(group-by (comp <-SQLite :ident))
|
||||
(map (fn [[ident rows]]
|
||||
[ident
|
||||
(into {} (map (fn [row]
|
||||
[(<-SQLite (:attr row)) (<-SQLite (:value row))]) rows))]))
|
||||
(into {})))))
|
||||
|
||||
(declare <with-internal)
|
||||
|
||||
(defn <db-with-sqlite-connection
|
||||
([sqlite-connection]
|
||||
|
|
@ -283,16 +367,56 @@
|
|||
(go-pair
|
||||
(when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
|
||||
(raise "Could not ensure current SQLite schema version."))
|
||||
(let [idents (clojure.set/union [:db/txInstant :db/ident :db.part/db :db.install/attribute :db.type/string :db.type/integer :db.type/ref :db/id :db.cardinality/one :db.cardinality/many :db/cardinality :db/valueType :x :y :name :aka :test/kw :age :email :spouse] (keys default-schema))
|
||||
idents (into {} (map-indexed #(vector %2 %1) idents))
|
||||
idents (into (<? (<idents sqlite-connection)) idents) ;; TODO: pre-populate idents and SQLite tables?
|
||||
symbolic-schema (merge schema default-schema)]
|
||||
(map->DB
|
||||
{:sqlite-connection sqlite-connection
|
||||
:idents idents
|
||||
:symbolic-schema symbolic-schema
|
||||
:schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) symbolic-schema)))
|
||||
:current-tx tx0})))))
|
||||
|
||||
(let [current-tx (<? (<current-tx sqlite-connection))
|
||||
bootstrapped (>= current-tx 0)
|
||||
current-tx (max current-tx tx0)]
|
||||
(when-not bootstrapped
|
||||
;; We need to bootstrap the DB.
|
||||
(let [fail-alter-ident (fn [old new] (if-not (= old new)
|
||||
(raise "Altering idents is not yet supported, got " new " altering existing ident " old
|
||||
{:error :schema/alter-idents :old old :new new})
|
||||
new))
|
||||
fail-alter-attr (fn [old new] (if-not (= old new)
|
||||
(raise "Altering schema attributes is not yet supported, got " new " altering existing schema attribute " old
|
||||
{:error :schema/alter-schema :old old :new new})
|
||||
new))]
|
||||
(-> (map->DB
|
||||
{:sqlite-connection sqlite-connection
|
||||
:idents bootstrap-idents
|
||||
:symbolic-schema bootstrap-symbolic-schema
|
||||
:schema (ds/schema (into {} (map (fn [[k v]] [(k bootstrap-idents) v]) bootstrap-symbolic-schema))) ;; TODO: fail if ident missing.
|
||||
:current-tx current-tx})
|
||||
;; We use <with rather than <transact! to apply the bootstrap transaction data but to
|
||||
;; not follow the regular schema application process. We can't apply the schema
|
||||
;; changes, since the applied datoms would conflict with the bootstrapping idents and
|
||||
;; schema. (The bootstrapping idents and schema are required to be able to write to
|
||||
;; the database conveniently; without them, we'd have to manually write datoms to the
|
||||
;; store. It's feasible but awkward.) After bootstrapping, we read back the idents
|
||||
;; and schema, just like when we re-open.
|
||||
(<with-internal (bootstrap-tx-data) fail-alter-ident fail-alter-attr)
|
||||
(<?))))
|
||||
|
||||
;; We just bootstrapped, or we are returning to an already bootstrapped DB.
|
||||
(let [idents (<? (<idents sqlite-connection))
|
||||
symbolic-schema (<? (<symbolic-schema sqlite-connection))]
|
||||
(when-not bootstrapped
|
||||
(when (not (= idents bootstrap-idents))
|
||||
(raise "After bootstrapping database, expected new materialized idents and old bootstrapped idents to be identical"
|
||||
{:error :bootstrap/bad-idents,
|
||||
:new idents :old bootstrap-idents
|
||||
}))
|
||||
(when (not (= symbolic-schema bootstrap-symbolic-schema))
|
||||
(raise "After bootstrapping database, expected new materialized symbolic schema and old bootstrapped symbolic schema to be identical"
|
||||
{:error :bootstrap/bad-symbolic-schema,
|
||||
:new symbolic-schema :old bootstrap-symbolic-schema
|
||||
})))
|
||||
(map->DB
|
||||
{:sqlite-connection sqlite-connection
|
||||
:idents idents
|
||||
:symbolic-schema symbolic-schema
|
||||
:schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) symbolic-schema))) ;; TODO: fail if ident missing.
|
||||
:current-tx (inc current-tx)}))))))
|
||||
|
||||
(defn connection-with-db [db]
|
||||
(map->Connection {:current-db (atom db)}))
|
||||
|
|
@ -688,22 +812,22 @@
|
|||
(defn- is-ident? [db [_ a & _]]
|
||||
(= a (get-in db [:idents :db/ident])))
|
||||
|
||||
(defn process-db-ident-assertions
|
||||
(defn collect-db-ident-assertions
|
||||
"Transactions may add idents, install new partitions, and install new schema attributes.
|
||||
Handle :db/ident assertions here."
|
||||
Collect :db/ident assertions into :added-idents here."
|
||||
[db report]
|
||||
{:pre [(db? db) (report? report)]}
|
||||
|
||||
;; TODO: use q to filter the report!
|
||||
(let [original-db db
|
||||
(let [original-report report
|
||||
tx-data (:tx-data report)
|
||||
original-ident-assertions (filter (partial is-ident? db) tx-data)]
|
||||
(loop [db original-db
|
||||
(loop [report original-report
|
||||
ident-assertions original-ident-assertions]
|
||||
(let [[ia & ias] ident-assertions]
|
||||
(cond
|
||||
(nil? ia)
|
||||
db
|
||||
report
|
||||
|
||||
(not (:added ia))
|
||||
(raise "Retracting a :db/ident is not yet supported, got " ia
|
||||
|
|
@ -713,13 +837,8 @@
|
|||
:else
|
||||
;; Added.
|
||||
(let [ident (:v ia)]
|
||||
;; TODO: accept re-assertions?
|
||||
(when (get-in db [:idents ident])
|
||||
(raise "Re-asserting a :db/ident is not yet supported, got " ia
|
||||
{:error :schema/idents
|
||||
:op ia }))
|
||||
(if (keyword? ident)
|
||||
(recur (assoc-in db [:idents ident] (:e ia)) ias)
|
||||
(recur (assoc-in report [:added-idents ident] (:e ia)) ias)
|
||||
(raise "Cannot assert a :db/ident with a non-keyword value, got " ia
|
||||
{:error :schema/idents
|
||||
:op ia }))))))))
|
||||
|
|
@ -735,51 +854,91 @@
|
|||
(symbolicate tx)
|
||||
added)))
|
||||
|
||||
(defn process-db-install-assertions
|
||||
(defn collect-db-install-assertions
|
||||
"Transactions may add idents, install new partitions, and install new schema attributes.
|
||||
Handle [:db.part/db :db.install/attribute] assertions here."
|
||||
Collect [:db.part/db :db.install/attribute] assertions here."
|
||||
[db report]
|
||||
{:pre [(db? db) (report? report)]}
|
||||
|
||||
;; TODO: be more efficient; symbolicating each datom is expensive!
|
||||
(let [datoms (map (partial symbolicate-datom db) (:tx-data report))
|
||||
schema-fragment (datomish.schema-changes/datoms->schema-fragment datoms)
|
||||
fail (fn [old new] (raise "Altering schema elements is not yet supported, got " new " altering existing schema element " old
|
||||
{:error :schema/alter-schema :old old :new new}))]
|
||||
schema-fragment (datomish.schema-changes/datoms->schema-fragment datoms)]
|
||||
(assoc-in report [:added-attributes] schema-fragment)))
|
||||
|
||||
(if (empty? schema-fragment)
|
||||
db
|
||||
(let [symbolic-schema (merge-with fail (:symbolic-schema db) schema-fragment)
|
||||
schema (ds/schema (into {} (map (fn [[k v]] [(k (idents db)) v]) symbolic-schema)))]
|
||||
(assoc db
|
||||
:symbolic-schema symbolic-schema
|
||||
:schema schema)))))
|
||||
|
||||
(defn <with [db tx-data]
|
||||
;; TODO: lift to IDB.
|
||||
(defn <apply-db-ident-assertions [db added-idents]
|
||||
(go-pair
|
||||
(let [report (<? (<transact-tx-data db 0xdeadbeef ;; TODO
|
||||
(map->TxReport
|
||||
{:db-before db
|
||||
:db-after db
|
||||
;; :current-tx current-tx
|
||||
:entities tx-data
|
||||
:tx-data []
|
||||
:tempids {}})))
|
||||
db-after (->
|
||||
db
|
||||
(let [->SQLite (get-in ds/value-type-map [:db.type/keyword :->SQLite]) ;; TODO: make this a protocol.
|
||||
exec (partial s/execute! (:sqlite-connection db))]
|
||||
;; TODO: batch insert.
|
||||
(doseq [[ident entid] added-idents]
|
||||
(<? (exec
|
||||
["INSERT INTO idents VALUES (?, ?)" (->SQLite ident) entid]))))
|
||||
db))
|
||||
|
||||
(<apply-datoms (:tx-data report))
|
||||
(<?)
|
||||
(defn <apply-db-install-assertions [db fragment]
|
||||
(go-pair
|
||||
(let [->SQLite (get-in ds/value-type-map [:db.type/keyword :->SQLite]) ;; TODO: make this a protocol.
|
||||
exec (partial s/execute! (:sqlite-connection db))]
|
||||
;; TODO: batch insert.
|
||||
(doseq [[ident attr-map] fragment]
|
||||
(doseq [[attr value] attr-map]
|
||||
(<? (exec
|
||||
["INSERT INTO schema VALUES (?, ?, ?)" (->SQLite ident) (->SQLite attr) (->SQLite value)])))))
|
||||
db))
|
||||
|
||||
(<advance-tx)
|
||||
(<?)
|
||||
(defn- <with-internal [db tx-data merge-ident merge-attr]
|
||||
(go-pair
|
||||
(let [report (->>
|
||||
(map->TxReport
|
||||
{:db-before db
|
||||
:db-after db
|
||||
;; :current-tx current-tx
|
||||
:entities tx-data
|
||||
:tx-data []
|
||||
:tempids {}
|
||||
:added-parts {}
|
||||
:added-idents {}
|
||||
:added-attributes {}
|
||||
})
|
||||
|
||||
(process-db-ident-assertions report)
|
||||
(<transact-tx-data db 0xdeadbeef) ;; TODO: timestamp properly.
|
||||
(<?)
|
||||
|
||||
(process-db-install-assertions report))]
|
||||
(collect-db-ident-assertions db)
|
||||
|
||||
(collect-db-install-assertions db))
|
||||
idents (merge-with merge-ident (:idents db) (:added-idents report))
|
||||
symbolic-schema (merge-with merge-attr (:symbolic-schema db) (:added-attributes report))
|
||||
schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) symbolic-schema)))
|
||||
db-after (->
|
||||
db
|
||||
|
||||
(<apply-datoms (:tx-data report))
|
||||
(<?)
|
||||
|
||||
(<apply-db-ident-assertions (:added-idents report))
|
||||
(<?)
|
||||
|
||||
(<apply-db-install-assertions (:added-attributes report))
|
||||
(<?)
|
||||
|
||||
(assoc :idents idents
|
||||
:symbolic-schema symbolic-schema
|
||||
:schema schema)
|
||||
|
||||
(<advance-tx)
|
||||
(<?))]
|
||||
(-> report
|
||||
(assoc-in [:db-after] db-after)))))
|
||||
|
||||
(defn- <with [db tx-data]
|
||||
(let [fail-touch-ident (fn [old new] (raise "Altering idents is not yet supported, got " new " altering existing ident " old
|
||||
{:error :schema/alter-idents :old old :new new}))
|
||||
fail-touch-attr (fn [old new] (raise "Altering schema attributes is not yet supported, got " new " altering existing schema attribute " old
|
||||
{:error :schema/alter-schema :old old :new new}))]
|
||||
(<with-internal db tx-data fail-touch-ident fail-touch-attr)))
|
||||
|
||||
(defn <db-with [db tx-data]
|
||||
(go-pair
|
||||
(:db-after (<? (<with db tx-data)))))
|
||||
|
|
|
|||
|
|
@ -21,7 +21,8 @@
|
|||
Input: a sequence of datoms, like [e :keyword-attr v _ added].
|
||||
1. Select [:db.part/db :db.install/attribute ... ].
|
||||
2. Fail if any are not (= added true)
|
||||
3. For each [ :db.part/db :db.install/attribute e ], collect {e {:db/* v}}.
|
||||
3. For each [ :db.part/db :db.install/attribute e ], collect
|
||||
{e {:db/* v}}, dropping the inner :db/ident key.
|
||||
4. Map e -> ident; fail if not possible.
|
||||
5. Return the map, with ident keys.
|
||||
|
||||
|
|
@ -55,6 +56,6 @@
|
|||
db-avs (into {} (map ->av (filter db-*? datoms)))]
|
||||
;; TODO: get ident from existing datom, to allow [:db.part/db :db.install/attribute existing-id].
|
||||
(if-let [ident (:db/ident db-avs)]
|
||||
[ident db-avs]
|
||||
[ident (dissoc db-avs :db/ident)]
|
||||
(raise ":db.install/attribute requires :db/ident, got " db-avs " for " e
|
||||
{:error :schema/db-install :op db-avs}))))))))))
|
||||
|
|
|
|||
|
|
@ -25,11 +25,24 @@
|
|||
"CREATE INDEX aevt ON datoms (a, e)" ;; No v -- that's an opt-in index.
|
||||
"CREATE UNIQUE INDEX avet ON datoms (a, v, e) WHERE index_avet = 1" ;; Opt-in index: only if a has :db/index true.
|
||||
"CREATE UNIQUE INDEX vaet ON datoms (v, a, e) WHERE index_vaet = 1" ;; Opt-in index: only if a has :db/valueType :db.type/ref
|
||||
"CREATE UNIQUE INDEX unique_value ON datoms (v) WHERE unique_value = 1" ;; TODO.
|
||||
"CREATE UNIQUE INDEX unique_identity ON datoms (a, v) WHERE unique_identity = 1" ;; TODO.
|
||||
|
||||
;; TODO: possibly remove this index. :db.unique/value should be asserted by the transactor in
|
||||
;; all cases, but the index may speed up some of SQLite's query planning. For now, it services
|
||||
;; to validate the transactor implementation.
|
||||
"CREATE UNIQUE INDEX unique_value ON datoms (v) WHERE unique_value = 1"
|
||||
;; TODO: possibly remove this index. :db.unique/identity should be asserted by the transactor in
|
||||
;; all cases, but the index may speed up some of SQLite's query planning. For now, it serves to
|
||||
;; validate the transactor implementation.
|
||||
"CREATE UNIQUE INDEX unique_identity ON datoms (a, v) WHERE unique_identity = 1"
|
||||
|
||||
"CREATE TABLE transactions (e INTEGER NOT NULL, a SMALLINT NOT NULL, v BLOB NOT NULL, tx INTEGER NOT NULL, added TINYINT NOT NULL DEFAULT 1)"
|
||||
"CREATE INDEX tx ON transactions (tx)"
|
||||
"CREATE TABLE attributes (name TEXT NOT NULL PRIMARY KEY, a INTEGER UNIQUE NOT NULL)"])
|
||||
|
||||
;; Materialized views of the schema.
|
||||
"CREATE TABLE idents (ident TEXT NOT NULL PRIMARY KEY, entid INTEGER UNIQUE NOT NULL)"
|
||||
"CREATE TABLE schema (ident TEXT NOT NULL, attr TEXT NOT NULL, value TEXT NOT NULL, FOREIGN KEY (ident) REFERENCES idents (ident))"
|
||||
"CREATE INDEX unique_schema ON schema (ident, attr, value)"
|
||||
])
|
||||
|
||||
(defn <create-current-version
|
||||
[db]
|
||||
|
|
|
|||
|
|
@ -11,6 +11,7 @@
|
|||
(:require
|
||||
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
|
||||
[datomish.sqlite :as s]
|
||||
[datomish.sqlite-schema]
|
||||
[datomish.datom]
|
||||
|
||||
[datascript.core :as d]
|
||||
|
|
@ -35,16 +36,19 @@
|
|||
#?(:cljs
|
||||
(def Throwable js/Error))
|
||||
|
||||
(defn- <datoms [db]
|
||||
(defn- <datoms-after [db tx]
|
||||
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))]
|
||||
(go-pair
|
||||
(->>
|
||||
(s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms"])
|
||||
(s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms WHERE tx >= ?" tx])
|
||||
(<?)
|
||||
(mapv #(vector (:e %) (entids (:a %)) (:v %)))
|
||||
(mapv #(vector (:e %) (get entids (:a %) (str "fail" (:a %))) (:v %)))
|
||||
(filter #(not (= :db/txInstant (second %))))
|
||||
(set)))))
|
||||
|
||||
(defn- <datoms [db]
|
||||
(<datoms-after db 0))
|
||||
|
||||
(defn- <shallow-entity [db eid]
|
||||
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))]
|
||||
(go-pair
|
||||
|
|
@ -54,32 +58,57 @@
|
|||
(mapv #(vector (entids (:a %)) (:v %)))
|
||||
(reduce conj {})))))
|
||||
|
||||
(defn- <transactions [db]
|
||||
(defn- <transactions-after [db tx]
|
||||
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))]
|
||||
(go-pair
|
||||
(->>
|
||||
(s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx, added FROM transactions ORDER BY tx ASC, e, a, v, added"])
|
||||
(s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx, added FROM transactions WHERE tx >= ? ORDER BY tx ASC, e, a, v, added" tx])
|
||||
(<?)
|
||||
(mapv #(vector (:e %) (entids (:a %)) (:v %) (:tx %) (:added %)))))))
|
||||
|
||||
(defn- <transactions [db]
|
||||
(<transactions-after db 0))
|
||||
|
||||
(defn tx [report]
|
||||
(get-in report [:db-after :current-tx]))
|
||||
|
||||
;; TODO: use reverse refs!
|
||||
(def test-schema
|
||||
{:x {:db/unique :db.unique/identity
|
||||
:db/valueType :db.type/integer}
|
||||
:y {:db/cardinality :db.cardinality/many
|
||||
:db/valueType :db.type/integer}
|
||||
:name {:db/unique :db.unique/identity
|
||||
:db/valueType :db.type/string}
|
||||
:aka {:db/cardinality :db.cardinality/many
|
||||
:db/valueType :db.type/string}
|
||||
:age {:db/valueType :db.type/integer}
|
||||
:email {:db/unique :db.unique/identity
|
||||
:db/valueType :db.type/string}
|
||||
:spouse {:db/unique :db.unique/value
|
||||
:db/valueType :db.type/string}
|
||||
})
|
||||
[{:db/id (dm/id-literal :test -1)
|
||||
:db/ident :x
|
||||
:db/unique :db.unique/identity
|
||||
:db/valueType :db.type/integer}
|
||||
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -1)}
|
||||
{:db/id (dm/id-literal :test -2)
|
||||
:db/ident :name
|
||||
:db/unique :db.unique/identity
|
||||
:db/valueType :db.type/string}
|
||||
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -2)}
|
||||
{:db/id (dm/id-literal :test -3)
|
||||
:db/ident :y
|
||||
:db/cardinality :db.cardinality/many
|
||||
:db/valueType :db.type/integer}
|
||||
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -3)}
|
||||
{:db/id (dm/id-literal :test -5)
|
||||
:db/ident :aka
|
||||
:db/cardinality :db.cardinality/many
|
||||
:db/valueType :db.type/string}
|
||||
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -5)}
|
||||
{:db/id (dm/id-literal :test -6)
|
||||
:db/ident :age
|
||||
:db/valueType :db.type/integer}
|
||||
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -6)}
|
||||
{:db/id (dm/id-literal :test -7)
|
||||
:db/ident :email
|
||||
:db/unique :db.unique/identity
|
||||
:db/valueType :db.type/string}
|
||||
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -7)}
|
||||
{:db/id (dm/id-literal :test -8)
|
||||
:db/ident :spouse
|
||||
:db/unique :db.unique/value
|
||||
:db/valueType :db.type/string}
|
||||
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -8)}
|
||||
])
|
||||
|
||||
(deftest-async test-add-one
|
||||
(with-tempfile [t (tempfile)]
|
||||
|
|
@ -88,12 +117,14 @@
|
|||
conn (dm/connection-with-db db)
|
||||
now 0xdeadbeef]
|
||||
(try
|
||||
(is (not (= nil (<? (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)]
|
||||
(is (= (<? (<datoms (dm/db conn)))
|
||||
(is (= (<? (<datoms-after (dm/db conn) tx))
|
||||
#{[0 :name "valuex"]}))
|
||||
(is (= (<? (<transactions (dm/db conn)))
|
||||
(is (= (<? (<transactions-after (dm/db conn) tx))
|
||||
[[0 :name "valuex" tx 1] ;; TODO: true, not 1.
|
||||
[tx :db/txInstant now tx 1]])))
|
||||
(finally
|
||||
|
|
@ -106,16 +137,18 @@
|
|||
conn (dm/connection-with-db db)
|
||||
now 0xdeadbeef]
|
||||
(try
|
||||
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
|
||||
|
||||
(let [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)))]
|
||||
(is (= (<? (<datoms (dm/db conn)))
|
||||
(is (= (<? (<datoms-after (dm/db conn) tx1))
|
||||
#{[1 :name "Petr"]
|
||||
[1 :aka "Tupen"]
|
||||
[1 :aka "Devil"]}))
|
||||
|
||||
(is (= (<? (<transactions (dm/db conn)))
|
||||
(is (= (<? (<transactions-after (dm/db conn) tx1))
|
||||
[[1 :name "Ivan" tx1 1] ;; TODO: true, not 1.
|
||||
[tx1 :db/txInstant now tx1 1]
|
||||
[1 :name "Ivan" tx2 0]
|
||||
|
|
@ -136,11 +169,13 @@
|
|||
conn (dm/connection-with-db db)
|
||||
now 0xdeadbeef]
|
||||
(try
|
||||
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
|
||||
|
||||
(let [txa (tx (<? (dm/<transact! conn [[:db/add 0 :x 123]] now)))
|
||||
txb (tx (<? (dm/<transact! conn [[:db/retract 0 :x 123]] now)))]
|
||||
(is (= (<? (<datoms db))
|
||||
(is (= (<? (<datoms-after (dm/db conn) txa))
|
||||
#{}))
|
||||
(is (= (<? (<transactions db))
|
||||
(is (= (<? (<transactions-after (dm/db conn) txa))
|
||||
[[0 :x 123 txa 1] ;; TODO: true, not 1.
|
||||
[txa :db/txInstant now txa 1]
|
||||
[0 :x 123 txb 0]
|
||||
|
|
@ -155,6 +190,8 @@
|
|||
conn (dm/connection-with-db db)
|
||||
now -1]
|
||||
(try
|
||||
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
|
||||
|
||||
(let [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]
|
||||
|
|
@ -163,9 +200,10 @@
|
|||
[(dm/id-literal :db.part/user -1)
|
||||
(dm/id-literal :db.part/user -2)]))
|
||||
|
||||
(let [eid1 (get-in report [:tempids (dm/id-literal :db.part/user -1)])
|
||||
(let [tx (get-in report [:db-after :current-tx])
|
||||
eid1 (get-in report [:tempids (dm/id-literal :db.part/user -1)])
|
||||
eid2 (get-in report [:tempids (dm/id-literal :db.part/user -2)])]
|
||||
(is (= (<? (<datoms db))
|
||||
(is (= (<? (<datoms-after (dm/db conn) tx))
|
||||
#{[eid1 :x 0]
|
||||
[eid1 :y 1]
|
||||
[eid2 :y 2]
|
||||
|
|
@ -181,6 +219,8 @@
|
|||
conn (dm/connection-with-db db)
|
||||
now -1]
|
||||
(try
|
||||
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
|
||||
|
||||
(testing "Multiple :db/unique values in tx-data violate unique constraint, no tempid"
|
||||
(is (thrown-with-msg?
|
||||
ExceptionInfo #"unique constraint"
|
||||
|
|
@ -199,30 +239,35 @@
|
|||
(deftest-async test-valueType-keyword
|
||||
(with-tempfile [t (tempfile)]
|
||||
(let [c (<? (s/<sqlite-connection t))
|
||||
db (<? (dm/<db-with-sqlite-connection c
|
||||
(merge test-schema {:test/kw {:db/unique :db.unique/identity
|
||||
:db/valueType :db.type/keyword}})))
|
||||
db (<? (dm/<db-with-sqlite-connection c test-schema))
|
||||
conn (dm/connection-with-db db)
|
||||
now -1]
|
||||
(try
|
||||
(<? (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))
|
||||
|
||||
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :test/kw :test/kw1]] now))
|
||||
eid (get-in report [:tempids (dm/id-literal :db.part/user -1)])]
|
||||
(is (= (<? (<datoms db))
|
||||
tx (get-in report [:db-after :current-tx])
|
||||
eid (get-in report [:tempids (dm/id-literal :db.part/user -1)])]
|
||||
(is (= (<? (<datoms-after (dm/db conn) tx))
|
||||
#{[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))
|
||||
(is (= (<? (<datoms db))
|
||||
(is (= (<? (<datoms-after (dm/db conn) tx))
|
||||
#{[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))
|
||||
(is (= (<? (<datoms db))
|
||||
(is (= (<? (<datoms-after (dm/db conn) tx))
|
||||
#{[eid :test/kw ":test/kw2"]}))) ;; Value is raw.
|
||||
|
||||
(testing "Retracting compares values correctly."
|
||||
(<? (dm/<transact! conn [[:db/retract eid :test/kw :test/kw2]] now))
|
||||
(is (= (<? (<datoms db))
|
||||
(is (= (<? (<datoms-after (dm/db conn) tx))
|
||||
#{}))))
|
||||
|
||||
(finally
|
||||
|
|
@ -233,41 +278,39 @@
|
|||
(let [c (<? (s/<sqlite-connection t))
|
||||
db (<? (dm/<db-with-sqlite-connection c test-schema))
|
||||
conn (dm/connection-with-db db)
|
||||
now 0xdeadbeef]
|
||||
now 0xdeadbeef
|
||||
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
|
||||
(try
|
||||
;; Not having DB-as-value really hurts us here.
|
||||
(let [<with-base-and (fn [entities]
|
||||
(go-pair
|
||||
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM datoms"]))
|
||||
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM transactions"]))
|
||||
;; TODO: don't rely on explicit IDs.
|
||||
(<? (dm/<transact! conn [{:db/id 1 :name "Ivan" :email "@1"}
|
||||
{:db/id 2 :name "Petr" :email "@2"}] now))
|
||||
(<? (dm/<transact! conn entities now))))
|
||||
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
|
||||
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
|
||||
|
||||
(testing "upsert with tempid"
|
||||
(let [tx (<? (<with-base-and [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"]
|
||||
[:db/add (dm/id-literal :db.part/user -1) :age 12]]))]
|
||||
(is (= (<? (<shallow-entity (dm/db conn) 1))
|
||||
{:name "Ivan" :age 12 :email "@1"}))
|
||||
(is (= (tempids tx)
|
||||
{-1 1}))))
|
||||
;; 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))
|
||||
(<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
|
||||
{:db/id 102 :name "Petr" :email "@2"}] now))
|
||||
|
||||
(testing "upsert with tempid, order does not matter"
|
||||
(let [tx (<? (<with-base-and [[:db/add (dm/id-literal :db.part/user -1) :age 12]
|
||||
[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"]]))]
|
||||
(is (= (<? (<shallow-entity (dm/db conn) 1))
|
||||
{:name "Ivan" :age 12 :email "@1"}))
|
||||
(is (= (tempids tx)
|
||||
{-1 1}))))
|
||||
(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))]
|
||||
(is (= (<? (<shallow-entity (dm/db conn) 101))
|
||||
{:name "Ivan" :age 12 :email "@1"}))
|
||||
(is (= (tempids report)
|
||||
{-1 101}))))
|
||||
|
||||
(testing "Conflicting upserts fail"
|
||||
(is (thrown-with-msg? Throwable #"Conflicting upsert: #datomish.db.TempId\{:part :db.part/user, :idx -\d+\} resolves both to \d+ and \d+"
|
||||
(<? (dm/<with db [[: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]]))))))
|
||||
(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))]
|
||||
(is (= (<? (<shallow-entity (dm/db conn) 102))
|
||||
{:name "Petr" :age 13 :email "@2"}))
|
||||
(is (= (tempids report)
|
||||
{-1 102}))))
|
||||
|
||||
(testing "Conflicting upserts fail"
|
||||
(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/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)))))
|
||||
(finally
|
||||
(<? (dm/close-db db)))))))
|
||||
|
||||
|
|
@ -276,56 +319,52 @@
|
|||
(let [c (<? (s/<sqlite-connection t))
|
||||
db (<? (dm/<db-with-sqlite-connection c test-schema))
|
||||
conn (dm/connection-with-db db)
|
||||
now 0xdeadbeef]
|
||||
now 0xdeadbeef
|
||||
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
|
||||
(try
|
||||
;; Not having DB-as-value really hurts us here.
|
||||
(let [<with-base-and (fn [entities]
|
||||
(go-pair
|
||||
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM datoms"]))
|
||||
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM transactions"]))
|
||||
;; TODO: don't rely on explicit IDs.
|
||||
(<? (dm/<transact! conn [{:db/id 1 :name "Ivan" :email "@1"}
|
||||
{:db/id 2 :name "Petr" :email "@2"}] now))
|
||||
(<? (dm/<transact! conn entities now))))
|
||||
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
|
||||
;; 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))
|
||||
(<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
|
||||
{:db/id 102 :name "Petr" :email "@2"}] now))
|
||||
|
||||
(testing "upsert with tempid"
|
||||
(let [tx (<? (<with-base-and [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}]))]
|
||||
(is (= (<? (<shallow-entity (dm/db conn) 1))
|
||||
{:name "Ivan" :email "@1" :age 35}))
|
||||
(is (= (tempids tx)
|
||||
{-1 1}))))
|
||||
(testing "upsert with tempid"
|
||||
(let [tx (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}] now))]
|
||||
(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 (<? (<with-base-and [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@1" :age 35}]))]
|
||||
(is (= (<? (<shallow-entity (dm/db conn) 1))
|
||||
{:name "Ivan" :email "@1" :age 35}))
|
||||
(is (= (tempids tx)
|
||||
{-1 1}))))
|
||||
(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))]
|
||||
(is (= (<? (<shallow-entity (dm/db conn) 101))
|
||||
{:name "Ivan" :email "@1" :age 35}))
|
||||
(is (= (tempids tx)
|
||||
{-1 101}))))
|
||||
|
||||
(testing "upsert to two entities, resolve to same tempid, fails due to overlapping writes"
|
||||
(is (thrown-with-msg? Throwable #"cardinality constraint"
|
||||
(<? (<with-base-and [{: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}])))))
|
||||
(testing "upsert with existing id"
|
||||
(let [tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :age 36}] now))]
|
||||
(is (= (<? (<shallow-entity (dm/db conn) 101))
|
||||
{:name "Ivan" :email "@1" :age 36}))
|
||||
(is (= (tempids tx)
|
||||
{}))))
|
||||
|
||||
(testing "upsert to two entities, two tempids, fails due to overlapping writes"
|
||||
(is (thrown-with-msg? Throwable #"cardinality constraint"
|
||||
(<? (<with-base-and [{: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}])))))
|
||||
(testing "upsert by 2 attrs with existing id"
|
||||
(let [tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1" :age 37}] now))]
|
||||
(is (= (<? (<shallow-entity (dm/db conn) 101))
|
||||
{:name "Ivan" :email "@1" :age 37}))
|
||||
(is (= (tempids tx)
|
||||
{}))))
|
||||
|
||||
(testing "upsert with existing id"
|
||||
(let [tx (<? (<with-base-and [{:db/id 1 :name "Ivan" :age 35}]))]
|
||||
(is (= (<? (<shallow-entity (dm/db conn) 1))
|
||||
{:name "Ivan" :email "@1" :age 35}))
|
||||
(is (= (tempids tx)
|
||||
{}))))
|
||||
(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)))))
|
||||
|
||||
(testing "upsert by 2 attrs with existing id"
|
||||
(let [tx (<? (<with-base-and [{:db/id 1 :name "Ivan" :email "@1" :age 35}]))]
|
||||
(is (= (<? (<shallow-entity (dm/db conn) 1))
|
||||
{:name "Ivan" :email "@1" :age 35}))
|
||||
(is (= (tempids tx)
|
||||
{})))))
|
||||
(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)))))
|
||||
|
||||
(finally
|
||||
(<? (dm/close-db db)))))))
|
||||
|
|
@ -335,40 +374,36 @@
|
|||
(let [c (<? (s/<sqlite-connection t))
|
||||
db (<? (dm/<db-with-sqlite-connection c test-schema))
|
||||
conn (dm/connection-with-db db)
|
||||
now 0xdeadbeef]
|
||||
now 0xdeadbeef
|
||||
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
|
||||
(try
|
||||
;; Not having DB-as-value really hurts us here.
|
||||
(let [<with-base-and (fn [entities]
|
||||
(go-pair
|
||||
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM datoms"]))
|
||||
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM transactions"]))
|
||||
;; TODO: don't rely on explicit IDs.
|
||||
(<? (dm/<transact! conn [{:db/id 1 :name "Ivan" :email "@1"}
|
||||
{:db/id 2 :name "Petr" :email "@2"}] now))
|
||||
(<? (dm/<transact! conn entities now))))
|
||||
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
|
||||
;; 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))
|
||||
(<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
|
||||
{:db/id 102 :name "Petr" :email "@2"}] now))
|
||||
|
||||
;; TODO: improve error message to refer to upsert inputs.
|
||||
(testing "upsert conficts with existing id"
|
||||
(is (thrown-with-msg? Throwable #"unique constraint"
|
||||
(<? (<with-base-and [{:db/id 2 :name "Ivan" :age 36}])))))
|
||||
;; 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)))))
|
||||
|
||||
;; TODO: improve error message to refer to upsert inputs.
|
||||
(testing "upsert conficts with non-existing id"
|
||||
(is (thrown-with-msg? Throwable #"unique constraint"
|
||||
(<? (<with-base-and [{:db/id 3 :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)))))
|
||||
|
||||
(testing "upsert by non-existing value resolves as update"
|
||||
(let [tx (<? (<with-base-and [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@3" :age 35}]))]
|
||||
(is (= (<? (<shallow-entity (dm/db conn) 1))
|
||||
{:name "Ivan" :email "@3" :age 35}))
|
||||
(is (= (tempids tx)
|
||||
{-1 1}))))
|
||||
;; 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)))))
|
||||
|
||||
;; 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+"
|
||||
(<? (<with-base-and [{: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))]
|
||||
(is (= (<? (<shallow-entity (dm/db conn) 101))
|
||||
{:name "Ivan" :email "@3" :age 35}))
|
||||
(is (= (tempids report)
|
||||
{-1 101}))))
|
||||
|
||||
(finally
|
||||
(<? (dm/close-db db)))))))
|
||||
|
|
@ -423,14 +458,13 @@
|
|||
|
||||
(testing "Schema is modified"
|
||||
(is (= (get-in db-after [:symbolic-schema :test/attr])
|
||||
{:db/ident :test/attr,
|
||||
:db/valueType :db.type/string,
|
||||
{:db/valueType :db.type/string,
|
||||
:db/cardinality :db.cardinality/one})))
|
||||
|
||||
(testing "Schema is used in subsequent transaction"
|
||||
(<? (dm/<transact! conn [{:db/id 1 :test/attr "value 1"}]))
|
||||
(<? (dm/<transact! conn [{:db/id 1 :test/attr "value 2"}]))
|
||||
(is (= (<? (<shallow-entity (dm/db conn) 1))
|
||||
(<? (dm/<transact! conn [{:db/id 100 :test/attr "value 1"}]))
|
||||
(<? (dm/<transact! conn [{:db/id 100 :test/attr "value 2"}]))
|
||||
(is (= (<? (<shallow-entity (dm/db conn) 100))
|
||||
{:test/attr "value 2"}))))
|
||||
|
||||
(finally
|
||||
|
|
|
|||
|
|
@ -61,13 +61,11 @@
|
|||
[2 :db/valueType :db.value/integer]
|
||||
[2 :db/cardinalty :db.cardinality/many]]
|
||||
{:test/attr1
|
||||
{:db/ident :test/attr1
|
||||
:db/valueType :db.value/string
|
||||
{:db/valueType :db.value/string
|
||||
:db/cardinalty :db.cardinality/one
|
||||
:db/unique :db.unique/identity}
|
||||
:test/attr2
|
||||
{:db/ident :test/attr2
|
||||
:db/valueType :db.value/integer
|
||||
{:db/valueType :db.value/integer
|
||||
:db/cardinalty :db.cardinality/many}})
|
||||
|
||||
;; :db/ident, :db/valueType, and :db/cardinality are required. valueType and cardinality are
|
||||
|
|
|
|||
Loading…
Reference in a new issue