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

Bootstrap DB schema; persist and restore schema from materialized views.

Browse source
This commit is contained in:
Nick Alexander 2016-08-03 08:47:55 -07:00
parent 5d271454ac
commit 296c9cb436
5 changed files with 420 additions and 215 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

285
src/datomish/db.cljc
View file

@ -209,7 +209,15 @@
(defn id-literal? [x] (defn id-literal? [x]
(and (instance? TempId 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] (defn- report? [x]
(and (instance? TxReport x))) (and (instance? TxReport x)))
@ -234,8 +242,10 @@
;; TODO: implement support for DB parts? ;; TODO: implement support for DB parts?
(def tx0 0x2000000) (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.install/partition {:db/valueType :db.type/ref
:db/cardinality :db.cardinality/many} :db/cardinality :db.cardinality/many}
:db.install/valueType {:db/valueType :db.type/ref :db.install/valueType {:db/valueType :db.type/ref
@ -247,10 +257,7 @@
;; :db/cardinality :db.cardinality/many} ;; :db/cardinality :db.cardinality/many}
:db/txInstant {:db/valueType :db.type/integer :db/txInstant {:db/valueType :db.type/integer
:db/cardinality :db.cardinality/one :db/cardinality :db.cardinality/one
:db/index true} } ;; :db/index true} TODO: Handle this using SQLite protocol.
:db/ident {:db/valueType :db.type/keyword
:db/cardinality :db.cardinality/one
:db/unique :db.unique/identity}
:db/valueType {:db/valueType :db.type/ref :db/valueType {:db/valueType :db.type/ref
:db/cardinality :db.cardinality/one} :db/cardinality :db.cardinality/one}
:db/cardinality {:db/valueType :db.type/ref :db/cardinality {:db/valueType :db.type/ref
@ -267,13 +274,90 @@
:db/cardinality :db.cardinality/one} :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] (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 (go-pair
(let [rows (<? (->> (let [rows (<? (s/all-rows sqlite-connection ["SELECT COALESCE(MAX(tx), -1) AS current_tx FROM transactions"]))]
{:select [:e :v] :from [:datoms] :where [:= :a ":db/ident"]} ;; TODO: use raw entid. (:current_tx (first rows)))))
(sql/format)
(s/all-rows sqlite-connection)))] (defn <symbolic-schema [sqlite-connection]
(into {} (map #(-> {(keyword (:v %)) (:e %)})) rows)))) "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 (defn <db-with-sqlite-connection
([sqlite-connection] ([sqlite-connection]
@ -283,16 +367,56 @@
(go-pair (go-pair
(when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection))) (when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
(raise "Could not ensure current SQLite schema version.")) (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)) (let [current-tx (<? (<current-tx sqlite-connection))
idents (into (<? (<idents sqlite-connection)) idents) ;; TODO: pre-populate idents and SQLite tables? bootstrapped (>= current-tx 0)
symbolic-schema (merge schema default-schema)] current-tx (max current-tx tx0)]
(map->DB (when-not bootstrapped
{:sqlite-connection sqlite-connection ;; We need to bootstrap the DB.
:idents idents (let [fail-alter-ident (fn [old new] (if-not (= old new)
:symbolic-schema symbolic-schema (raise "Altering idents is not yet supported, got " new " altering existing ident " old
:schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) symbolic-schema))) {:error :schema/alter-idents :old old :new new})
:current-tx tx0}))))) 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] (defn connection-with-db [db]
(map->Connection {:current-db (atom db)})) (map->Connection {:current-db (atom db)}))
@ -688,22 +812,22 @@
(defn- is-ident? [db [_ a & _]] (defn- is-ident? [db [_ a & _]]
(= a (get-in db [:idents :db/ident]))) (= 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. "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] [db report]
{:pre [(db? db) (report? report)]} {:pre [(db? db) (report? report)]}
;; TODO: use q to filter the report! ;; TODO: use q to filter the report!
(let [original-db db (let [original-report report
tx-data (:tx-data report) tx-data (:tx-data report)
original-ident-assertions (filter (partial is-ident? db) tx-data)] original-ident-assertions (filter (partial is-ident? db) tx-data)]
(loop [db original-db (loop [report original-report
ident-assertions original-ident-assertions] ident-assertions original-ident-assertions]
(let [[ia & ias] ident-assertions] (let [[ia & ias] ident-assertions]
(cond (cond
(nil? ia) (nil? ia)
db report
(not (:added ia)) (not (:added ia))
(raise "Retracting a :db/ident is not yet supported, got " ia (raise "Retracting a :db/ident is not yet supported, got " ia
@ -713,13 +837,8 @@
:else :else
;; Added. ;; Added.
(let [ident (:v ia)] (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) (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 (raise "Cannot assert a :db/ident with a non-keyword value, got " ia
{:error :schema/idents {:error :schema/idents
:op ia })))))))) :op ia }))))))))
@ -735,51 +854,91 @@
(symbolicate tx) (symbolicate tx)
added))) added)))
(defn process-db-install-assertions (defn collect-db-install-assertions
"Transactions may add idents, install new partitions, and install new schema attributes. "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] [db report]
{:pre [(db? db) (report? report)]} {:pre [(db? db) (report? report)]}
;; TODO: be more efficient; symbolicating each datom is expensive! ;; TODO: be more efficient; symbolicating each datom is expensive!
(let [datoms (map (partial symbolicate-datom db) (:tx-data report)) (let [datoms (map (partial symbolicate-datom db) (:tx-data report))
schema-fragment (datomish.schema-changes/datoms->schema-fragment datoms) 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 (assoc-in report [:added-attributes] schema-fragment)))
{:error :schema/alter-schema :old old :new new}))]
(if (empty? schema-fragment) ;; TODO: lift to IDB.
db (defn <apply-db-ident-assertions [db added-idents]
(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]
(go-pair (go-pair
(let [report (<? (<transact-tx-data db 0xdeadbeef ;; TODO (let [->SQLite (get-in ds/value-type-map [:db.type/keyword :->SQLite]) ;; TODO: make this a protocol.
(map->TxReport exec (partial s/execute! (:sqlite-connection db))]
{:db-before db ;; TODO: batch insert.
:db-after db (doseq [[ident entid] added-idents]
;; :current-tx current-tx (<? (exec
:entities tx-data ["INSERT INTO idents VALUES (?, ?)" (->SQLite ident) entid]))))
:tx-data [] db))
:tempids {}})))
db-after (->
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 (-> report
(assoc-in [:db-after] db-after))))) (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] (defn <db-with [db tx-data]
(go-pair (go-pair
(:db-after (<? (<with db tx-data))))) (:db-after (<? (<with db tx-data)))))

5
src/datomish/schema_changes.cljc
View file

@ -21,7 +21,8 @@
Input: a sequence of datoms, like [e :keyword-attr v _ added]. Input: a sequence of datoms, like [e :keyword-attr v _ added].
1. Select [:db.part/db :db.install/attribute ... ]. 1. Select [:db.part/db :db.install/attribute ... ].
2. Fail if any are not (= added true) 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. 4. Map e -> ident; fail if not possible.
5. Return the map, with ident keys. 5. Return the map, with ident keys.
@ -55,6 +56,6 @@
db-avs (into {} (map ->av (filter db-*? datoms)))] db-avs (into {} (map ->av (filter db-*? datoms)))]
;; TODO: get ident from existing datom, to allow [:db.part/db :db.install/attribute existing-id]. ;; TODO: get ident from existing datom, to allow [:db.part/db :db.install/attribute existing-id].
(if-let [ident (:db/ident db-avs)] (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 (raise ":db.install/attribute requires :db/ident, got " db-avs " for " e
{:error :schema/db-install :op db-avs})))))))))) {:error :schema/db-install :op db-avs}))))))))))

19
src/datomish/sqlite_schema.cljc
View file

@ -25,11 +25,24 @@
"CREATE INDEX aevt ON datoms (a, e)" ;; No v -- that's an opt-in index. "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 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 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 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 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 (defn <create-current-version
[db] [db]

320
test/datomish/db_test.cljc
View file

@ -11,6 +11,7 @@
(:require (:require
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]] [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
[datomish.sqlite :as s] [datomish.sqlite :as s]
[datomish.sqlite-schema]
[datomish.datom] [datomish.datom]
[datascript.core :as d] [datascript.core :as d]
@ -35,16 +36,19 @@
#?(:cljs #?(:cljs
(def Throwable js/Error)) (def Throwable js/Error))
(defn- <datoms [db] (defn- <datoms-after [db tx]
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))] (let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))]
(go-pair (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 %)))) (filter #(not (= :db/txInstant (second %))))
(set))))) (set)))))
(defn- <datoms [db]
(<datoms-after db 0))
(defn- <shallow-entity [db eid] (defn- <shallow-entity [db eid]
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))] (let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))]
(go-pair (go-pair
@ -54,32 +58,57 @@
(mapv #(vector (entids (:a %)) (:v %))) (mapv #(vector (entids (:a %)) (:v %)))
(reduce conj {}))))) (reduce conj {})))))
(defn- <transactions [db] (defn- <transactions-after [db tx]
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))] (let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))]
(go-pair (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 %))))))) (mapv #(vector (:e %) (entids (:a %)) (:v %) (:tx %) (:added %)))))))
(defn- <transactions [db]
(<transactions-after db 0))
(defn tx [report] (defn tx [report]
(get-in report [:db-after :current-tx])) (get-in report [:db-after :current-tx]))
;; TODO: use reverse refs!
(def test-schema (def test-schema
{:x {:db/unique :db.unique/identity [{:db/id (dm/id-literal :test -1)
:db/valueType :db.type/integer} :db/ident :x
:y {:db/cardinality :db.cardinality/many :db/unique :db.unique/identity
:db/valueType :db.type/integer} :db/valueType :db.type/integer}
:name {:db/unique :db.unique/identity {:db/id :db.part/db :db.install/attribute (dm/id-literal :test -1)}
:db/valueType :db.type/string} {:db/id (dm/id-literal :test -2)
:aka {:db/cardinality :db.cardinality/many :db/ident :name
:db/valueType :db.type/string} :db/unique :db.unique/identity
:age {:db/valueType :db.type/integer} :db/valueType :db.type/string}
:email {:db/unique :db.unique/identity {:db/id :db.part/db :db.install/attribute (dm/id-literal :test -2)}
:db/valueType :db.type/string} {:db/id (dm/id-literal :test -3)
:spouse {:db/unique :db.unique/value :db/ident :y
:db/valueType :db.type/string} :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 (deftest-async test-add-one
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
@ -88,12 +117,14 @@
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now 0xdeadbeef] now 0xdeadbeef]
(try (try
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
(let [;; TODO: drop now, allow to set :db/txInstant. (let [;; TODO: drop now, allow to set :db/txInstant.
report (<? (dm/<transact! conn [[:db/add 0 :name "valuex"]] now)) report (<? (dm/<transact! conn [[:db/add 0 :name "valuex"]] now))
tx (tx report)] tx (tx report)]
(is (= (<? (<datoms (dm/db conn))) (is (= (<? (<datoms-after (dm/db conn) tx))
#{[0 :name "valuex"]})) #{[0 :name "valuex"]}))
(is (= (<? (<transactions (dm/db conn))) (is (= (<? (<transactions-after (dm/db conn) tx))
[[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 now tx 1]])))
(finally (finally
@ -106,16 +137,18 @@
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now 0xdeadbeef] now 0xdeadbeef]
(try (try
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
(let [tx1 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Ivan"]] now))) (let [tx1 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Ivan"]] now)))
tx2 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Petr"]] now))) tx2 (tx (<? (dm/<transact! conn [[:db/add 1 :name "Petr"]] now)))
tx3 (tx (<? (dm/<transact! conn [[:db/add 1 :aka "Tupen"]] now))) tx3 (tx (<? (dm/<transact! conn [[:db/add 1 :aka "Tupen"]] now)))
tx4 (tx (<? (dm/<transact! conn [[:db/add 1 :aka "Devil"]] 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 :name "Petr"]
[1 :aka "Tupen"] [1 :aka "Tupen"]
[1 :aka "Devil"]})) [1 :aka "Devil"]}))
(is (= (<? (<transactions (dm/db conn))) (is (= (<? (<transactions-after (dm/db conn) tx1))
[[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 now tx1 1]
[1 :name "Ivan" tx2 0] [1 :name "Ivan" tx2 0]
@ -136,11 +169,13 @@
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now 0xdeadbeef] now 0xdeadbeef]
(try (try
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
(let [txa (tx (<? (dm/<transact! conn [[:db/add 0 :x 123]] now))) (let [txa (tx (<? (dm/<transact! conn [[:db/add 0 :x 123]] now)))
txb (tx (<? (dm/<transact! conn [[:db/retract 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. [[0 :x 123 txa 1] ;; TODO: true, not 1.
[txa :db/txInstant now txa 1] [txa :db/txInstant now txa 1]
[0 :x 123 txb 0] [0 :x 123 txb 0]
@ -155,6 +190,8 @@
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now -1] now -1]
(try (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] (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 -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]
@ -163,9 +200,10 @@
[(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)]))
(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)])] 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 :x 0]
[eid1 :y 1] [eid1 :y 1]
[eid2 :y 2] [eid2 :y 2]
@ -181,6 +219,8 @@
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now -1] now -1]
(try (try
(is (not (= nil (<? (dm/<transact! conn test-schema now)))))
(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"
@ -199,30 +239,35 @@
(deftest-async test-valueType-keyword (deftest-async test-valueType-keyword
(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 db (<? (dm/<db-with-sqlite-connection c test-schema))
(merge test-schema {:test/kw {:db/unique :db.unique/identity
:db/valueType :db.type/keyword}})))
conn (dm/connection-with-db db) conn (dm/connection-with-db db)
now -1] now -1]
(try (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)) (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)])] tx (get-in report [:db-after :current-tx])
(is (= (<? (<datoms db)) 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. #{[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]] now))
(is (= (<? (<datoms db)) (is (= (<? (<datoms-after (dm/db conn) tx))
#{[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]] now))
(is (= (<? (<datoms db)) (is (= (<? (<datoms-after (dm/db conn) tx))
#{[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]] now))
(is (= (<? (<datoms db)) (is (= (<? (<datoms-after (dm/db conn) tx))
#{})))) #{}))))
(finally (finally
@ -233,41 +278,39 @@
(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] now 0xdeadbeef
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try (try
;; Not having DB-as-value really hurts us here. (is (not (= nil (<? (dm/<transact! conn test-schema now)))))
(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))))]
(testing "upsert with tempid" ;; Not having DB-as-value really hurts us here. This test only works because all upserts
(let [tx (<? (<with-base-and [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"] ;; succeed on top of each other, so we never need to reset the underlying store.
[:db/add (dm/id-literal :db.part/user -1) :age 12]]))] (<? (dm/<transact! conn test-schema now))
(is (= (<? (<shallow-entity (dm/db conn) 1)) (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:name "Ivan" :age 12 :email "@1"})) {:db/id 102 :name "Petr" :email "@2"}] now))
(is (= (tempids tx)
{-1 1}))))
(testing "upsert with tempid, order does not matter" (testing "upsert with tempid"
(let [tx (<? (<with-base-and [[:db/add (dm/id-literal :db.part/user -1) :age 12] (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) :name "Ivan"]]))] [:db/add (dm/id-literal :db.part/user -1) :age 12]] now))]
(is (= (<? (<shallow-entity (dm/db conn) 1)) (is (= (<? (<shallow-entity (dm/db conn) 101))
{:name "Ivan" :age 12 :email "@1"})) {:name "Ivan" :age 12 :email "@1"}))
(is (= (tempids tx) (is (= (tempids report)
{-1 1})))) {-1 101}))))
(testing "Conflicting upserts fail" (testing "upsert with tempid, order does not matter"
(is (thrown-with-msg? Throwable #"Conflicting upsert: #datomish.db.TempId\{:part :db.part/user, :idx -\d+\} resolves both to \d+ and \d+" (let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :age 13]
(<? (dm/<with db [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"] [:db/add (dm/id-literal :db.part/user -1) :name "Petr"]] now))]
[:db/add (dm/id-literal :db.part/user -1) :age 35] (is (= (<? (<shallow-entity (dm/db conn) 102))
[:db/add (dm/id-literal :db.part/user -1) :name "Petr"] {:name "Petr" :age 13 :email "@2"}))
[:db/add (dm/id-literal :db.part/user -1) :age 36]])))))) (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 (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
@ -276,56 +319,52 @@
(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] now 0xdeadbeef
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try (try
;; Not having DB-as-value really hurts us here. ;; Not having DB-as-value really hurts us here. This test only works because all upserts
(let [<with-base-and (fn [entities] ;; succeed on top of each other, so we never need to reset the underlying store.
(go-pair (<? (dm/<transact! conn test-schema now))
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM datoms"])) (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM transactions"])) {:db/id 102 :name "Petr" :email "@2"}] now))
;; 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))))]
(testing "upsert with tempid" (testing "upsert with tempid"
(let [tx (<? (<with-base-and [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}]))] (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) 1)) (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 1})))) {-1 101}))))
(testing "upsert by 2 attrs with tempid" (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}]))] (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) 1)) (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 1})))) {-1 101}))))
(testing "upsert to two entities, resolve to same tempid, fails due to overlapping writes" (testing "upsert with existing id"
(is (thrown-with-msg? Throwable #"cardinality constraint" (let [tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :age 36}] now))]
(<? (<with-base-and [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35} (is (= (<? (<shallow-entity (dm/db conn) 101))
{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 36}]))))) {:name "Ivan" :email "@1" :age 36}))
(is (= (tempids tx)
{}))))
(testing "upsert to two entities, two tempids, fails due to overlapping writes" (testing "upsert by 2 attrs with existing id"
(is (thrown-with-msg? Throwable #"cardinality constraint" (let [tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1" :age 37}] now))]
(<? (<with-base-and [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35} (is (= (<? (<shallow-entity (dm/db conn) 101))
{:db/id (dm/id-literal :db.part/user -2) :name "Ivan" :age 36}]))))) {:name "Ivan" :email "@1" :age 37}))
(is (= (tempids tx)
{}))))
(testing "upsert with existing id" (testing "upsert to two entities, resolve to same tempid, fails due to overlapping writes"
(let [tx (<? (<with-base-and [{:db/id 1 :name "Ivan" :age 35}]))] (is (thrown-with-msg? Throwable #"cardinality constraint"
(is (= (<? (<shallow-entity (dm/db conn) 1)) (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}
{:name "Ivan" :email "@1" :age 35})) {:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 36}] now)))))
(is (= (tempids tx)
{}))))
(testing "upsert by 2 attrs with existing id" (testing "upsert to two entities, two tempids, fails due to overlapping writes"
(let [tx (<? (<with-base-and [{:db/id 1 :name "Ivan" :email "@1" :age 35}]))] (is (thrown-with-msg? Throwable #"cardinality constraint"
(is (= (<? (<shallow-entity (dm/db conn) 1)) (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}
{:name "Ivan" :email "@1" :age 35})) {:db/id (dm/id-literal :db.part/user -2) :name "Ivan" :age 36}] now)))))
(is (= (tempids tx)
{})))))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
@ -335,40 +374,36 @@
(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] now 0xdeadbeef
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try (try
;; Not having DB-as-value really hurts us here. ;; Not having DB-as-value really hurts us here. This test only works because all upserts
(let [<with-base-and (fn [entities] ;; fail until the final one, so we never need to reset the underlying store.
(go-pair (<? (dm/<transact! conn test-schema now))
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM datoms"])) (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
(<? (s/execute! (:sqlite-connection (dm/db conn)) ["DELETE FROM transactions"])) {:db/id 102 :name "Petr" :email "@2"}] now))
;; 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))))]
;; 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"
(<? (<with-base-and [{:db/id 2 :name "Ivan" :age 36}]))))) (<? (dm/<transact! conn [{:db/id 102 :name "Ivan" :age 36}] now)))))
;; 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"
(<? (<with-base-and [{:db/id 3 :name "Ivan" :age 36}]))))) (<? (dm/<transact! conn [{:db/id 103 :name "Ivan" :age 36}] now)))))
(testing "upsert by non-existing value resolves as update" ;; TODO: improve error message to refer to upsert inputs.
(let [tx (<? (<with-base-and [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@3" :age 35}]))] (testing "upsert by 2 conflicting fields"
(is (= (<? (<shallow-entity (dm/db conn) 1)) (is (thrown-with-msg? Throwable #"Conflicting upsert: #datomish.db.TempId\{:part :db.part/user, :idx -\d+\} resolves both to \d+ and \d+"
{:name "Ivan" :email "@3" :age 35})) (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@2" :age 35}] now)))))
(is (= (tempids tx)
{-1 1}))))
;; TODO: improve error message to refer to upsert inputs. (testing "upsert by non-existing value resolves as update"
(testing "upsert by 2 conflicting fields" (let [report (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@3" :age 35}] now))]
(is (thrown-with-msg? Throwable #"Conflicting upsert: #datomish.db.TempId\{:part :db.part/user, :idx -\d+\} resolves both to \d+ and \d+" (is (= (<? (<shallow-entity (dm/db conn) 101))
(<? (<with-base-and [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@2" :age 35}])))))) {:name "Ivan" :email "@3" :age 35}))
(is (= (tempids report)
{-1 101}))))
(finally (finally
(<? (dm/close-db db))))))) (<? (dm/close-db db)))))))
@ -423,14 +458,13 @@
(testing "Schema is modified" (testing "Schema is modified"
(is (= (get-in db-after [:symbolic-schema :test/attr]) (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}))) :db/cardinality :db.cardinality/one})))
(testing "Schema is used in subsequent transaction" (testing "Schema is used in subsequent transaction"
(<? (dm/<transact! conn [{:db/id 1 :test/attr "value 1"}])) (<? (dm/<transact! conn [{:db/id 100 :test/attr "value 1"}]))
(<? (dm/<transact! conn [{:db/id 1 :test/attr "value 2"}])) (<? (dm/<transact! conn [{:db/id 100 :test/attr "value 2"}]))
(is (= (<? (<shallow-entity (dm/db conn) 1)) (is (= (<? (<shallow-entity (dm/db conn) 100))
{:test/attr "value 2"})))) {:test/attr "value 2"}))))
(finally (finally

6
test/datomish/schema_changes_test.cljc
View file

@ -61,13 +61,11 @@
[2 :db/valueType :db.value/integer] [2 :db/valueType :db.value/integer]
[2 :db/cardinalty :db.cardinality/many]] [2 :db/cardinalty :db.cardinality/many]]
{:test/attr1 {:test/attr1
{:db/ident :test/attr1 {:db/valueType :db.value/string
:db/valueType :db.value/string
:db/cardinalty :db.cardinality/one :db/cardinalty :db.cardinality/one
:db/unique :db.unique/identity} :db/unique :db.unique/identity}
:test/attr2 :test/attr2
{:db/ident :test/attr2 {:db/valueType :db.value/integer
:db/valueType :db.value/integer
:db/cardinalty :db.cardinality/many}}) :db/cardinalty :db.cardinality/many}})
;; :db/ident, :db/valueType, and :db/cardinality are required. valueType and cardinality are ;; :db/ident, :db/valueType, and :db/cardinality are required. valueType and cardinality are