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

Follow-up: split the monolith!

Browse source 
This was a little more tricky than might be expected because the
initialization process uses the transactor to bootstrap the database.
Since Clojure doesn't accept mutually recursive modules, this
necessitated a third module, namely "db-factory", which uses both "db"
and "transact".  While I was here, I started an "api" module, to paper
over the potentially complicated internal module structure for external
consumers.  In time, this "api" module may also grow CLJS-specific JS
transformations.
This commit is contained in:
Nick Alexander 2016-08-04 17:40:38 -07:00
parent 1853d57cba
commit d8c976c3ad
6 changed files with 1052 additions and 993 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

755
src/datomish/db.cljc
View file

@ -12,8 +12,6 @@
[datomish.query.projection :as projection] [datomish.query.projection :as projection]
[datomish.query.source :as source] [datomish.query.source :as source]
[datomish.query :as query] [datomish.query :as query]
[honeysql.core :as sql]
[datomish.transact.bootstrap :as bootstrap]
[datomish.datom :as dd :refer [datom datom? #?@(:cljs [Datom])]] [datomish.datom :as dd :refer [datom datom? #?@(:cljs [Datom])]]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]] [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
[datomish.schema :as ds] [datomish.schema :as ds]
@ -36,13 +34,6 @@
(uncaughtException [_ thread ex] (uncaughtException [_ thread ex]
(println ex "Uncaught exception on" (.getName thread)))))) (println ex "Uncaught exception on" (.getName thread))))))
;; Setting this to something else will make your output more readable,
;; but not automatically safe for use.
(def sql-quoting-style :ansi)
(defn- sql-format [args]
(sql/format args :quoting :ansi))
(defprotocol IClock (defprotocol IClock
(now (now
[clock] [clock]
@ -152,7 +143,7 @@
{:select [:e :a :v :tx [1 :added]] ;; TODO: generalize columns. {:select [:e :a :v :tx [1 :added]] ;; TODO: generalize columns.
:from [:all_datoms] :from [:all_datoms]
:where (cons :and (map #(vector := %1 %2) [:e :a :v] (take-while (comp not nil?) [e a v])))} ;; Must drop nils. :where (cons :and (map #(vector := %1 %2) [:e :a :v] (take-while (comp not nil?) [e a v])))} ;; Must drop nils.
(sql-format) (s/format)
(s/all-rows (:sqlite-connection db)) (s/all-rows (:sqlite-connection db))
(<?) (<?)
@ -167,7 +158,7 @@
{:select [:e :a :v :tx [1 :added]] ;; TODO: generalize columns. {:select [:e :a :v :tx [1 :added]] ;; TODO: generalize columns.
:from [:all_datoms] :from [:all_datoms]
:where [:and [:= :a a] [:= :v v] [:= :index_avet 1]]} :where [:and [:= :a a] [:= :v v] [:= :index_avet 1]]}
(sql-format) (s/format)
(s/all-rows (:sqlite-connection db)) (s/all-rows (:sqlite-connection db))
(<?) (<?)
@ -247,378 +238,7 @@
:cljs :cljs
(.getTime (js/Date.))))) (.getTime (js/Date.)))))
(defprotocol IConnection ;; TODO: factor this into the overall design.
(close
[conn]
"Close this connection. Returns a pair channel of [nil error].")
(db
[conn]
"Get the current DB associated with this connection.")
(history
[conn]
"Get the full transaction history DB associated with this connection."))
(defrecord Connection [current-db]
IConnection
(close [conn] (close-db @(:current-db conn)))
(db [conn] @(:current-db conn))
(history [conn]
(raise "Datomic's history is not yet supported." {})))
(defn conn? [x]
(and (satisfies? IConnection x)))
;; ----------------------------------------------------------------------------
;; define data-readers to be made available to EDN readers. in CLJS
;; they're magically available. in CLJ, data_readers.clj may or may
;; not work, but you can always simply do
;;
;; (clojure.edn/read-string {:readers datomish/data-readers} "...")
;;
(defonce -id-literal-idx (atom -1000000))
(defrecord TempId [part idx])
(defn id-literal
([part]
(if (sequential? part)
(apply id-literal part)
(->TempId part (swap! -id-literal-idx dec))))
([part idx]
(->TempId part idx)))
(defn id-literal? [x]
(and (instance? TempId x)))
(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.
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)))
(defonce -eid (atom (- 0x200 1)))
;; TODO: better here.
(defn- next-eid [db]
(swap! -eid inc))
(defn- allocate-eid
[report id-literal eid]
{:pre [(report? report) (id-literal? id-literal) (and (integer? eid) (not (neg? eid)))]}
(assoc-in report [:tempids id-literal] eid))
;; (def data-readers {'db/id id-literal})
;; #?(:cljs
;; (doseq [[tag cb] data-readers] (cljs.reader/register-tag-parser! tag cb)))
;; TODO: implement support for DB parts?
(def tx0 0x2000000)
(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 (<? (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]
(go-pair
(when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
(raise "Could not ensure current SQLite schema version."))
(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)}))
;; ;; TODO: persist max-tx and max-eid in SQLite.
(defn maybe-datom->entity [entity]
(cond
(datom? entity)
(->
(let [[e a v tx added] entity]
(if added
[:db/add [e a v tx]]
[:db/retract [e a v tx]]))
(with-meta (get (meta entity) :source)))
true
entity))
(defn- #?@(:clj [^Boolean reverse-ref?]
:cljs [^boolean reverse-ref?]) [attr]
(if (keyword? attr)
(= \_ (nth (name attr) 0))
(raise "Bad attribute type: " attr ", expected keyword"
{:error :transact/syntax, :attribute attr})))
(defn- reverse-ref [attr]
(if (keyword? attr)
(if (reverse-ref? attr)
(keyword (namespace attr) (subs (name attr) 1))
(keyword (namespace attr) (str "_" (name attr))))
(raise "Bad attribute type: " attr ", expected keyword"
{:error :transact/syntax, :attribute attr})))
(declare explode-entity)
(defn- explode-entity-a-v [db entity eid a v]
;; a should be symbolic at this point. Map it. TODO: use ident/entid to ensure we have a symbolic attr.
(let [reverse? (reverse-ref? a)
straight-a (if reverse? (reverse-ref a) a)
straight-a* (get-in db [:idents straight-a] straight-a)
_ (when (and reverse? (not (ds/ref? (schema db) straight-a*)))
(raise "Bad attribute " a ": reverse attribute name requires {:db/valueType :db.type/ref} in schema"
{:error :transact/syntax, :attribute a, :op entity}))
a* (get-in db [:idents a] a)]
(cond
reverse?
(explode-entity-a-v db entity v straight-a eid)
(and (map? v)
(not (id-literal? v)))
;; Another entity is given as a nested map.
(if (ds/ref? (schema db) straight-a*)
(let [other (assoc v (reverse-ref a) eid
;; TODO: make the new ID have the same part as the original eid.
;; TODO: make the new ID not show up in the tempids map. (Does Datomic exposed the new ID this way?)
:db/id (id-literal :db.part/user))]
(explode-entity db other))
(raise "Bad attribute " a ": nested map " v " given but attribute name requires {:db/valueType :db.type/ref} in schema"
{:error :transact/entity-map-type-ref
:op entity }))
(sequential? v)
(if (ds/multival? (schema db) a*) ;; dm/schema
(mapcat (partial explode-entity-a-v db entity eid a) v) ;; Allow sequences of nested maps, etc. This does mean [[1]] will work.
(raise "Sequential values " v " but attribute " a " is :db.cardinality/one"
{:error :transact/entity-sequential-cardinality-one
:op entity }))
true
[[:db/add eid a* v]])))
(defn- explode-entity [db entity]
(if (map? entity)
(if-let [eid (:db/id entity)]
(mapcat (partial apply explode-entity-a-v db entity eid) (dissoc entity :db/id))
(raise "Map entity missing :db/id, got " entity
{:error :transact/entity-missing-db-id
:op entity }))
[entity]))
(defn explode-entities [db entities]
"Explode map shorthand, such as {:db/id e :attr value :_reverse ref}, to a list of vectors,
like [[:db/add e :attr value] [:db/add ref :reverse e]]."
(mapcat (partial explode-entity db) entities))
(defn maybe-ident->entid [db [op e a v tx :as orig]]
(let [e (get (idents db) e e) ;; TODO: use ident, entid here.
a (get (idents db) a a)
v (if (ds/kw? (schema db) a) ;; TODO: decide if this is best. We could also check for ref and numeric types.
v
(get (idents db) v v))]
[op e a v tx]))
(defrecord Transaction [db tempids entities])
(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 ensure-entity-form [[op e a v & rest :as entity]]
(cond
(not (sequential? entity))
(raise "Bad entity " entity ", should be sequential at this point"
{:error :transact/bad-entity, :entity entity})
(not (contains? #{:db/add :db/retract} op))
(raise "Unrecognized operation " op " expected one of :db/add :db/retract at this point"
{:error :transact/bad-operation :entity entity })
(nil? e)
(raise "Bad entity: nil e in " entity
{:error :transact/bad-entity :entity entity })
(nil? a)
(raise "Bad entity: nil a in " entity
{:error :transact/bad-entity :entity entity })
(nil? v)
(raise "Bad entity: nil v in " entity
{:error :transact/bad-entity :entity entity })
(some? rest)
(raise "Bad entity: too long " entity
{:error :transact/bad-entity :entity entity })
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) [])
;; :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}))
;; TODO: find an approach that generates less garbage.
(->
report
;; Normalize Datoms into :db/add or :db/retract vectors.
(update :entities (partial map maybe-datom->entity))
(update :entities (partial explode-entities db))
(update :entities (partial map ensure-entity-form))
;; 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*)))))
(defn- lookup-ref? [x]
"Return true if `x` is like [:attr value]."
(and (sequential? x)
(= (count x) 2)
(or (keyword? (first x))
(integer? (first x)))))
(defn <?run (defn <?run
"Execute the provided query on the provided DB. "Execute the provided query on the provided DB.
Returns a transduced channel of [result err] pairs. Returns a transduced channel of [result err] pairs.
@ -648,372 +268,3 @@
[db find args] [db find args]
(a/reduce (partial reduce-error-pair conj) [[] nil] (a/reduce (partial reduce-error-pair conj) [[] nil]
(<?run db find args))) (<?run db find args)))
(defn <resolve-lookup-refs [db report]
{:pre [(db? db) (report? report)]}
(go-pair
(->>
(vec (for [[op & entity] (:entities report)]
(into [op] (for [field entity]
(if (lookup-ref? field)
(first (<? (<eavt db field))) ;; TODO improve this -- this should be avet, shouldn't it?
field)))))
(assoc-in report [:entities])))) ;; TODO: meta.
(declare <resolve-id-literals)
(defn <retry-with-tempid [db report es tempid upserted-eid]
(if (contains? (:tempids report) tempid)
(go-pair
(raise "Conflicting upsert: " tempid " resolves"
" both to " upserted-eid " and " (get (:tempids report) tempid)
{ :error :transact/upsert }))
;; try to re-run from the beginning
;; but remembering that `old-eid` will resolve to `upserted-eid`
(<resolve-id-literals db
(->
report
(assoc-in [:tempids tempid] upserted-eid)
(assoc-in [:entities] es)))))
(defn- transact-entity [report entity]
(update-in report [:entities] conj entity))
(defn <resolve-id-literals
"Upsert uniquely identified literals when possible and allocate new entids for all other id literals.
It's worth noting that some amount of trial and error is probably
necessary here, since [[-1 :ref -2] [-2 :ref -1]] is a valid input.
It's my belief that no graph algorithm can correctly order the
id-literals in quasi-linear time, since that algorithm will need to
accept all permutations of the id-literals. Therefore, we simplify
by accepting that we may process the input multiple times, and we
regain some efficiency by sorting so that upserts happen earlier and
we are most likely to find a successful entid allocation without
multiple trials.
Concretely, we sort [-1 a v] < [-1 a -2] < [e a -1] < [e a v]. This
means simple upserts will be processed early, followed by entities
with multiple id-literals that we hope will reduce to simple upserts
based on the earlier upserts. After that, we handle what should be
simple allocations."
[db report]
{:pre [(db? db) (report? report)]}
(go-pair
(let [keyfn (fn [[op e a v]]
(if (and (id-literal? e)
(not-any? id-literal? [a v]))
(- 5)
(- (count (filter id-literal? [e a v])))))
initial-report (assoc report :entities []) ;; TODO.
initial-entities (sort-by keyfn (:entities report))]
(loop [report initial-report
es initial-entities]
(let [[[op e a v :as entity] & entities] es]
(cond
(nil? entity)
report
(and (not= op :db/add)
(not (empty? (filter id-literal? [e a v]))))
(raise "id-literals are resolved for :db/add only"
{:error :transact/syntax
:op entity })
;; Upsert!
(and (id-literal? e)
(ds/unique-identity? (schema db) a)
(not-any? id-literal? [a v]))
(let [upserted-eid (:e (first (<? (<avet db [a v]))))
allocated-eid (get-in report [:tempids e])]
(if (and upserted-eid allocated-eid (not= upserted-eid allocated-eid))
(<? (<retry-with-tempid db initial-report initial-entities e upserted-eid)) ;; TODO: not initial report, just the sorted entities here.
(let [eid (or upserted-eid allocated-eid (next-eid db))]
(recur (allocate-eid report e eid) (cons [op eid a v] entities)))))
;; Start allocating and retrying. We try with e last, so as to eventually upsert it.
(id-literal? v)
;; We can't fail with unbound literals here, since we could have multiple.
(let [eid (or (get-in report [:tempids v]) (next-eid db))]
(recur (allocate-eid report v eid) (cons [op e a eid] entities)))
(id-literal? a)
;; TODO: should we even allow id-literal attributes? Datomic fails in some cases here.
(let [eid (or (get-in report [:tempids a]) (next-eid db))]
(recur (allocate-eid report a eid) (cons [op e eid v] entities)))
(id-literal? e)
(let [eid (or (get-in report [:tempids e]) (next-eid db))]
(recur (allocate-eid report e eid) (cons [op eid a v] entities)))
true
(recur (transact-entity report entity) entities)
))))))
(defn- transact-report [report datom]
(update-in report [:tx-data] conj datom))
(defn- <ensure-schema-constraints
"Throw unless all entities in :entities obey the schema constraints."
[db report]
{:pre [(db? db) (report? report)]}
;; TODO: consider accumulating errors to show more meaningful error reports.
;; TODO: constrain entities; constrain attributes.
(go-pair
(let [schema (schema db)]
(doseq [[op e a v] (:entities report)]
(ds/ensure-valid-value schema a v)))
report))
(defn- <ensure-unique-constraints
"Throw unless all datoms in :tx-data obey the uniqueness constraints."
[db report]
{:pre [(db? db) (report? report)]}
;; TODO: consider accumulating errors to show more meaningful error reports.
;; TODO: constrain entities; constrain attributes.
(go-pair
;; TODO: comment on applying datoms that violate uniqueness.
(let [schema (schema db)
unique-datoms (transient {})] ;; map (nil, a, v)|(e, a, nil)|(e, a, v) -> datom.
(doseq [[e a v tx added :as datom] (:tx-data report)]
(when added
;; Check for violated :db/unique constraint between datom and existing store.
(when (ds/unique? schema a)
(when-let [found (first (<? (<avet db [a v])))]
(raise "Cannot add " datom " because of unique constraint: " found
{:error :transact/unique
:attribute a ;; TODO: map attribute back to ident.
:entity datom})))
;; Check for violated :db/unique constraint between datoms.
(when (ds/unique? schema a)
(let [key [nil a v]]
(when-let [other (get unique-datoms key)]
(raise "Cannot add " datom " and " other " because together they violate unique constraint"
{:error :transact/unique
:attribute a ;; TODO: map attribute back to ident.
:entity datom}))
(assoc! unique-datoms key datom)))
;; Check for violated :db/cardinality :db.cardinality/one constraint between datoms.
(when-not (ds/multival? schema a)
(let [key [e a nil]]
(when-let [other (get unique-datoms key)]
(raise "Cannot add " datom " and " other " because together they violate cardinality constraint"
{:error :transact/unique
:entity datom}))
(assoc! unique-datoms key datom)))
;; Check for duplicated datoms. Datomic doesn't allow overlapping writes, and we don't
;; want to guarantee order, so we don't either.
(let [key [e a v]]
(when-let [other (get unique-datoms key)]
(raise "Cannot add duplicate " datom
{:error :transact/unique
:entity datom}))
(assoc! unique-datoms key datom)))))
report))
(defn <entities->tx-data [db report]
{:pre [(db? db) (report? report)]}
(go-pair
(let [initial-report report
{tx :tx} report
schema (schema db)]
(loop [report initial-report
es (:entities initial-report)]
(let [[[op e a v :as entity] & entities] es]
(cond
(nil? entity)
report
(= op :db/add)
(if (ds/multival? schema a)
(if (empty? (<? (<eavt db [e a v])))
(recur (transact-report report (datom e a v tx true)) entities)
(recur report entities))
(if-let [^Datom old-datom (first (<? (<eavt db [e a])))]
(if (= (.-v old-datom) v)
(recur report entities)
(recur (-> report
(transact-report (datom e a (.-v old-datom) tx false))
(transact-report (datom e a v tx true)))
entities))
(recur (transact-report report (datom e a v tx true)) entities)))
(= op :db/retract)
(if (first (<? (<eavt db [e a v])))
(recur (transact-report report (datom e a v tx false)) entities)
(recur report entities))
true
(raise "Unknown operation at " entity ", expected :db/add, :db/retract"
{:error :transact/syntax, :operation op, :tx-data entity})))))))
(defn <transact-tx-data
[db report]
{:pre [(db? db) (report? report)]}
(go-pair
(->>
report
(preprocess db)
(<resolve-lookup-refs db)
(<?)
(<resolve-id-literals db)
(<?)
(<ensure-schema-constraints db)
(<?)
(<entities->tx-data db)
(<?)
(<ensure-unique-constraints db)
(<?))))
;; Normalize as [op int|id-literal int|id-literal value|id-literal]. ;; TODO: mention lookup-refs.
;; Replace lookup-refs with entids where possible.
;; Upsert or allocate id-literals.
(defn- is-ident? [db [_ a & _]]
(= a (get-in db [:idents :db/ident])))
(defn collect-db-ident-assertions
"Transactions may add idents, install new partitions, and install new schema attributes.
Collect :db/ident assertions into :added-idents here."
[db report]
{:pre [(db? db) (report? report)]}
;; TODO: use q to filter the report!
(let [original-report report
tx-data (:tx-data report)
original-ident-assertions (filter (partial is-ident? db) tx-data)]
(loop [report original-report
ident-assertions original-ident-assertions]
(let [[ia & ias] ident-assertions]
(cond
(nil? ia)
report
(not (:added ia))
(raise "Retracting a :db/ident is not yet supported, got " ia
{:error :schema/idents
:op ia })
:else
;; Added.
(let [ident (:v ia)]
(if (keyword? ident)
(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 }))))))))
(defn- symbolicate-datom [db [e a v added]]
(let [entids (zipmap (vals (idents db)) (keys (idents db)))
symbolicate (fn [x]
(get entids x x))]
(datom
(symbolicate e)
(symbolicate a)
(symbolicate v)
added)))
(defn collect-db-install-assertions
"Transactions may add idents, install new partitions, and install new schema attributes.
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)]
(assoc-in report [:added-attributes] schema-fragment)))
(defn- <with-internal [db tx-data merge-ident merge-attr]
(go-pair
(let [report (->>
(map->TxReport
{:db-before db
:db-after db
;; 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 {}
:added-parts {}
:added-idents {}
:added-attributes {}
})
(<transact-tx-data db)
(<?)
(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)))))
(defn <transact!
[conn tx-data]
{:pre [(conn? conn)]}
(let [db (db conn)] ;; TODO: be careful with swapping atoms.
(in-transaction!
db
#(go-pair
(let [report (<? (<with db tx-data))]
(reset! (:current-db conn) (:db-after report))
report)))))

124
src/datomish/db_factory.cljc Normal file
View file

@ -0,0 +1,124 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
(ns datomish.db-factory
#?(:cljs
(:require-macros
[datomish.pair-chan :refer [go-pair <?]]
[cljs.core.async.macros :refer [go]]))
(:require
[datomish.db :as db]
[datomish.transact :as transact]
[datomish.transact.bootstrap :as bootstrap]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
[datomish.schema :as ds]
[datomish.sqlite :as s]
[datomish.sqlite-schema :as sqlite-schema]
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
[clojure.core.async :as a :refer [chan go <! >!]]])
#?@(:cljs [[datomish.pair-chan]
[cljs.core.async :as a :refer [chan <! >!]]]))
#?(:clj
(:import
[datomish.datom Datom])))
;; TODO: implement support for DB parts?
(def tx0 0x2000000)
(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]}
(s/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 (<? (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]}
(s/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 {})))))
(defn <db-with-sqlite-connection
[sqlite-connection]
(go-pair
(when-not (= sqlite-schema/current-version (<? (sqlite-schema/<ensure-current-version sqlite-connection)))
(raise "Could not ensure current SQLite schema version."))
(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))]
(-> (db/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-internal 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.
(transact/<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
})))
(db/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)})))))

10
src/datomish/sqlite.cljc
View file

@ -3,19 +3,29 @@
;; file, You can obtain one at http://mozilla.org/MPL/2.0/. ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
(ns datomish.sqlite (ns datomish.sqlite
(:refer-clojure :exclude [format])
#?(:cljs #?(:cljs
(:require-macros (:require-macros
[datomish.pair-chan :refer [go-pair go-safely <?]] [datomish.pair-chan :refer [go-pair go-safely <?]]
[cljs.core.async.macros :refer [go]])) [cljs.core.async.macros :refer [go]]))
#?(:clj #?(:clj
(:require (:require
[honeysql.core]
[datomish.pair-chan :refer [go-pair go-safely <?]] [datomish.pair-chan :refer [go-pair go-safely <?]]
[clojure.core.async :refer [go <! >! chan put! take! close!]]) [clojure.core.async :refer [go <! >! chan put! take! close!]])
:cljs :cljs
(:require (:require
[honeysql.core]
[datomish.pair-chan] [datomish.pair-chan]
[cljs.core.async :as a :refer [<! >! chan put! take! close!]]))) [cljs.core.async :as a :refer [<! >! chan put! take! close!]])))
;; Setting this to something else will make your output more readable,
;; but not automatically safe for use.
(def sql-quoting-style :ansi)
(defn format [args]
(honeysql.core/format args :quoting :ansi))
(defprotocol ISQLiteConnection (defprotocol ISQLiteConnection
(-execute! (-execute!
[db sql bindings] [db sql bindings]

671
src/datomish/transact.cljc Normal file
View file

@ -0,0 +1,671 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
(ns datomish.transact
#?(:cljs
(:require-macros
[datomish.pair-chan :refer [go-pair <?]]
[cljs.core.async.macros :refer [go]]))
(:require
[datomish.query.context :as context]
[datomish.query.projection :as projection]
[datomish.query.source :as source]
[datomish.query :as query]
[datomish.db :as db]
[datomish.datom :as dd :refer [datom datom? #?@(:cljs [Datom])]]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]]
[datomish.schema :as ds]
[datomish.schema-changes]
[datomish.sqlite :as s]
[datomish.sqlite-schema :as sqlite-schema]
[datomish.transact.bootstrap :as bootstrap]
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
[clojure.core.async :as a :refer [chan go <! >!]]])
#?@(:cljs [[datomish.pair-chan]
[cljs.core.async :as a :refer [chan <! >!]]]))
#?(:clj
(:import
[datomish.datom Datom])))
(defprotocol IConnection
(close
[conn]
"Close this connection. Returns a pair channel of [nil error].")
(db
[conn]
"Get the current DB associated with this connection.")
(history
[conn]
"Get the full transaction history DB associated with this connection."))
(defrecord Connection [current-db]
IConnection
(close [conn] (db/close-db @(:current-db conn)))
(db [conn] @(:current-db conn))
(history [conn]
(raise "Datomic's history is not yet supported." {})))
(defn conn? [x]
(and (satisfies? IConnection x)))
;; ----------------------------------------------------------------------------
;; define data-readers to be made available to EDN readers. in CLJS
;; they're magically available. in CLJ, data_readers.clj may or may
;; not work, but you can always simply do
;;
;; (clojure.edn/read-string {:readers datomish/data-readers} "...")
;;
(defonce -id-literal-idx (atom -1000000))
(defrecord TempId [part idx])
(defn id-literal
([part]
(if (sequential? part)
(apply id-literal part)
(->TempId part (swap! -id-literal-idx dec))))
([part idx]
(->TempId part idx)))
(defn id-literal? [x]
(and (instance? TempId x)))
(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.
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)))
(defonce -eid (atom (- 0x200 1)))
;; TODO: better here.
(defn- next-eid [db]
(swap! -eid inc))
(defn- allocate-eid
[report id-literal eid]
{:pre [(report? report) (id-literal? id-literal) (and (integer? eid) (not (neg? eid)))]}
(assoc-in report [:tempids id-literal] eid))
;; (def data-readers {'db/id id-literal})
;; #?(:cljs
;; (doseq [[tag cb] data-readers] (cljs.reader/register-tag-parser! tag cb)))
;; TODO: implement support for DB parts?
(defn connection-with-db [db]
(map->Connection {:current-db (atom db)}))
;; ;; TODO: persist max-tx and max-eid in SQLite.
(defn maybe-datom->entity [entity]
(cond
(datom? entity)
(->
(let [[e a v tx added] entity]
(if added
[:db/add [e a v tx]]
[:db/retract [e a v tx]]))
(with-meta (get (meta entity) :source)))
true
entity))
(defn- #?@(:clj [^Boolean reverse-ref?]
:cljs [^boolean reverse-ref?]) [attr]
(if (keyword? attr)
(= \_ (nth (name attr) 0))
(raise "Bad attribute type: " attr ", expected keyword"
{:error :transact/syntax, :attribute attr})))
(defn- reverse-ref [attr]
(if (keyword? attr)
(if (reverse-ref? attr)
(keyword (namespace attr) (subs (name attr) 1))
(keyword (namespace attr) (str "_" (name attr))))
(raise "Bad attribute type: " attr ", expected keyword"
{:error :transact/syntax, :attribute attr})))
(declare explode-entity)
(defn- explode-entity-a-v [db entity eid a v]
;; a should be symbolic at this point. Map it. TODO: use ident/entid to ensure we have a symbolic attr.
(let [reverse? (reverse-ref? a)
straight-a (if reverse? (reverse-ref a) a)
straight-a* (get-in db [:idents straight-a] straight-a)
_ (when (and reverse? (not (ds/ref? (db/schema db) straight-a*)))
(raise "Bad attribute " a ": reverse attribute name requires {:db/valueType :db.type/ref} in schema"
{:error :transact/syntax, :attribute a, :op entity}))
a* (get-in db [:idents a] a)]
(cond
reverse?
(explode-entity-a-v db entity v straight-a eid)
(and (map? v)
(not (id-literal? v)))
;; Another entity is given as a nested map.
(if (ds/ref? (db/schema db) straight-a*)
(let [other (assoc v (reverse-ref a) eid
;; TODO: make the new ID have the same part as the original eid.
;; TODO: make the new ID not show up in the tempids map. (Does Datomic exposed the new ID this way?)
:db/id (id-literal :db.part/user))]
(explode-entity db other))
(raise "Bad attribute " a ": nested map " v " given but attribute name requires {:db/valueType :db.type/ref} in schema"
{:error :transact/entity-map-type-ref
:op entity }))
(sequential? v)
(if (ds/multival? (db/schema db) a*) ;; dm/schema
(mapcat (partial explode-entity-a-v db entity eid a) v) ;; Allow sequences of nested maps, etc. This does mean [[1]] will work.
(raise "Sequential values " v " but attribute " a " is :db.cardinality/one"
{:error :transact/entity-sequential-cardinality-one
:op entity }))
true
[[:db/add eid a* v]])))
(defn- explode-entity [db entity]
(if (map? entity)
(if-let [eid (:db/id entity)]
(mapcat (partial apply explode-entity-a-v db entity eid) (dissoc entity :db/id))
(raise "Map entity missing :db/id, got " entity
{:error :transact/entity-missing-db-id
:op entity }))
[entity]))
(defn explode-entities [db entities]
"Explode map shorthand, such as {:db/id e :attr value :_reverse ref}, to a list of vectors,
like [[:db/add e :attr value] [:db/add ref :reverse e]]."
(mapcat (partial explode-entity db) entities))
(defn maybe-ident->entid [db [op e a v tx :as orig]]
(let [e (get (db/idents db) e e) ;; TODO: use ident, entid here.
a (get (db/idents db) a a)
v (if (ds/kw? (db/schema db) a) ;; TODO: decide if this is best. We could also check for ref and numeric types.
v
(get (db/idents db) v v))]
[op e a v tx]))
(defrecord Transaction [db tempids entities])
(defn- tx-entity [db report]
{:pre [(db/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 ensure-entity-form [[op e a v & rest :as entity]]
(cond
(not (sequential? entity))
(raise "Bad entity " entity ", should be sequential at this point"
{:error :transact/bad-entity, :entity entity})
(not (contains? #{:db/add :db/retract} op))
(raise "Unrecognized operation " op " expected one of :db/add :db/retract at this point"
{:error :transact/bad-operation :entity entity })
(nil? e)
(raise "Bad entity: nil e in " entity
{:error :transact/bad-entity :entity entity })
(nil? a)
(raise "Bad entity: nil a in " entity
{:error :transact/bad-entity :entity entity })
(nil? v)
(raise "Bad entity: nil v in " entity
{:error :transact/bad-entity :entity entity })
(some? rest)
(raise "Bad entity: too long " entity
{:error :transact/bad-entity :entity entity })
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? 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? db) (report? 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}))
;; TODO: find an approach that generates less garbage.
(->
report
;; Normalize Datoms into :db/add or :db/retract vectors.
(update :entities (partial map maybe-datom->entity))
(update :entities (partial explode-entities db))
(update :entities (partial map ensure-entity-form))
;; 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*)))))
(defn- lookup-ref? [x]
"Return true if `x` is like [:attr value]."
(and (sequential? x)
(= (count x) 2)
(or (keyword? (first x))
(integer? (first x)))))
(defn <resolve-lookup-refs [db report]
{:pre [(db/db? db) (report? report)]}
(go-pair
(->>
(vec (for [[op & entity] (:entities report)]
(into [op] (for [field entity]
(if (lookup-ref? field)
(first (<? (db/<eavt db field))) ;; TODO improve this -- this should be avet, shouldn't it?
field)))))
(assoc-in report [:entities])))) ;; TODO: meta.
(declare <resolve-id-literals)
(defn <retry-with-tempid [db report es tempid upserted-eid]
(if (contains? (:tempids report) tempid)
(go-pair
(raise "Conflicting upsert: " tempid " resolves"
" both to " upserted-eid " and " (get (:tempids report) tempid)
{ :error :transact/upsert }))
;; try to re-run from the beginning
;; but remembering that `old-eid` will resolve to `upserted-eid`
(<resolve-id-literals db
(->
report
(assoc-in [:tempids tempid] upserted-eid)
(assoc-in [:entities] es)))))
(defn- transact-entity [report entity]
(update-in report [:entities] conj entity))
(defn <resolve-id-literals
"Upsert uniquely identified literals when possible and allocate new entids for all other id literals.
It's worth noting that some amount of trial and error is probably
necessary here, since [[-1 :ref -2] [-2 :ref -1]] is a valid input.
It's my belief that no graph algorithm can correctly order the
id-literals in quasi-linear time, since that algorithm will need to
accept all permutations of the id-literals. Therefore, we simplify
by accepting that we may process the input multiple times, and we
regain some efficiency by sorting so that upserts happen earlier and
we are most likely to find a successful entid allocation without
multiple trials.
Concretely, we sort [-1 a v] < [-1 a -2] < [e a -1] < [e a v]. This
means simple upserts will be processed early, followed by entities
with multiple id-literals that we hope will reduce to simple upserts
based on the earlier upserts. After that, we handle what should be
simple allocations."
[db report]
{:pre [(db/db? db) (report? report)]}
(go-pair
(let [keyfn (fn [[op e a v]]
(if (and (id-literal? e)
(not-any? id-literal? [a v]))
(- 5)
(- (count (filter id-literal? [e a v])))))
initial-report (assoc report :entities []) ;; TODO.
initial-entities (sort-by keyfn (:entities report))]
(loop [report initial-report
es initial-entities]
(let [[[op e a v :as entity] & entities] es]
(cond
(nil? entity)
report
(and (not= op :db/add)
(not (empty? (filter id-literal? [e a v]))))
(raise "id-literals are resolved for :db/add only"
{:error :transact/syntax
:op entity })
;; Upsert!
(and (id-literal? e)
(ds/unique-identity? (db/schema db) a)
(not-any? id-literal? [a v]))
(let [upserted-eid (:e (first (<? (db/<avet db [a v]))))
allocated-eid (get-in report [:tempids e])]
(if (and upserted-eid allocated-eid (not= upserted-eid allocated-eid))
(<? (<retry-with-tempid db initial-report initial-entities e upserted-eid)) ;; TODO: not initial report, just the sorted entities here.
(let [eid (or upserted-eid allocated-eid (next-eid db))]
(recur (allocate-eid report e eid) (cons [op eid a v] entities)))))
;; Start allocating and retrying. We try with e last, so as to eventually upsert it.
(id-literal? v)
;; We can't fail with unbound literals here, since we could have multiple.
(let [eid (or (get-in report [:tempids v]) (next-eid db))]
(recur (allocate-eid report v eid) (cons [op e a eid] entities)))
(id-literal? a)
;; TODO: should we even allow id-literal attributes? Datomic fails in some cases here.
(let [eid (or (get-in report [:tempids a]) (next-eid db))]
(recur (allocate-eid report a eid) (cons [op e eid v] entities)))
(id-literal? e)
(let [eid (or (get-in report [:tempids e]) (next-eid db))]
(recur (allocate-eid report e eid) (cons [op eid a v] entities)))
true
(recur (transact-entity report entity) entities)
))))))
(defn- transact-report [report datom]
(update-in report [:tx-data] conj datom))
(defn- <ensure-schema-constraints
"Throw unless all entities in :entities obey the schema constraints."
[db report]
{:pre [(db/db? db) (report? report)]}
;; TODO: consider accumulating errors to show more meaningful error reports.
;; TODO: constrain entities; constrain attributes.
(go-pair
(let [schema (db/schema db)]
(doseq [[op e a v] (:entities report)]
(ds/ensure-valid-value schema a v)))
report))
(defn- <ensure-unique-constraints
"Throw unless all datoms in :tx-data obey the uniqueness constraints."
[db report]
{:pre [(db/db? db) (report? report)]}
;; TODO: consider accumulating errors to show more meaningful error reports.
;; TODO: constrain entities; constrain attributes.
(go-pair
;; TODO: comment on applying datoms that violate uniqueness.
(let [schema (db/schema db)
unique-datoms (transient {})] ;; map (nil, a, v)|(e, a, nil)|(e, a, v) -> datom.
(doseq [[e a v tx added :as datom] (:tx-data report)]
(when added
;; Check for violated :db/unique constraint between datom and existing store.
(when (ds/unique? schema a)
(when-let [found (first (<? (db/<avet db [a v])))]
(raise "Cannot add " datom " because of unique constraint: " found
{:error :transact/unique
:attribute a ;; TODO: map attribute back to ident.
:entity datom})))
;; Check for violated :db/unique constraint between datoms.
(when (ds/unique? schema a)
(let [key [nil a v]]
(when-let [other (get unique-datoms key)]
(raise "Cannot add " datom " and " other " because together they violate unique constraint"
{:error :transact/unique
:attribute a ;; TODO: map attribute back to ident.
:entity datom}))
(assoc! unique-datoms key datom)))
;; Check for violated :db/cardinality :db.cardinality/one constraint between datoms.
(when-not (ds/multival? schema a)
(let [key [e a nil]]
(when-let [other (get unique-datoms key)]
(raise "Cannot add " datom " and " other " because together they violate cardinality constraint"
{:error :transact/unique
:entity datom}))
(assoc! unique-datoms key datom)))
;; Check for duplicated datoms. Datomic doesn't allow overlapping writes, and we don't
;; want to guarantee order, so we don't either.
(let [key [e a v]]
(when-let [other (get unique-datoms key)]
(raise "Cannot add duplicate " datom
{:error :transact/unique
:entity datom}))
(assoc! unique-datoms key datom)))))
report))
(defn <entities->tx-data [db report]
{:pre [(db/db? db) (report? report)]}
(go-pair
(let [initial-report report
{tx :tx} report
schema (db/schema db)]
(loop [report initial-report
es (:entities initial-report)]
(let [[[op e a v :as entity] & entities] es]
(cond
(nil? entity)
report
(= op :db/add)
(if (ds/multival? schema a)
(if (empty? (<? (db/<eavt db [e a v])))
(recur (transact-report report (datom e a v tx true)) entities)
(recur report entities))
(if-let [^Datom old-datom (first (<? (db/<eavt db [e a])))]
(if (= (.-v old-datom) v)
(recur report entities)
(recur (-> report
(transact-report (datom e a (.-v old-datom) tx false))
(transact-report (datom e a v tx true)))
entities))
(recur (transact-report report (datom e a v tx true)) entities)))
(= op :db/retract)
(if (first (<? (db/<eavt db [e a v])))
(recur (transact-report report (datom e a v tx false)) entities)
(recur report entities))
true
(raise "Unknown operation at " entity ", expected :db/add, :db/retract"
{:error :transact/syntax, :operation op, :tx-data entity})))))))
(defn <transact-tx-data
[db report]
{:pre [(db/db? db) (report? report)]}
(go-pair
(->>
report
(preprocess db)
(<resolve-lookup-refs db)
(<?)
(<resolve-id-literals db)
(<?)
(<ensure-schema-constraints db)
(<?)
(<entities->tx-data db)
(<?)
(<ensure-unique-constraints db)
(<?))))
;; Normalize as [op int|id-literal int|id-literal value|id-literal]. ;; TODO: mention lookup-refs.
;; Replace lookup-refs with entids where possible.
;; Upsert or allocate id-literals.
(defn- is-ident? [db [_ a & _]]
(= a (get-in db [:idents :db/ident])))
(defn collect-db-ident-assertions
"Transactions may add idents, install new partitions, and install new schema attributes.
Collect :db/ident assertions into :added-idents here."
[db report]
{:pre [(db/db? db) (report? report)]}
;; TODO: use q to filter the report!
(let [original-report report
tx-data (:tx-data report)
original-ident-assertions (filter (partial is-ident? db) tx-data)]
(loop [report original-report
ident-assertions original-ident-assertions]
(let [[ia & ias] ident-assertions]
(cond
(nil? ia)
report
(not (:added ia))
(raise "Retracting a :db/ident is not yet supported, got " ia
{:error :schema/idents
:op ia })
:else
;; Added.
(let [ident (:v ia)]
(if (keyword? ident)
(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 }))))))))
(defn- symbolicate-datom [db [e a v added]]
(let [entids (zipmap (vals (db/idents db)) (keys (db/idents db)))
symbolicate (fn [x]
(get entids x x))]
(datom
(symbolicate e)
(symbolicate a)
(symbolicate v)
added)))
(defn collect-db-install-assertions
"Transactions may add idents, install new partitions, and install new schema attributes.
Collect [:db.part/db :db.install/attribute] assertions here."
[db report]
{:pre [(db/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)]
(assoc-in report [:added-attributes] schema-fragment)))
;; TODO: expose this in a more appropriate way.
(defn <with-internal [db tx-data merge-ident merge-attr]
(go-pair
(let [report (->>
(map->TxReport
{:db-before db
:db-after db
;; 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 (db/current-tx db)
:txInstant (db/now db)
:entities tx-data
:tx-data []
:tempids {}
:added-parts {}
:added-idents {}
:added-attributes {}
})
(<transact-tx-data db)
(<?)
(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
(db/<apply-datoms (:tx-data report))
(<?)
(db/<apply-db-ident-assertions (:added-idents report))
(<?)
(db/<apply-db-install-assertions (:added-attributes report))
(<?)
;; TODO: abstract this.
(assoc :idents idents
:symbolic-schema symbolic-schema
:schema schema)
(db/<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)))))
(defn <transact!
[conn tx-data]
{:pre [(conn? conn)]}
(let [db (db conn)] ;; TODO: be careful with swapping atoms.
(db/in-transaction!
db
#(go-pair
(let [report (<? (<with db tx-data))]
(reset! (:current-db conn) (:db-after report))
report)))))

40
test/datomish/api.cljc Normal file
View file

@ -0,0 +1,40 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
(ns datomish.api
#?(:cljs
(:require-macros
[datomish.pair-chan :refer [go-pair <?]]
[cljs.core.async.macros :as a :refer [go]]))
(:require
[datomish.db :as db]
[datomish.db-factory :as db-factory]
[datomish.sqlite :as sqlite]
[datomish.transact :as transact]
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
[clojure.core.async :refer [go <! >!]]])
#?@(:cljs [[datomish.pair-chan]
[cljs.core.async :as a :refer [<! >!]]])))
(defn <connect [uri]
;; Eventually, URI. For now, just a plain path (no file://).
(go-pair
(->
(sqlite/<sqlite-connection uri)
(<?)
(db-factory/<db-with-sqlite-connection)
(<?)
(transact/connection-with-db))))
(def <transact! transact/<transact!)
;; TODO: use Potemkin, or a subset of Potemkin that is CLJS friendly (like
;; https://github.com/ztellman/potemkin/issues/31) to improve this re-exporting process.
(def <close transact/close)
(def id-literal transact/id-literal)
(def db transact/db)

429
test/datomish/db_test.cljc
View file

@ -9,15 +9,12 @@
[datomish.node-tempfile-macros :refer [with-tempfile]] [datomish.node-tempfile-macros :refer [with-tempfile]]
[cljs.core.async.macros :as a :refer [go]])) [cljs.core.async.macros :as a :refer [go]]))
(:require (:require
[datomish.api :as d]
[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.sqlite-schema]
[datomish.datom] [datomish.datom]
[datomish.db :as db]
[datascript.core :as d]
[datascript.db :as db]
[datomish.db :as dm]
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]] #?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
[tempfile.core :refer [tempfile with-tempfile]] [tempfile.core :refer [tempfile with-tempfile]]
[datomish.test-macros :refer [deftest-async]] [datomish.test-macros :refer [deftest-async]]
@ -36,8 +33,11 @@
#?(:cljs #?(:cljs
(def Throwable js/Error)) (def Throwable js/Error))
(defn- tempids [tx]
(into {} (map (juxt (comp :idx first) second) (:tempids tx))))
(defn- <datoms-after [db tx] (defn- <datoms-after [db tx]
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))] (let [entids (zipmap (vals (db/idents db)) (keys (db/idents db)))]
(go-pair (go-pair
(->> (->>
(s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms WHERE tx > ?" tx]) (s/all-rows (:sqlite-connection db) ["SELECT e, a, v, tx FROM datoms WHERE tx > ?" tx])
@ -51,7 +51,7 @@
(defn- <shallow-entity [db eid] (defn- <shallow-entity [db eid]
;; TODO: make this actually be <entity. Handle :db.cardinality/many and :db/isComponent. ;; TODO: make this actually be <entity. Handle :db.cardinality/many and :db/isComponent.
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))] (let [entids (zipmap (vals (db/idents db)) (keys (db/idents db)))]
(go-pair (go-pair
(->> (->>
(s/all-rows (:sqlite-connection db) ["SELECT a, v FROM datoms WHERE e = ?" eid]) (s/all-rows (:sqlite-connection db) ["SELECT a, v FROM datoms WHERE e = ?" eid])
@ -60,7 +60,7 @@
(reduce conj {}))))) (reduce conj {})))))
(defn- <transactions-after [db tx] (defn- <transactions-after [db tx]
(let [entids (zipmap (vals (dm/idents db)) (keys (dm/idents db)))] (let [entids (zipmap (vals (db/idents db)) (keys (db/idents db)))]
(go-pair (go-pair
(->> (->>
(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]) (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])
@ -79,80 +79,76 @@
;; TODO: use reverse refs! ;; TODO: use reverse refs!
(def test-schema (def test-schema
[{:db/id (dm/id-literal :test -1) [{:db/id (d/id-literal :test -1)
:db/ident :x :db/ident :x
:db/unique :db.unique/identity :db/unique :db.unique/identity
:db/valueType :db.type/integer} :db/valueType :db.type/integer}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -1)} {:db/id :db.part/db :db.install/attribute (d/id-literal :test -1)}
{:db/id (dm/id-literal :test -2) {:db/id (d/id-literal :test -2)
:db/ident :name :db/ident :name
:db/unique :db.unique/identity :db/unique :db.unique/identity
:db/valueType :db.type/string} :db/valueType :db.type/string}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -2)} {:db/id :db.part/db :db.install/attribute (d/id-literal :test -2)}
{:db/id (dm/id-literal :test -3) {:db/id (d/id-literal :test -3)
:db/ident :y :db/ident :y
:db/cardinality :db.cardinality/many :db/cardinality :db.cardinality/many
:db/valueType :db.type/integer} :db/valueType :db.type/integer}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -3)} {:db/id :db.part/db :db.install/attribute (d/id-literal :test -3)}
{:db/id (dm/id-literal :test -5) {:db/id (d/id-literal :test -5)
:db/ident :aka :db/ident :aka
:db/cardinality :db.cardinality/many :db/cardinality :db.cardinality/many
:db/valueType :db.type/string} :db/valueType :db.type/string}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -5)} {:db/id :db.part/db :db.install/attribute (d/id-literal :test -5)}
{:db/id (dm/id-literal :test -6) {:db/id (d/id-literal :test -6)
:db/ident :age :db/ident :age
:db/valueType :db.type/integer} :db/valueType :db.type/integer}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -6)} {:db/id :db.part/db :db.install/attribute (d/id-literal :test -6)}
{:db/id (dm/id-literal :test -7) {:db/id (d/id-literal :test -7)
:db/ident :email :db/ident :email
:db/unique :db.unique/identity :db/unique :db.unique/identity
:db/valueType :db.type/string} :db/valueType :db.type/string}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -7)} {:db/id :db.part/db :db.install/attribute (d/id-literal :test -7)}
{:db/id (dm/id-literal :test -8) {:db/id (d/id-literal :test -8)
:db/ident :spouse :db/ident :spouse
:db/unique :db.unique/value :db/unique :db.unique/value
:db/valueType :db.type/string} :db/valueType :db.type/string}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -8)} {:db/id :db.part/db :db.install/attribute (d/id-literal :test -8)}
{:db/id (dm/id-literal :test -9) {:db/id (d/id-literal :test -9)
:db/ident :friends :db/ident :friends
:db/cardinality :db.cardinality/many :db/cardinality :db.cardinality/many
:db/valueType :db.type/ref} :db/valueType :db.type/ref}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :test -9)} {:db/id :db.part/db :db.install/attribute (d/id-literal :test -9)}
]) ])
(deftest-async test-add-one (deftest-async test-add-one
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))]
db (<? (dm/<db-with-sqlite-connection c))
conn (dm/connection-with-db db)]
(try (try
(let [{tx0 :tx} (<? (dm/<transact! conn test-schema))] (let [{tx0 :tx} (<? (d/<transact! conn test-schema))]
(let [{:keys [tx txInstant]} (<? (dm/<transact! conn [[:db/add 0 :name "valuex"]]))] (let [{:keys [tx txInstant]} (<? (d/<transact! conn [[:db/add 0 :name "valuex"]]))]
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[0 :name "valuex"]})) #{[0 :name "valuex"]}))
(is (= (<? (<transactions-after (dm/db conn) tx0)) (is (= (<? (<transactions-after (d/db conn) tx0))
[[0 :name "valuex" tx 1] ;; TODO: true, not 1. [[0 :name "valuex" tx 1] ;; TODO: true, not 1.
[tx :db/txInstant txInstant tx 1]])))) [tx :db/txInstant txInstant tx 1]]))))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(deftest-async test-add-two (deftest-async test-add-two
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))]
db (<? (dm/<db-with-sqlite-connection c))
conn (dm/connection-with-db db)]
(try (try
(let [{tx0 :tx} (<? (dm/<transact! conn test-schema)) (let [{tx0 :tx} (<? (d/<transact! conn test-schema))
{tx1 :tx txInstant1 :txInstant} (<? (dm/<transact! conn [[:db/add 1 :name "Ivan"]])) {tx1 :tx txInstant1 :txInstant} (<? (d/<transact! conn [[:db/add 1 :name "Ivan"]]))
{tx2 :tx txInstant2 :txInstant} (<? (dm/<transact! conn [[:db/add 1 :name "Petr"]])) {tx2 :tx txInstant2 :txInstant} (<? (d/<transact! conn [[:db/add 1 :name "Petr"]]))
{tx3 :tx txInstant3 :txInstant} (<? (dm/<transact! conn [[:db/add 1 :aka "Tupen"]])) {tx3 :tx txInstant3 :txInstant} (<? (d/<transact! conn [[:db/add 1 :aka "Tupen"]]))
{tx4 :tx txInstant4 :txInstant} (<? (dm/<transact! conn [[:db/add 1 :aka "Devil"]]))] {tx4 :tx txInstant4 :txInstant} (<? (d/<transact! conn [[:db/add 1 :aka "Devil"]]))]
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[1 :name "Petr"] #{[1 :name "Petr"]
[1 :aka "Tupen"] [1 :aka "Tupen"]
[1 :aka "Devil"]})) [1 :aka "Devil"]}))
(is (= (<? (<transactions-after (dm/db conn) tx0)) (is (= (<? (<transactions-after (d/db conn) tx0))
[[1 :name "Ivan" tx1 1] ;; TODO: true, not 1. [[1 :name "Ivan" tx1 1] ;; TODO: true, not 1.
[tx1 :db/txInstant txInstant1 tx1 1] [tx1 :db/txInstant txInstant1 tx1 1]
[1 :name "Ivan" tx2 0] [1 :name "Ivan" tx2 0]
@ -164,280 +160,259 @@
[tx4 :db/txInstant txInstant4 tx4 1]]))) [tx4 :db/txInstant txInstant4 tx4 1]])))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(deftest-async test-retract (deftest-async test-retract
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))]
db (<? (dm/<db-with-sqlite-connection c))
conn (dm/connection-with-db db)]
(try (try
(let [{tx0 :tx} (<? (dm/<transact! conn test-schema)) (let [{tx0 :tx} (<? (d/<transact! conn test-schema))
{tx1 :tx txInstant1 :txInstant} (<? (dm/<transact! conn [[:db/add 0 :x 123]])) {tx1 :tx txInstant1 :txInstant} (<? (d/<transact! conn [[:db/add 0 :x 123]]))
{tx2 :tx txInstant2 :txInstant} (<? (dm/<transact! conn [[:db/retract 0 :x 123]]))] {tx2 :tx txInstant2 :txInstant} (<? (d/<transact! conn [[:db/retract 0 :x 123]]))]
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{})) #{}))
(is (= (<? (<transactions-after (dm/db conn) tx0)) (is (= (<? (<transactions-after (d/db conn) tx0))
[[0 :x 123 tx1 1] [[0 :x 123 tx1 1]
[tx1 :db/txInstant txInstant1 tx1 1] [tx1 :db/txInstant txInstant1 tx1 1]
[0 :x 123 tx2 0] [0 :x 123 tx2 0]
[tx2 :db/txInstant txInstant2 tx2 1]]))) [tx2 :db/txInstant txInstant2 tx2 1]])))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(deftest-async test-id-literal-1 (deftest-async test-id-literal-1
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))]
db (<? (dm/<db-with-sqlite-connection c))
conn (dm/connection-with-db db)]
(try (try
(let [tx0 (:tx (<? (dm/<transact! conn test-schema))) (let [tx0 (:tx (<? (d/<transact! conn test-schema)))
report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :x 0] report (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :x 0]
[:db/add (dm/id-literal :db.part/user -1) :y 1] [:db/add (d/id-literal :db.part/user -1) :y 1]
[:db/add (dm/id-literal :db.part/user -2) :y 2] [:db/add (d/id-literal :db.part/user -2) :y 2]
[:db/add (dm/id-literal :db.part/user -2) :y 3]]))] [:db/add (d/id-literal :db.part/user -2) :y 3]]))]
(is (= (keys (:tempids report)) ;; TODO: include values. (is (= (keys (:tempids report)) ;; TODO: include values.
[(dm/id-literal :db.part/user -1) [(d/id-literal :db.part/user -1)
(dm/id-literal :db.part/user -2)])) (d/id-literal :db.part/user -2)]))
(let [eid1 (get-in report [:tempids (dm/id-literal :db.part/user -1)]) (let [eid1 (get-in report [:tempids (d/id-literal :db.part/user -1)])
eid2 (get-in report [:tempids (dm/id-literal :db.part/user -2)])] eid2 (get-in report [:tempids (d/id-literal :db.part/user -2)])]
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid1 :x 0] #{[eid1 :x 0]
[eid1 :y 1] [eid1 :y 1]
[eid2 :y 2] [eid2 :y 2]
[eid2 :y 3]})))) [eid2 :y 3]}))))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(deftest-async test-unique (deftest-async test-unique
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))]
db (<? (dm/<db-with-sqlite-connection c))
conn (dm/connection-with-db db)]
(try (try
(let [tx0 (:tx (<? (dm/<transact! conn test-schema)))] (let [tx0 (:tx (<? (d/<transact! conn test-schema)))]
(testing "Multiple :db/unique values in tx-data violate unique constraint, no tempid" (testing "Multiple :db/unique values in tx-data violate unique constraint, no tempid"
(is (thrown-with-msg? (is (thrown-with-msg?
ExceptionInfo #"unique constraint" ExceptionInfo #"unique constraint"
(<? (dm/<transact! conn [[:db/add 1 :x 0] (<? (d/<transact! conn [[:db/add 1 :x 0]
[:db/add 2 :x 0]]))))) [:db/add 2 :x 0]])))))
(testing "Multiple :db/unique values in tx-data violate unique constraint, tempid" (testing "Multiple :db/unique values in tx-data violate unique constraint, tempid"
(is (thrown-with-msg? (is (thrown-with-msg?
ExceptionInfo #"unique constraint" ExceptionInfo #"unique constraint"
(<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :spouse "Dana"] (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :spouse "Dana"]
[:db/add (dm/id-literal :db.part/user -2) :spouse "Dana"]])))))) [:db/add (d/id-literal :db.part/user -2) :spouse "Dana"]]))))))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(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 [conn (<? (d/<connect t))]
db (<? (dm/<db-with-sqlite-connection c))
conn (dm/connection-with-db db)]
(try (try
(let [tx0 (:tx (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) (let [tx0 (:tx (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1)
:db/ident :test/kw :db/ident :test/kw
:db/unique :db.unique/identity :db/unique :db.unique/identity
:db/valueType :db.type/keyword} :db/valueType :db.type/keyword}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :db.part/user -1)}])))] {:db/id :db.part/db :db.install/attribute (d/id-literal :db.part/user -1)}])))]
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :test/kw :test/kw1]])) (let [report (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :test/kw :test/kw1]]))
eid (get-in report [:tempids (dm/id-literal :db.part/user -1)])] eid (get-in report [:tempids (d/id-literal :db.part/user -1)])]
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid :test/kw ":test/kw1"]})) ;; Value is raw. #{[eid :test/kw ":test/kw1"]})) ;; Value is raw.
(testing "Adding the same value compares existing values correctly." (testing "Adding the same value compares existing values correctly."
(<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw1]])) (<? (d/<transact! conn [[:db/add eid :test/kw :test/kw1]]))
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid :test/kw ":test/kw1"]}))) ;; Value is raw. #{[eid :test/kw ":test/kw1"]}))) ;; Value is raw.
(testing "Upserting retracts existing value correctly." (testing "Upserting retracts existing value correctly."
(<? (dm/<transact! conn [[:db/add eid :test/kw :test/kw2]])) (<? (d/<transact! conn [[:db/add eid :test/kw :test/kw2]]))
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[eid :test/kw ":test/kw2"]}))) ;; Value is raw. #{[eid :test/kw ":test/kw2"]}))) ;; Value is raw.
(testing "Retracting compares values correctly." (testing "Retracting compares values correctly."
(<? (dm/<transact! conn [[:db/retract eid :test/kw :test/kw2]])) (<? (d/<transact! conn [[:db/retract eid :test/kw :test/kw2]]))
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{}))))) #{})))))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(deftest-async test-vector-upsert (deftest-async test-vector-upsert
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))]
db (<? (dm/<db-with-sqlite-connection c))
conn (dm/connection-with-db db)
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try (try
;; Not having DB-as-value really hurts us here. This test only works because all upserts ;; Not having DB-as-value really hurts us here. This test only works because all upserts
;; succeed on top of each other, so we never need to reset the underlying store. ;; succeed on top of each other, so we never need to reset the underlying store.
(<? (dm/<transact! conn test-schema)) (<? (d/<transact! conn test-schema))
(let [tx0 (:tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"} (let [tx0 (:tx (<? (d/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}])))] {:db/id 102 :name "Petr" :email "@2"}])))]
(testing "upsert with tempid" (testing "upsert with tempid"
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"] (let [report (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :name "Ivan"]
[:db/add (dm/id-literal :db.part/user -1) :age 12]]))] [:db/add (d/id-literal :db.part/user -1) :age 12]]))]
(is (= (<? (<shallow-entity (dm/db conn) 101)) (is (= (<? (<shallow-entity (d/db conn) 101))
{:name "Ivan" :age 12 :email "@1"})) {:name "Ivan" :age 12 :email "@1"}))
(is (= (tempids report) (is (= (tempids report)
{-1 101})))) {-1 101}))))
(testing "upsert with tempid, order does not matter" (testing "upsert with tempid, order does not matter"
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :age 13] (let [report (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :age 13]
[:db/add (dm/id-literal :db.part/user -1) :name "Petr"]]))] [:db/add (d/id-literal :db.part/user -1) :name "Petr"]]))]
(is (= (<? (<shallow-entity (dm/db conn) 102)) (is (= (<? (<shallow-entity (d/db conn) 102))
{:name "Petr" :age 13 :email "@2"})) {:name "Petr" :age 13 :email "@2"}))
(is (= (tempids report) (is (= (tempids report)
{-1 102})))) {-1 102}))))
(testing "Conflicting upserts fail" (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+" (is (thrown-with-msg? Throwable #"Conflicting upsert"
(<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user -1) :name "Ivan"] (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :name "Ivan"]
[:db/add (dm/id-literal :db.part/user -1) :age 35] [:db/add (d/id-literal :db.part/user -1) :age 35]
[:db/add (dm/id-literal :db.part/user -1) :name "Petr"] [:db/add (d/id-literal :db.part/user -1) :name "Petr"]
[:db/add (dm/id-literal :db.part/user -1) :age 36]])))))) [:db/add (d/id-literal :db.part/user -1) :age 36]]))))))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(deftest-async test-map-upsert (deftest-async test-map-upsert
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))]
db (<? (dm/<db-with-sqlite-connection c))
conn (dm/connection-with-db db)
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try (try
;; Not having DB-as-value really hurts us here. This test only works because all upserts ;; Not having DB-as-value really hurts us here. This test only works because all upserts
;; succeed on top of each other, so we never need to reset the underlying store. ;; succeed on top of each other, so we never need to reset the underlying store.
(<? (dm/<transact! conn test-schema)) (<? (d/<transact! conn test-schema))
(let [tx0 (:tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"} (let [tx0 (:tx (<? (d/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}])))] {:db/id 102 :name "Petr" :email "@2"}])))]
(testing "upsert with tempid" (testing "upsert with tempid"
(let [tx (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35}]))] (let [tx (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :age 35}]))]
(is (= (<? (<shallow-entity (dm/db conn) 101)) (is (= (<? (<shallow-entity (d/db conn) 101))
{:name "Ivan" :email "@1" :age 35})) {:name "Ivan" :email "@1" :age 35}))
(is (= (tempids tx) (is (= (tempids tx)
{-1 101})))) {-1 101}))))
(testing "upsert by 2 attrs with tempid" (testing "upsert by 2 attrs with tempid"
(let [tx (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@1" :age 35}]))] (let [tx (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :email "@1" :age 35}]))]
(is (= (<? (<shallow-entity (dm/db conn) 101)) (is (= (<? (<shallow-entity (d/db conn) 101))
{:name "Ivan" :email "@1" :age 35})) {:name "Ivan" :email "@1" :age 35}))
(is (= (tempids tx) (is (= (tempids tx)
{-1 101})))) {-1 101}))))
(testing "upsert with existing id" (testing "upsert with existing id"
(let [tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :age 36}]))] (let [tx (<? (d/<transact! conn [{:db/id 101 :name "Ivan" :age 36}]))]
(is (= (<? (<shallow-entity (dm/db conn) 101)) (is (= (<? (<shallow-entity (d/db conn) 101))
{:name "Ivan" :email "@1" :age 36})) {:name "Ivan" :email "@1" :age 36}))
(is (= (tempids tx) (is (= (tempids tx)
{})))) {}))))
(testing "upsert by 2 attrs with existing id" (testing "upsert by 2 attrs with existing id"
(let [tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1" :age 37}]))] (let [tx (<? (d/<transact! conn [{:db/id 101 :name "Ivan" :email "@1" :age 37}]))]
(is (= (<? (<shallow-entity (dm/db conn) 101)) (is (= (<? (<shallow-entity (d/db conn) 101))
{:name "Ivan" :email "@1" :age 37})) {:name "Ivan" :email "@1" :age 37}))
(is (= (tempids tx) (is (= (tempids tx)
{})))) {}))))
(testing "upsert to two entities, resolve to same tempid, fails due to overlapping writes" (testing "upsert to two entities, resolve to same tempid, fails due to overlapping writes"
(is (thrown-with-msg? Throwable #"cardinality constraint" (is (thrown-with-msg? Throwable #"cardinality constraint"
(<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35} (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :age 35}
{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 36}]))))) {:db/id (d/id-literal :db.part/user -1) :name "Ivan" :age 36}])))))
(testing "upsert to two entities, two tempids, fails due to overlapping writes" (testing "upsert to two entities, two tempids, fails due to overlapping writes"
(is (thrown-with-msg? Throwable #"cardinality constraint" (is (thrown-with-msg? Throwable #"cardinality constraint"
(<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :age 35} (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :age 35}
{:db/id (dm/id-literal :db.part/user -2) :name "Ivan" :age 36}])))))) {:db/id (d/id-literal :db.part/user -2) :name "Ivan" :age 36}]))))))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(deftest-async test-map-upsert-conflicts (deftest-async test-map-upsert-conflicts
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))]
db (<? (dm/<db-with-sqlite-connection c))
conn (dm/connection-with-db db)
tempids (fn [tx] (into {} (map (juxt (comp :idx first) second) (:tempids tx))))]
(try (try
;; Not having DB-as-value really hurts us here. This test only works because all upserts ;; Not having DB-as-value really hurts us here. This test only works because all upserts
;; fail until the final one, so we never need to reset the underlying store. ;; fail until the final one, so we never need to reset the underlying store.
(<? (dm/<transact! conn test-schema)) (<? (d/<transact! conn test-schema))
(let [tx0 (:tx (<? (dm/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"} (let [tx0 (:tx (<? (d/<transact! conn [{:db/id 101 :name "Ivan" :email "@1"}
{:db/id 102 :name "Petr" :email "@2"}])))] {:db/id 102 :name "Petr" :email "@2"}])))]
;; TODO: improve error message to refer to upsert inputs. ;; TODO: improve error message to refer to upsert inputs.
(testing "upsert conficts with existing id" (testing "upsert conficts with existing id"
(is (thrown-with-msg? Throwable #"unique constraint" (is (thrown-with-msg? Throwable #"unique constraint"
(<? (dm/<transact! conn [{:db/id 102 :name "Ivan" :age 36}]))))) (<? (d/<transact! conn [{:db/id 102 :name "Ivan" :age 36}])))))
;; TODO: improve error message to refer to upsert inputs. ;; TODO: improve error message to refer to upsert inputs.
(testing "upsert conficts with non-existing id" (testing "upsert conficts with non-existing id"
(is (thrown-with-msg? Throwable #"unique constraint" (is (thrown-with-msg? Throwable #"unique constraint"
(<? (dm/<transact! conn [{:db/id 103 :name "Ivan" :age 36}]))))) (<? (d/<transact! conn [{:db/id 103 :name "Ivan" :age 36}])))))
;; TODO: improve error message to refer to upsert inputs. ;; TODO: improve error message to refer to upsert inputs.
(testing "upsert by 2 conflicting fields" (testing "upsert by 2 conflicting fields"
(is (thrown-with-msg? Throwable #"Conflicting upsert: #datomish.db.TempId\{:part :db.part/user, :idx -\d+\} resolves both to \d+ and \d+" (is (thrown-with-msg? Throwable #"Conflicting upsert"
(<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@2" :age 35}]))))) (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :email "@2" :age 35}])))))
(testing "upsert by non-existing value resolves as update" (testing "upsert by non-existing value resolves as update"
(let [report (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user -1) :name "Ivan" :email "@3" :age 35}]))] (let [report (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :name "Ivan" :email "@3" :age 35}]))]
(is (= (<? (<shallow-entity (dm/db conn) 101)) (is (= (<? (<shallow-entity (d/db conn) 101))
{:name "Ivan" :email "@3" :age 35})) {:name "Ivan" :email "@3" :age 35}))
(is (= (tempids report) (is (= (tempids report)
{-1 101}))))) {-1 101})))))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(deftest-async test-add-ident (deftest-async test-add-ident
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))]
db (<? (dm/<db-with-sqlite-connection c))
conn (dm/connection-with-db db)]
(try (try
(let [report (<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/db -1) :db/ident :test/ident]])) (let [report (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/db -1) :db/ident :test/ident]]))
db-after (:db-after report) db-after (:db-after report)
tx (:tx db-after)] tx (:tx db-after)]
(is (= (:test/ident (dm/idents db-after)) (get-in report [:tempids (dm/id-literal :db.part/db -1)])))) (is (= (:test/ident (db/idents db-after)) (get-in report [:tempids (d/id-literal :db.part/db -1)]))))
;; TODO: This should fail, but doesn't, due to stringification of :test/ident. ;; TODO: This should fail, but doesn't, due to stringification of :test/ident.
;; (is (thrown-with-msg? ;; (is (thrown-with-msg?
;; ExceptionInfo #"Retracting a :db/ident is not yet supported, got " ;; ExceptionInfo #"Retracting a :db/ident is not yet supported, got "
;; (<? (dm/<transact! conn [[:db/retract 44 :db/ident :test/ident]])))) ;; (<? (d/<transact! conn [[:db/retract 44 :db/ident :test/ident]]))))
;; ;; Renaming looks like retraction and then assertion. ;; ;; Renaming looks like retraction and then assertion.
;; (is (thrown-with-msg? ;; (is (thrown-with-msg?
;; ExceptionInfo #"Retracting a :db/ident is not yet supported, got" ;; ExceptionInfo #"Retracting a :db/ident is not yet supported, got"
;; (<? (dm/<transact! conn [[:db/add 44 :db/ident :other-name]])))) ;; (<? (d/<transact! conn [[:db/add 44 :db/ident :other-name]]))))
;; (is (thrown-with-msg? ;; (is (thrown-with-msg?
;; ExceptionInfo #"Re-asserting a :db/ident is not yet supported, got" ;; ExceptionInfo #"Re-asserting a :db/ident is not yet supported, got"
;; (<? (dm/<transact! conn [[:db/add 55 :db/ident :test/ident]])))) ;; (<? (d/<transact! conn [[:db/add 55 :db/ident :test/ident]]))))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(deftest-async test-add-schema (deftest-async test-add-schema
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))]
db (<? (dm/<db-with-sqlite-connection c))
conn (dm/connection-with-db db)]
(try (try
(let [es [[:db/add :db.part/db :db.install/attribute (dm/id-literal :db.part/db -1)] (let [es [[:db/add :db.part/db :db.install/attribute (d/id-literal :db.part/db -1)]
{:db/id (dm/id-literal :db.part/db -1) {:db/id (d/id-literal :db.part/db -1)
:db/ident :test/attr :db/ident :test/attr
:db/valueType :db.type/string :db/valueType :db.type/string
:db/cardinality :db.cardinality/one}] :db/cardinality :db.cardinality/one}]
report (<? (dm/<transact! conn es)) report (<? (d/<transact! conn es))
db-after (:db-after report) db-after (:db-after report)
tx (:tx db-after)] tx (:tx db-after)]
@ -450,155 +425,147 @@
: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 100 :test/attr "value 1"}])) (<? (d/<transact! conn [{:db/id 100 :test/attr "value 1"}]))
(<? (dm/<transact! conn [{:db/id 100 :test/attr "value 2"}])) (<? (d/<transact! conn [{:db/id 100 :test/attr "value 2"}]))
(is (= (<? (<shallow-entity (dm/db conn) 100)) (is (= (<? (<shallow-entity (d/db conn) 100))
{:test/attr "value 2"})))) {:test/attr "value 2"}))))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(deftest-async test-fulltext (deftest-async test-fulltext
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))
db (<? (dm/<db-with-sqlite-connection c)) schema [{:db/id (d/id-literal :db.part/db -1)
conn (dm/connection-with-db db)
schema [{:db/id (dm/id-literal :db.part/db -1)
:db/ident :test/fulltext :db/ident :test/fulltext
:db/valueType :db.type/string :db/valueType :db.type/string
:db/fulltext true :db/fulltext true
:db/unique :db.unique/identity} :db/unique :db.unique/identity}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :db.part/db -1)} {:db/id :db.part/db :db.install/attribute (d/id-literal :db.part/db -1)}
{:db/id (dm/id-literal :db.part/db -2) {:db/id (d/id-literal :db.part/db -2)
:db/ident :test/other :db/ident :test/other
:db/valueType :db.type/string :db/valueType :db.type/string
:db/fulltext true :db/fulltext true
:db/cardinality :db.cardinality/one} :db/cardinality :db.cardinality/one}
{:db/id :db.part/db :db.install/attribute (dm/id-literal :db.part/db -2)} {:db/id :db.part/db :db.install/attribute (d/id-literal :db.part/db -2)}
] ]
tx0 (:tx (<? (dm/<transact! conn schema)))] tx0 (:tx (<? (d/<transact! conn schema)))]
(try (try
(testing "Can add fulltext indexed datoms" (testing "Can add fulltext indexed datoms"
(let [r (<? (dm/<transact! conn [[:db/add 101 :test/fulltext "test this"]]))] (let [r (<? (d/<transact! conn [[:db/add 101 :test/fulltext "test this"]]))]
(is (= (<? (<fulltext-values (dm/db conn))) (is (= (<? (<fulltext-values (d/db conn)))
[[1 "test this"]])) [[1 "test this"]]))
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :test/fulltext 1]})) ;; Values are raw; 1 is the rowid into fulltext_values. #{[101 :test/fulltext 1]})) ;; Values are raw; 1 is the rowid into fulltext_values.
)) ))
(testing "Can replace fulltext indexed datoms" (testing "Can replace fulltext indexed datoms"
(let [r (<? (dm/<transact! conn [[:db/add 101 :test/fulltext "alternate thing"]]))] (let [r (<? (d/<transact! conn [[:db/add 101 :test/fulltext "alternate thing"]]))]
(is (= (<? (<fulltext-values (dm/db conn))) (is (= (<? (<fulltext-values (d/db conn)))
[[1 "test this"] [[1 "test this"]
[2 "alternate thing"]])) [2 "alternate thing"]]))
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :test/fulltext 2]})) ;; Values are raw; 2 is the rowid into fulltext_values. #{[101 :test/fulltext 2]})) ;; Values are raw; 2 is the rowid into fulltext_values.
)) ))
(testing "Can upsert keyed by fulltext indexed datoms" (testing "Can upsert keyed by fulltext indexed datoms"
(let [r (<? (dm/<transact! conn [{:db/id (dm/id-literal :db.part/user) :test/fulltext "alternate thing" :test/other "other"}]))] (let [r (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user) :test/fulltext "alternate thing" :test/other "other"}]))]
(is (= (<? (<fulltext-values (dm/db conn))) (is (= (<? (<fulltext-values (d/db conn)))
[[1 "test this"] [[1 "test this"]
[2 "alternate thing"] [2 "alternate thing"]
[3 "other"]])) [3 "other"]]))
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :test/fulltext 2] ;; Values are raw; 2, 3 are the rowids into fulltext_values. #{[101 :test/fulltext 2] ;; Values are raw; 2, 3 are the rowids into fulltext_values.
[101 :test/other 3]})) [101 :test/other 3]}))
)) ))
(testing "Can re-use fulltext indexed datoms" (testing "Can re-use fulltext indexed datoms"
(let [r (<? (dm/<transact! conn [[:db/add 102 :test/other "test this"]]))] (let [r (<? (d/<transact! conn [[:db/add 102 :test/other "test this"]]))]
(is (= (<? (<fulltext-values (dm/db conn))) (is (= (<? (<fulltext-values (d/db conn)))
[[1 "test this"] [[1 "test this"]
[2 "alternate thing"] [2 "alternate thing"]
[3 "other"]])) [3 "other"]]))
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :test/fulltext 2] #{[101 :test/fulltext 2]
[101 :test/other 3] [101 :test/other 3]
[102 :test/other 1]})) ;; Values are raw; 1, 2, 3 are the rowids into fulltext_values. [102 :test/other 1]})) ;; Values are raw; 1, 2, 3 are the rowids into fulltext_values.
)) ))
(testing "Can retract fulltext indexed datoms" (testing "Can retract fulltext indexed datoms"
(let [r (<? (dm/<transact! conn [[:db/retract 101 :test/fulltext "alternate thing"]]))] (let [r (<? (d/<transact! conn [[:db/retract 101 :test/fulltext "alternate thing"]]))]
(is (= (<? (<fulltext-values (dm/db conn))) (is (= (<? (<fulltext-values (d/db conn)))
[[1 "test this"] [[1 "test this"]
[2 "alternate thing"] [2 "alternate thing"]
[3 "other"]])) [3 "other"]]))
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :test/other 3] #{[101 :test/other 3]
[102 :test/other 1]})) ;; Values are raw; 1, 3 are the rowids into fulltext_values. [102 :test/other 1]})) ;; Values are raw; 1, 3 are the rowids into fulltext_values.
)) ))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(deftest-async test-txInstant (deftest-async test-txInstant
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))
db (<? (dm/<db-with-sqlite-connection c)) {tx0 :tx} (<? (d/<transact! conn test-schema))]
conn (dm/connection-with-db db)
{tx0 :tx} (<? (dm/<transact! conn test-schema))]
(try (try
(let [{txa :tx txInstantA :txInstant} (<? (dm/<transact! conn []))] (let [{txa :tx txInstantA :txInstant} (<? (d/<transact! conn []))]
(testing ":db/txInstant is set by default" (testing ":db/txInstant is set by default"
(is (= (<? (<transactions-after (dm/db conn) tx0)) (is (= (<? (<transactions-after (d/db conn) tx0))
[[txa :db/txInstant txInstantA txa 1]]))) [[txa :db/txInstant txInstantA txa 1]])))
;; TODO: range check txInstant values against DB clock. ;; TODO: range check txInstant values against DB clock.
(testing ":db/txInstant can be set explicitly" (testing ":db/txInstant can be set explicitly"
(let [{txb :tx txInstantB :txInstant} (<? (dm/<transact! conn [[:db/add :db/tx :db/txInstant (+ txInstantA 1)]]))] (let [{txb :tx txInstantB :txInstant} (<? (d/<transact! conn [[:db/add :db/tx :db/txInstant (+ txInstantA 1)]]))]
(is (= txInstantB (+ txInstantA 1))) (is (= txInstantB (+ txInstantA 1)))
(is (= (<? (<transactions-after (dm/db conn) txa)) (is (= (<? (<transactions-after (d/db conn) txa))
[[txb :db/txInstant txInstantB txb 1]])) [[txb :db/txInstant txInstantB txb 1]]))
(testing ":db/txInstant can be set explicitly, with additional datoms" (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)] (let [{txc :tx txInstantC :txInstant} (<? (d/<transact! conn [[:db/add :db/tx :db/txInstant (+ txInstantB 2)]
[:db/add :db/tx :x 123]]))] [:db/add :db/tx :x 123]]))]
(is (= txInstantC (+ txInstantB 2))) (is (= txInstantC (+ txInstantB 2)))
(is (= (<? (<transactions-after (dm/db conn) txb)) (is (= (<? (<transactions-after (d/db conn) txb))
[[txc :db/txInstant txInstantC txc 1] [[txc :db/txInstant txInstantC txc 1]
[txc :x 123 txc 1]])) [txc :x 123 txc 1]]))
(testing "additional datoms can be added, without :db/txInstant explicitly" (testing "additional datoms can be added, without :db/txInstant explicitly"
(let [{txd :tx txInstantD :txInstant} (<? (dm/<transact! conn [[:db/add :db/tx :x 456]]))] (let [{txd :tx txInstantD :txInstant} (<? (d/<transact! conn [[:db/add :db/tx :x 456]]))]
(is (= (<? (<transactions-after (dm/db conn) txc)) (is (= (<? (<transactions-after (d/db conn) txc))
[[txd :db/txInstant txInstantD txd 1] [[txd :db/txInstant txInstantD txd 1]
[txd :x 456 txd 1]]))))))))) [txd :x 456 txd 1]])))))))))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(deftest-async test-no-tx (deftest-async test-no-tx
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))
db (<? (dm/<db-with-sqlite-connection c)) {tx0 :tx} (<? (d/<transact! conn test-schema))]
conn (dm/connection-with-db db)
{tx0 :tx} (<? (dm/<transact! conn test-schema))]
(try (try
(testing "Cannot specificy an explicit tx" (testing "Cannot specificy an explicit tx"
(is (thrown-with-msg? (is (thrown-with-msg?
ExceptionInfo #"Bad entity: too long" ExceptionInfo #"Bad entity: too long"
(<? (dm/<transact! conn [[:db/add (dm/id-literal :db.part/user) :x 0 10101]]))))) (<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user) :x 0 10101]])))))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(deftest-async test-explode-sequences (deftest-async test-explode-sequences
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))
db (<? (dm/<db-with-sqlite-connection c)) {tx0 :tx} (<? (d/<transact! conn test-schema))]
conn (dm/connection-with-db db)
{tx0 :tx} (<? (dm/<transact! conn test-schema))]
(try (try
(testing ":db.cardinality/many sequences are accepted" (testing ":db.cardinality/many sequences are accepted"
(<? (dm/<transact! conn [{:db/id 101 :aka ["first" "second"]}])) (<? (d/<transact! conn [{:db/id 101 :aka ["first" "second"]}]))
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :aka "first"] #{[101 :aka "first"]
[101 :aka "second"]}))) [101 :aka "second"]})))
(testing ":db.cardinality/many sequences are recursively applied, allowing unexpected sequence nesting" (testing ":db.cardinality/many sequences are recursively applied, allowing unexpected sequence nesting"
(<? (dm/<transact! conn [{:db/id 102 :aka [[["first"]] ["second"]]}])) (<? (d/<transact! conn [{:db/id 102 :aka [[["first"]] ["second"]]}]))
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :aka "first"] #{[101 :aka "first"]
[101 :aka "second"] [101 :aka "second"]
[102 :aka "first"] [102 :aka "first"]
@ -607,32 +574,30 @@
(testing ":db.cardinality/one sequences fail" (testing ":db.cardinality/one sequences fail"
(is (thrown-with-msg? (is (thrown-with-msg?
ExceptionInfo #"Sequential values" ExceptionInfo #"Sequential values"
(<? (dm/<transact! conn [{:db/id 101 :email ["@1" "@2"]}]))))) (<? (d/<transact! conn [{:db/id 101 :email ["@1" "@2"]}])))))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(deftest-async test-explode-maps (deftest-async test-explode-maps
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))
db (<? (dm/<db-with-sqlite-connection c)) {tx0 :tx} (<? (d/<transact! conn test-schema))]
conn (dm/connection-with-db db)
{tx0 :tx} (<? (dm/<transact! conn test-schema))]
(try (try
(testing "nested maps are accepted" (testing "nested maps are accepted"
(<? (dm/<transact! conn [{:db/id 101 :friends {:name "Petr"}}])) (<? (d/<transact! conn [{:db/id 101 :friends {:name "Petr"}}]))
;; TODO: this works only because we have a single friend. ;; TODO: this works only because we have a single friend.
(let [{petr :friends} (<? (<shallow-entity (dm/db conn) 101))] (let [{petr :friends} (<? (<shallow-entity (d/db conn) 101))]
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :friends petr] #{[101 :friends petr]
[petr :name "Petr"]})))) [petr :name "Petr"]}))))
(testing "recursively nested maps are accepted" (testing "recursively nested maps are accepted"
(<? (dm/<transact! conn [{:db/id 102 :friends {:name "Ivan" :friends {:name "Petr"}}}])) (<? (d/<transact! conn [{:db/id 102 :friends {:name "Ivan" :friends {:name "Petr"}}}]))
;; This would be much easier with `entity` and lookup refs. ;; This would be much easier with `entity` and lookup refs.
(let [{ivan :friends} (<? (<shallow-entity (dm/db conn) 102)) (let [{ivan :friends} (<? (<shallow-entity (d/db conn) 102))
{petr :friends} (<? (<shallow-entity (dm/db conn) ivan))] {petr :friends} (<? (<shallow-entity (d/db conn) ivan))]
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :friends petr] #{[101 :friends petr]
[petr :name "Petr"] [petr :name "Petr"]
[102 :friends ivan] [102 :friends ivan]
@ -642,22 +607,20 @@
(testing "nested maps without :db.type/ref fail" (testing "nested maps without :db.type/ref fail"
(is (thrown-with-msg? (is (thrown-with-msg?
ExceptionInfo #"\{:db/valueType :db.type/ref\}" ExceptionInfo #"\{:db/valueType :db.type/ref\}"
(<? (dm/<transact! conn [{:db/id 101 :aka {:name "Petr"}}]))))) (<? (d/<transact! conn [{:db/id 101 :aka {:name "Petr"}}])))))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))
(deftest-async test-explode-reverse-refs (deftest-async test-explode-reverse-refs
(with-tempfile [t (tempfile)] (with-tempfile [t (tempfile)]
(let [c (<? (s/<sqlite-connection t)) (let [conn (<? (d/<connect t))
db (<? (dm/<db-with-sqlite-connection c)) {tx0 :tx} (<? (d/<transact! conn test-schema))]
conn (dm/connection-with-db db)
{tx0 :tx} (<? (dm/<transact! conn test-schema))]
(try (try
(testing "reverse refs are accepted" (testing "reverse refs are accepted"
(<? (dm/<transact! conn [{:db/id 101 :name "Igor"}])) (<? (d/<transact! conn [{:db/id 101 :name "Igor"}]))
(<? (dm/<transact! conn [{:db/id 102 :name "Oleg" :_friends 101}])) (<? (d/<transact! conn [{:db/id 102 :name "Oleg" :_friends 101}]))
(is (= (<? (<datoms-after (dm/db conn) tx0)) (is (= (<? (<datoms-after (d/db conn) tx0))
#{[101 :name "Igor"] #{[101 :name "Igor"]
[102 :name "Oleg"] [102 :name "Oleg"]
[101 :friends 102]}))) [101 :friends 102]})))
@ -665,7 +628,7 @@
(testing "reverse refs without :db.type/ref fail" (testing "reverse refs without :db.type/ref fail"
(is (thrown-with-msg? (is (thrown-with-msg?
ExceptionInfo #"\{:db/valueType :db.type/ref\}" ExceptionInfo #"\{:db/valueType :db.type/ref\}"
(<? (dm/<transact! conn [{:db/id 101 :_aka 102}]))))) (<? (d/<transact! conn [{:db/id 101 :_aka 102}])))))
(finally (finally
(<? (dm/close-db db))))))) (<? (d/<close conn)))))))