Add :db.fn/retractAttribute and :db.fn/retractEntity. Fixes #46. r=rnewman
This commit is contained in:
commit
562ced372d
5 changed files with 736 additions and 548 deletions
|
@ -172,6 +172,55 @@
|
||||||
:table-alias source/gensym-table-alias
|
:table-alias source/gensym-table-alias
|
||||||
:make-constraints nil}))
|
:make-constraints nil}))
|
||||||
|
|
||||||
|
;; TODO: make this not do the tx_lookup. We could achieve this by having additional special values
|
||||||
|
;; of added0, or by separating the tx_lookup table into before and after tables.
|
||||||
|
(defn- retractAttributes->queries [eas tx]
|
||||||
|
(let [where-part
|
||||||
|
"(e = ? AND a = ?)"
|
||||||
|
|
||||||
|
repeater (memoize (fn [n] (interpose " OR " (repeat n where-part))))]
|
||||||
|
(map
|
||||||
|
(fn [chunk]
|
||||||
|
(cons
|
||||||
|
(apply str
|
||||||
|
"INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, sv, svalue_type_tag)
|
||||||
|
SELECT e, a, v, ?, 0, value_type_tag, v, value_type_tag
|
||||||
|
FROM datoms
|
||||||
|
WHERE "
|
||||||
|
(repeater (count chunk)))
|
||||||
|
(cons
|
||||||
|
tx
|
||||||
|
(mapcat (fn [[_ e a]]
|
||||||
|
[e a])
|
||||||
|
chunk))))
|
||||||
|
(partition-all (quot (dec max-sql-vars) 2) eas))))
|
||||||
|
|
||||||
|
;; TODO: make this not do the tx_lookup. We could achieve this by having additional special values
|
||||||
|
;; of added0, or by separating the tx_lookup table into before and after tables.
|
||||||
|
(defn- retractEntities->queries [es tx]
|
||||||
|
(let [ref-tag (sqlite-schema/->tag :db.type/ref)
|
||||||
|
|
||||||
|
;; TODO: include index_vaet flag here, so we can use that index to speed up the deletion.
|
||||||
|
where-part
|
||||||
|
(str "e = ? OR (v = ? AND value_type_tag = " ref-tag ")") ;; Retract the entity and all refs to the entity.
|
||||||
|
|
||||||
|
repeater (memoize (fn [n] (interpose " OR " (repeat n where-part))))]
|
||||||
|
(map
|
||||||
|
(fn [chunk]
|
||||||
|
(cons
|
||||||
|
(apply str
|
||||||
|
"INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, sv, svalue_type_tag)
|
||||||
|
SELECT e, a, v, ?, 0, value_type_tag, v, value_type_tag
|
||||||
|
FROM datoms
|
||||||
|
WHERE "
|
||||||
|
(repeater (count chunk)))
|
||||||
|
(cons
|
||||||
|
tx
|
||||||
|
(mapcat (fn [[_ e]]
|
||||||
|
[e e])
|
||||||
|
chunk))))
|
||||||
|
(partition-all (quot (dec max-sql-vars) 2) es))))
|
||||||
|
|
||||||
(defn- retractions->queries [retractions tx fulltext? ->SQLite]
|
(defn- retractions->queries [retractions tx fulltext? ->SQLite]
|
||||||
(let
|
(let
|
||||||
[f-q
|
[f-q
|
||||||
|
@ -431,9 +480,12 @@
|
||||||
queries (atom [])
|
queries (atom [])
|
||||||
operations (group-by first entities)]
|
operations (group-by first entities)]
|
||||||
|
|
||||||
(when-not (clojure.set/subset? (keys operations) #{:db/retract :db/add})
|
;; Belt and braces. At this point, we should have already errored out if op is not known.
|
||||||
(raise (str "Unknown operations " (keys operations))
|
(let [known #{:db/retract :db/add :db.fn/retractAttribute :db.fn/retractEntity}]
|
||||||
{:error :transact/syntax, :operations (dissoc operations :db/retract :db/add)}))
|
(when-not (clojure.set/subset? (keys operations) known)
|
||||||
|
(let [unknown (apply dissoc operations known)]
|
||||||
|
(raise (str "Unknown operations " (apply sorted-set (keys unknown)))
|
||||||
|
{:error :transact/syntax, :operations (apply sorted-set (keys unknown))}))))
|
||||||
|
|
||||||
;; We can turn all non-FTS operations into simple SQL queries that we run serially.
|
;; We can turn all non-FTS operations into simple SQL queries that we run serially.
|
||||||
;; FTS queries require us to get a rowid from the FTS table and use that for
|
;; FTS queries require us to get a rowid from the FTS table and use that for
|
||||||
|
@ -441,6 +493,14 @@
|
||||||
;; We can't just freely use `go-pair` here, because this function is so complicated
|
;; We can't just freely use `go-pair` here, because this function is so complicated
|
||||||
;; that ClojureScript blows the stack trying to compile it.
|
;; that ClojureScript blows the stack trying to compile it.
|
||||||
|
|
||||||
|
(when-let [eas (:db.fn/retractAttribute operations)]
|
||||||
|
(swap!
|
||||||
|
queries concat (retractAttributes->queries eas tx)))
|
||||||
|
|
||||||
|
(when-let [es (:db.fn/retractEntity operations)]
|
||||||
|
(swap!
|
||||||
|
queries concat (retractEntities->queries es tx)))
|
||||||
|
|
||||||
(when-let [retractions (:db/retract operations)]
|
(when-let [retractions (:db/retract operations)]
|
||||||
(swap!
|
(swap!
|
||||||
queries concat (retractions->queries retractions tx fulltext? ->SQLite)))
|
queries concat (retractions->queries retractions tx fulltext? ->SQLite)))
|
||||||
|
|
|
@ -97,7 +97,6 @@
|
||||||
new))]
|
new))]
|
||||||
(let [exec (partial s/execute! (:sqlite-connection db))
|
(let [exec (partial s/execute! (:sqlite-connection db))
|
||||||
part->vector (fn [[part {:keys [start idx]}]]
|
part->vector (fn [[part {:keys [start idx]}]]
|
||||||
(println "part->vector" part start idx)
|
|
||||||
[(sqlite-schema/->SQLite part) start idx])]
|
[(sqlite-schema/->SQLite part) start idx])]
|
||||||
;; TODO: allow inserting new parts.
|
;; TODO: allow inserting new parts.
|
||||||
;; TODO: think more carefully about allocating new parts and bitmasking part ranges.
|
;; TODO: think more carefully about allocating new parts and bitmasking part ranges.
|
||||||
|
|
|
@ -5,8 +5,7 @@
|
||||||
(ns datomish.test-macros
|
(ns datomish.test-macros
|
||||||
#?(:cljs
|
#?(:cljs
|
||||||
(:require-macros
|
(:require-macros
|
||||||
[datomish.test-macros]
|
[datomish.test-macros]))
|
||||||
[datomish.node-tempfile-macros]))
|
|
||||||
(:require
|
(:require
|
||||||
[datomish.pair-chan]))
|
[datomish.pair-chan]))
|
||||||
|
|
||||||
|
@ -44,16 +43,8 @@
|
||||||
(defmacro deftest-db
|
(defmacro deftest-db
|
||||||
[n conn-var & body]
|
[n conn-var & body]
|
||||||
`(deftest-async ~n
|
`(deftest-async ~n
|
||||||
(if-cljs
|
(let [~conn-var (datomish.pair-chan/<? (datomish.api/<connect ""))]
|
||||||
(datomish.node-tempfile-macros/with-tempfile [t# (datomish.node-tempfile/tempfile)]
|
|
||||||
(let [~conn-var (datomish.pair-chan/<? (datomish.api/<connect t#))]
|
|
||||||
(try
|
(try
|
||||||
~@body
|
~@body
|
||||||
(finally
|
(finally
|
||||||
(datomish.pair-chan/<? (datomish.api/<close ~conn-var))))))
|
(datomish.pair-chan/<? (datomish.api/<close ~conn-var)))))))
|
||||||
(tempfile.core/with-tempfile [t# (tempfile.core/tempfile)]
|
|
||||||
(let [~conn-var (datomish.pair-chan/<? (datomish.api/<connect t#))]
|
|
||||||
(try
|
|
||||||
~@body
|
|
||||||
(finally
|
|
||||||
(datomish.pair-chan/<? (datomish.api/<close ~conn-var)))))))))
|
|
||||||
|
|
|
@ -119,12 +119,13 @@
|
||||||
entity))
|
entity))
|
||||||
|
|
||||||
(defn maybe-ident->entid [db [op e a v tx :as orig]]
|
(defn maybe-ident->entid [db [op e a v tx :as orig]]
|
||||||
|
;; We have to handle all ops, including those when a or v are not defined.
|
||||||
(let [e (db/entid db e)
|
(let [e (db/entid db e)
|
||||||
a (db/entid db a)
|
a (db/entid db 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 (if (and a (ds/kw? (db/schema db) a)) ;; TODO: decide if this is best. We could also check for ref and numeric types.
|
||||||
v
|
v
|
||||||
(db/entid db v))]
|
(db/entid db v))]
|
||||||
(when-not (integer? a)
|
(when (and a (not (integer? a)))
|
||||||
(raise "Unknown attribute " a
|
(raise "Unknown attribute " a
|
||||||
{:form orig :attribute a}))
|
{:form orig :attribute a}))
|
||||||
[op e a v tx]))
|
[op e a v tx]))
|
||||||
|
@ -138,16 +139,16 @@
|
||||||
;; n.b., this must not be symbolic -- it's inserted after we map idents -> entids.
|
;; n.b., this must not be symbolic -- it's inserted after we map idents -> entids.
|
||||||
[:db/add tx (db/entid db :db/txInstant) txInstant]))
|
[:db/add tx (db/entid db :db/txInstant) txInstant]))
|
||||||
|
|
||||||
(defn ensure-entity-form [[op e a v & rest :as entity]]
|
(defn ensure-entity-form [entity]
|
||||||
(cond
|
(when-not (sequential? entity)
|
||||||
(not (sequential? entity))
|
|
||||||
(raise "Bad entity " entity ", should be sequential at this point"
|
(raise "Bad entity " entity ", should be sequential at this point"
|
||||||
{:error :transact/bad-entity, :entity entity})
|
{: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 })
|
|
||||||
|
|
||||||
|
(let [[op] entity]
|
||||||
|
(case op
|
||||||
|
(:db/add :db/retract)
|
||||||
|
(let [[_ e a v & rest] entity]
|
||||||
|
(cond
|
||||||
(nil? e)
|
(nil? e)
|
||||||
(raise "Bad entity: nil e in " entity
|
(raise "Bad entity: nil e in " entity
|
||||||
{:error :transact/bad-entity :entity entity })
|
{:error :transact/bad-entity :entity entity })
|
||||||
|
@ -162,10 +163,39 @@
|
||||||
|
|
||||||
(some? rest)
|
(some? rest)
|
||||||
(raise "Bad entity: too long " entity
|
(raise "Bad entity: too long " entity
|
||||||
|
{:error :transact/bad-entity :entity entity })))
|
||||||
|
|
||||||
|
:db.fn/retractAttribute
|
||||||
|
(let [[_ e a & rest] entity]
|
||||||
|
(cond
|
||||||
|
(nil? e)
|
||||||
|
(raise "Bad entity: nil e in " entity
|
||||||
{:error :transact/bad-entity :entity entity })
|
{:error :transact/bad-entity :entity entity })
|
||||||
|
|
||||||
true
|
(nil? a)
|
||||||
entity))
|
(raise "Bad entity: nil a in " entity
|
||||||
|
{:error :transact/bad-entity :entity entity })
|
||||||
|
|
||||||
|
(some? rest)
|
||||||
|
(raise "Bad entity: too long " entity
|
||||||
|
{:error :transact/bad-entity :entity entity })))
|
||||||
|
|
||||||
|
:db.fn/retractEntity
|
||||||
|
(let [[_ e & rest] entity]
|
||||||
|
(cond
|
||||||
|
(nil? e)
|
||||||
|
(raise "Bad entity: nil e in " entity
|
||||||
|
{:error :transact/bad-entity :entity entity })
|
||||||
|
|
||||||
|
(some? rest)
|
||||||
|
(raise "Bad entity: too long " entity
|
||||||
|
{:error :transact/bad-entity :entity entity })))
|
||||||
|
|
||||||
|
;; Default
|
||||||
|
(raise "Unrecognized operation " op " expected one of :db/add :db/retract :db/fn.retractAttribute :db/fn.retractEntity at this point"
|
||||||
|
{:error :transact/bad-operation :entity entity })))
|
||||||
|
|
||||||
|
entity)
|
||||||
|
|
||||||
(defn- tx-instant? [db [op e a & _]]
|
(defn- tx-instant? [db [op e a & _]]
|
||||||
(and (= op :db/add)
|
(and (= op :db/add)
|
||||||
|
@ -373,7 +403,8 @@
|
||||||
(go-pair
|
(go-pair
|
||||||
(let [schema (db/schema db)]
|
(let [schema (db/schema db)]
|
||||||
(doseq [[op e a v] (:entities report)]
|
(doseq [[op e a v] (:entities report)]
|
||||||
(ds/ensure-valid-value schema a v)))
|
(if (and e a v)
|
||||||
|
(ds/ensure-valid-value schema a v))))
|
||||||
report))
|
report))
|
||||||
|
|
||||||
(defn <transact-tx-data
|
(defn <transact-tx-data
|
||||||
|
|
|
@ -19,12 +19,12 @@
|
||||||
#?@(:clj [[datomish.jdbc-sqlite]
|
#?@(:clj [[datomish.jdbc-sqlite]
|
||||||
[datomish.pair-chan :refer [go-pair <?]]
|
[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 deftest-db]]
|
||||||
[clojure.test :as t :refer [is are deftest testing]]
|
[clojure.test :as t :refer [is are deftest testing]]
|
||||||
[clojure.core.async :refer [go <! >!]]])
|
[clojure.core.async :refer [go <! >!]]])
|
||||||
#?@(:cljs [[datomish.promise-sqlite]
|
#?@(:cljs [[datomish.promise-sqlite]
|
||||||
[datomish.pair-chan]
|
[datomish.pair-chan]
|
||||||
[datomish.test-macros :refer-macros [deftest-async]]
|
[datomish.test-macros :refer-macros [deftest-async deftest-db]]
|
||||||
[datomish.node-tempfile :refer [tempfile]]
|
[datomish.node-tempfile :refer [tempfile]]
|
||||||
[cljs.test :as t :refer-macros [is are deftest testing async]]
|
[cljs.test :as t :refer-macros [is are deftest testing async]]
|
||||||
[cljs.core.async :as a :refer [<! >!]]]))
|
[cljs.core.async :as a :refer [<! >!]]]))
|
||||||
|
@ -81,24 +81,16 @@
|
||||||
:db.install/_attribute :db.part/db}
|
:db.install/_attribute :db.part/db}
|
||||||
])
|
])
|
||||||
|
|
||||||
(deftest-async test-add-one
|
(deftest-db test-add-one conn
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))]
|
|
||||||
(try
|
|
||||||
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))]
|
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))]
|
||||||
(let [{:keys [tx txInstant]} (<? (d/<transact! conn [[:db/add 0 :name "valuex"]]))]
|
(let [{:keys [tx txInstant]} (<? (d/<transact! conn [[:db/add 0 :name "valuex"]]))]
|
||||||
(is (= (<? (<datoms-after (d/db conn) tx0))
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
#{[0 :name "valuex"]}))
|
#{[0 :name "valuex"]}))
|
||||||
(is (= (<? (<transactions-after (d/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
|
|
||||||
(<? (d/<close conn)))))))
|
|
||||||
|
|
||||||
(deftest-async test-add-two
|
(deftest-db test-add-two conn
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))]
|
|
||||||
(try
|
|
||||||
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))
|
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))
|
||||||
{tx1 :tx txInstant1 :txInstant} (<? (d/<transact! conn [[:db/add 1 :name "Ivan"]]))
|
{tx1 :tx txInstant1 :txInstant} (<? (d/<transact! conn [[:db/add 1 :name "Ivan"]]))
|
||||||
{tx2 :tx txInstant2 :txInstant} (<? (d/<transact! conn [[:db/add 1 :name "Petr"]]))
|
{tx2 :tx txInstant2 :txInstant} (<? (d/<transact! conn [[:db/add 1 :name "Petr"]]))
|
||||||
|
@ -118,15 +110,9 @@
|
||||||
[1 :aka "Tupen" tx3 1]
|
[1 :aka "Tupen" tx3 1]
|
||||||
[tx3 :db/txInstant txInstant3 tx3 1]
|
[tx3 :db/txInstant txInstant3 tx3 1]
|
||||||
[1 :aka "Devil" tx4 1]
|
[1 :aka "Devil" tx4 1]
|
||||||
[tx4 :db/txInstant txInstant4 tx4 1]])))
|
[tx4 :db/txInstant txInstant4 tx4 1]]))))
|
||||||
|
|
||||||
(finally
|
(deftest-db test-retract conn
|
||||||
(<? (d/<close conn)))))))
|
|
||||||
|
|
||||||
(deftest-async test-retract
|
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))]
|
|
||||||
(try
|
|
||||||
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))
|
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))
|
||||||
{tx1 :tx txInstant1 :txInstant} (<? (d/<transact! conn [[:db/add 0 :x 123]]))
|
{tx1 :tx txInstant1 :txInstant} (<? (d/<transact! conn [[:db/add 0 :x 123]]))
|
||||||
{tx2 :tx txInstant2 :txInstant} (<? (d/<transact! conn [[:db/retract 0 :x 123]]))]
|
{tx2 :tx txInstant2 :txInstant} (<? (d/<transact! conn [[:db/retract 0 :x 123]]))]
|
||||||
|
@ -136,14 +122,9 @@
|
||||||
[[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
|
|
||||||
(<? (d/<close conn)))))))
|
|
||||||
|
|
||||||
(deftest-async test-id-literal-1
|
(deftest-db test-id-literal-1 conn
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))]
|
|
||||||
(try
|
|
||||||
(let [tx0 (:tx (<? (d/<transact! conn test-schema)))
|
(let [tx0 (:tx (<? (d/<transact! conn test-schema)))
|
||||||
report (<? (d/<transact! conn [[:db/add (d/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 (d/id-literal :db.part/user -1) :y 1]
|
[:db/add (d/id-literal :db.part/user -1) :y 1]
|
||||||
|
@ -159,15 +140,9 @@
|
||||||
#{[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
|
(deftest-db test-unique conn
|
||||||
(<? (d/<close conn)))))))
|
|
||||||
|
|
||||||
(deftest-async test-unique
|
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))]
|
|
||||||
(try
|
|
||||||
(let [tx0 (:tx (<? (d/<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?
|
||||||
|
@ -179,15 +154,9 @@
|
||||||
(is (thrown-with-msg?
|
(is (thrown-with-msg?
|
||||||
ExceptionInfo #"unique constraint"
|
ExceptionInfo #"unique constraint"
|
||||||
(<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :spouse "Dana"]
|
(<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :spouse "Dana"]
|
||||||
[:db/add (d/id-literal :db.part/user -2) :spouse "Dana"]]))))))
|
[:db/add (d/id-literal :db.part/user -2) :spouse "Dana"]])))))))
|
||||||
|
|
||||||
(finally
|
(deftest-db test-valueType-keyword conn
|
||||||
(<? (d/<close conn)))))))
|
|
||||||
|
|
||||||
(deftest-async test-valueType-keyword
|
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))]
|
|
||||||
(try
|
|
||||||
(let [tx0 (:tx (<? (d/<transact! conn [{:db/id (d/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
|
||||||
|
@ -212,15 +181,9 @@
|
||||||
(testing "Retracting compares values correctly."
|
(testing "Retracting compares values correctly."
|
||||||
(<? (d/<transact! conn [[:db/retract eid :test/kw :test/kw2]]))
|
(<? (d/<transact! conn [[:db/retract eid :test/kw :test/kw2]]))
|
||||||
(is (= (<? (<datoms-after (d/db conn) tx0))
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
#{})))))
|
#{}))))))
|
||||||
|
|
||||||
(finally
|
(deftest-db test-vector-upsert conn
|
||||||
(<? (d/<close conn)))))))
|
|
||||||
|
|
||||||
(deftest-async test-vector-upsert
|
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))]
|
|
||||||
(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.
|
||||||
(<? (d/<transact! conn test-schema))
|
(<? (d/<transact! conn test-schema))
|
||||||
|
@ -248,14 +211,9 @@
|
||||||
(<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :name "Ivan"]
|
(<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user -1) :name "Ivan"]
|
||||||
[:db/add (d/id-literal :db.part/user -1) :age 35]
|
[:db/add (d/id-literal :db.part/user -1) :age 35]
|
||||||
[:db/add (d/id-literal :db.part/user -1) :name "Petr"]
|
[:db/add (d/id-literal :db.part/user -1) :name "Petr"]
|
||||||
[:db/add (d/id-literal :db.part/user -1) :age 36]]))))))
|
[:db/add (d/id-literal :db.part/user -1) :age 36]])))))))
|
||||||
(finally
|
|
||||||
(<? (d/<close conn)))))))
|
|
||||||
|
|
||||||
(deftest-async test-map-upsert
|
(deftest-db test-map-upsert conn
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))]
|
|
||||||
(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.
|
||||||
(<? (d/<transact! conn test-schema))
|
(<? (d/<transact! conn test-schema))
|
||||||
|
@ -298,15 +256,9 @@
|
||||||
(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"
|
||||||
(<? (d/<transact! conn [{:db/id (d/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 (d/id-literal :db.part/user -2) :name "Ivan" :age 36}]))))))
|
{:db/id (d/id-literal :db.part/user -2) :name "Ivan" :age 36}])))))))
|
||||||
|
|
||||||
(finally
|
(deftest-db test-map-upsert-conflicts conn
|
||||||
(<? (d/<close conn)))))))
|
|
||||||
|
|
||||||
(deftest-async test-map-upsert-conflicts
|
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))]
|
|
||||||
(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.
|
||||||
(<? (d/<transact! conn test-schema))
|
(<? (d/<transact! conn test-schema))
|
||||||
|
@ -333,15 +285,9 @@
|
||||||
(is (= (<? (<shallow-entity (d/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
|
(deftest-db test-add-ident conn
|
||||||
(<? (d/<close conn)))))))
|
|
||||||
|
|
||||||
(deftest-async test-add-ident
|
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))]
|
|
||||||
(try
|
|
||||||
(is (= :test/ident (d/entid (d/db conn) :test/ident)))
|
(is (= :test/ident (d/entid (d/db conn) :test/ident)))
|
||||||
|
|
||||||
(let [report (<? (d/<transact! conn [[:db/add (d/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]]))
|
||||||
|
@ -362,14 +308,9 @@
|
||||||
;; (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"
|
||||||
;; (<? (d/<transact! conn [[:db/add 55 :db/ident :test/ident]]))))
|
;; (<? (d/<transact! conn [[:db/add 55 :db/ident :test/ident]]))))
|
||||||
|
)
|
||||||
|
|
||||||
(finally
|
(deftest-db test-add-schema conn
|
||||||
(<? (d/<close conn)))))))
|
|
||||||
|
|
||||||
(deftest-async test-add-schema
|
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))]
|
|
||||||
(try
|
|
||||||
(let [es [[:db/add :db.part/db :db.install/attribute (d/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 (d/id-literal :db.part/db -1)
|
{:db/id (d/id-literal :db.part/db -1)
|
||||||
:db/ident :test/attr
|
:db/ident :test/attr
|
||||||
|
@ -391,15 +332,10 @@
|
||||||
(<? (d/<transact! conn [{:db/id 100 :test/attr "value 1"}]))
|
(<? (d/<transact! conn [{:db/id 100 :test/attr "value 1"}]))
|
||||||
(<? (d/<transact! conn [{:db/id 100 :test/attr "value 2"}]))
|
(<? (d/<transact! conn [{:db/id 100 :test/attr "value 2"}]))
|
||||||
(is (= (<? (<shallow-entity (d/db conn) 100))
|
(is (= (<? (<shallow-entity (d/db conn) 100))
|
||||||
{:test/attr "value 2"}))))
|
{:test/attr "value 2"})))))
|
||||||
|
|
||||||
(finally
|
(deftest-db test-fulltext conn
|
||||||
(<? (d/<close conn)))))))
|
(let [schema [{:db/id (d/id-literal :db.part/db -1)
|
||||||
|
|
||||||
(deftest-async test-fulltext
|
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))
|
|
||||||
schema [{:db/id (d/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
|
||||||
|
@ -416,7 +352,7 @@
|
||||||
(testing "Schema checks"
|
(testing "Schema checks"
|
||||||
(is (ds/fulltext? (d/schema (d/db conn))
|
(is (ds/fulltext? (d/schema (d/db conn))
|
||||||
(d/entid (d/db conn) :test/fulltext))))
|
(d/entid (d/db conn) :test/fulltext))))
|
||||||
(try
|
|
||||||
(testing "Can add fulltext indexed datoms"
|
(testing "Can add fulltext indexed datoms"
|
||||||
(let [{tx1 :tx txInstant1 :txInstant}
|
(let [{tx1 :tx txInstant1 :txInstant}
|
||||||
(<? (d/<transact! conn [[:db/add 101 :test/fulltext "test this"]]))]
|
(<? (d/<transact! conn [[:db/add 101 :test/fulltext "test this"]]))]
|
||||||
|
@ -483,17 +419,11 @@
|
||||||
(is (= (<? (<datoms-after (d/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
|
(deftest-db test-txInstant conn
|
||||||
(<? (d/<close conn)))))))
|
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))
|
||||||
|
{txa :tx txInstantA :txInstant} (<? (d/<transact! conn []))]
|
||||||
(deftest-async test-txInstant
|
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))
|
|
||||||
{tx0 :tx} (<? (d/<transact! conn test-schema))]
|
|
||||||
(try
|
|
||||||
(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 (d/db conn) tx0))
|
(is (= (<? (<transactions-after (d/db conn) tx0))
|
||||||
[[txa :db/txInstant txInstantA txa 1]])))
|
[[txa :db/txInstant txInstantA txa 1]])))
|
||||||
|
@ -517,29 +447,17 @@
|
||||||
(let [{txd :tx txInstantD :txInstant} (<? (d/<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 (d/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
|
(deftest-db test-no-tx conn
|
||||||
(<? (d/<close conn)))))))
|
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))]
|
||||||
|
|
||||||
(deftest-async test-no-tx
|
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))
|
|
||||||
{tx0 :tx} (<? (d/<transact! conn test-schema))]
|
|
||||||
(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"
|
||||||
(<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user) :x 0 10101]])))))
|
(<? (d/<transact! conn [[:db/add (d/id-literal :db.part/user) :x 0 10101]])))))))
|
||||||
|
|
||||||
(finally
|
(deftest-db test-explode-sequences conn
|
||||||
(<? (d/<close conn)))))))
|
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))]
|
||||||
|
|
||||||
(deftest-async test-explode-sequences
|
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))
|
|
||||||
{tx0 :tx} (<? (d/<transact! conn test-schema))]
|
|
||||||
(try
|
|
||||||
(testing ":db.cardinality/many sequences are accepted"
|
(testing ":db.cardinality/many sequences are accepted"
|
||||||
(<? (d/<transact! conn [{:db/id 101 :aka ["first" "second"]}]))
|
(<? (d/<transact! conn [{:db/id 101 :aka ["first" "second"]}]))
|
||||||
(is (= (<? (<datoms-after (d/db conn) tx0))
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
@ -557,16 +475,10 @@
|
||||||
(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"
|
||||||
(<? (d/<transact! conn [{:db/id 101 :email ["@1" "@2"]}])))))
|
(<? (d/<transact! conn [{:db/id 101 :email ["@1" "@2"]}])))))))
|
||||||
|
|
||||||
(finally
|
(deftest-db test-explode-maps conn
|
||||||
(<? (d/<close conn)))))))
|
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))]
|
||||||
|
|
||||||
(deftest-async test-explode-maps
|
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))
|
|
||||||
{tx0 :tx} (<? (d/<transact! conn test-schema))]
|
|
||||||
(try
|
|
||||||
(testing "nested maps are accepted"
|
(testing "nested maps are accepted"
|
||||||
(<? (d/<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.
|
||||||
|
@ -590,16 +502,10 @@
|
||||||
(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\}"
|
||||||
(<? (d/<transact! conn [{:db/id 101 :aka {:name "Petr"}}])))))
|
(<? (d/<transact! conn [{:db/id 101 :aka {:name "Petr"}}])))))))
|
||||||
|
|
||||||
(finally
|
(deftest-db test-explode-reverse-refs conn
|
||||||
(<? (d/<close conn)))))))
|
(let [{tx0 :tx} (<? (d/<transact! conn test-schema))]
|
||||||
|
|
||||||
(deftest-async test-explode-reverse-refs
|
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))
|
|
||||||
{tx0 :tx} (<? (d/<transact! conn test-schema))]
|
|
||||||
(try
|
|
||||||
(testing "reverse refs are accepted"
|
(testing "reverse refs are accepted"
|
||||||
(<? (d/<transact! conn [{:db/id 101 :name "Igor"}]))
|
(<? (d/<transact! conn [{:db/id 101 :name "Igor"}]))
|
||||||
(<? (d/<transact! conn [{:db/id 102 :name "Oleg" :_friends 101}]))
|
(<? (d/<transact! conn [{:db/id 102 :name "Oleg" :_friends 101}]))
|
||||||
|
@ -611,11 +517,9 @@
|
||||||
(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\}"
|
||||||
(<? (d/<transact! conn [{:db/id 101 :_aka 102}])))))
|
(<? (d/<transact! conn [{:db/id 101 :_aka 102}])))))))
|
||||||
|
|
||||||
(finally
|
|
||||||
(<? (d/<close conn)))))))
|
|
||||||
|
|
||||||
|
;; We don't use deftest-db in order to be able to re-open an on disk file.
|
||||||
(deftest-async test-next-eid
|
(deftest-async test-next-eid
|
||||||
(with-tempfile [t (tempfile)]
|
(with-tempfile [t (tempfile)]
|
||||||
(let [conn (<? (d/<connect t))
|
(let [conn (<? (d/<connect t))
|
||||||
|
@ -644,10 +548,7 @@
|
||||||
(finally
|
(finally
|
||||||
(<? (d/<close conn))))))))))
|
(<? (d/<close conn))))))))))
|
||||||
|
|
||||||
(deftest-async test-unique-value
|
(deftest-db test-unique-value conn
|
||||||
(with-tempfile [t (tempfile)]
|
|
||||||
(let [conn (<? (d/<connect t))]
|
|
||||||
(try
|
|
||||||
(let [tx0 (:tx (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1)
|
(let [tx0 (:tx (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1)
|
||||||
:db/ident :test/x
|
:db/ident :test/x
|
||||||
:db/unique :db.unique/value
|
:db/unique :db.unique/value
|
||||||
|
@ -671,7 +572,213 @@
|
||||||
(testing "can't upsert a :db.unique/value field"
|
(testing "can't upsert a :db.unique/value field"
|
||||||
(is (thrown-with-msg?
|
(is (thrown-with-msg?
|
||||||
ExceptionInfo #"unique constraint"
|
ExceptionInfo #"unique constraint"
|
||||||
(<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/x 12345 :test/y 99999}]))))))
|
(<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/x 12345 :test/y 99999}])))))))
|
||||||
|
|
||||||
(finally
|
(def retract-schema
|
||||||
(<? (d/<close conn)))))))
|
[{:db/id (d/id-literal :db.part/user -1)
|
||||||
|
:db/ident :test/long
|
||||||
|
:db/cardinality :db.cardinality/many
|
||||||
|
:db/valueType :db.type/long
|
||||||
|
:db.install/_attribute :db.part/db}
|
||||||
|
{:db/id (d/id-literal :db.part/user -2)
|
||||||
|
:db/ident :test/fulltext
|
||||||
|
:db/cardinality :db.cardinality/many
|
||||||
|
:db/valueType :db.type/string
|
||||||
|
:db/fulltext true
|
||||||
|
:db.install/_attribute :db.part/db}
|
||||||
|
{:db/id (d/id-literal :db.part/user -3)
|
||||||
|
:db/ident :test/ref
|
||||||
|
:db/valueType :db.type/ref
|
||||||
|
:db.install/_attribute :db.part/db}])
|
||||||
|
|
||||||
|
(deftest-db test-retract-attribute conn
|
||||||
|
(let [tx0 (:tx (<? (d/<transact! conn retract-schema)))]
|
||||||
|
|
||||||
|
(testing "retractAttribute"
|
||||||
|
(let [report (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/long [12345 123456]}
|
||||||
|
{:db/id (d/id-literal :db.part/user -2) :test/ref (d/id-literal :db.part/user -1)}]))
|
||||||
|
eid1 (get-in report [:tempids (d/id-literal :db.part/user -1)])
|
||||||
|
eid2 (get-in report [:tempids (d/id-literal :db.part/user -2)])]
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{[eid1 :test/long 12345]
|
||||||
|
[eid1 :test/long 123456]
|
||||||
|
[eid2 :test/ref eid1]}))
|
||||||
|
|
||||||
|
(testing "retractAttribute with no matching datoms succeeds"
|
||||||
|
(<? (d/<transact! conn [[:db.fn/retractAttribute eid1 :test/ref]]))
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{[eid1 :test/long 12345]
|
||||||
|
[eid1 :test/long 123456]
|
||||||
|
[eid2 :test/ref eid1]})))
|
||||||
|
|
||||||
|
(testing "retractAttribute retracts datoms"
|
||||||
|
(let [{tx1 :tx} (<? (d/<transact! conn [[:db.fn/retractAttribute eid2 :test/ref]]))]
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{[eid1 :test/long 12345]
|
||||||
|
[eid1 :test/long 123456]})))
|
||||||
|
|
||||||
|
(let [{tx2 :tx} (<? (d/<transact! conn [[:db.fn/retractAttribute eid1 :test/long]]))]
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{}))))))))
|
||||||
|
|
||||||
|
(deftest-db test-retract-attribute-multiple conn
|
||||||
|
(let [tx0 (:tx (<? (d/<transact! conn retract-schema)))]
|
||||||
|
|
||||||
|
(let [report (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/long [12345 123456]}
|
||||||
|
{:db/id (d/id-literal :db.part/user -1) :test/fulltext ["first fulltext value" "second fulltext value"]}]))
|
||||||
|
eid1 (get-in report [:tempids (d/id-literal :db.part/user -1)])]
|
||||||
|
(is (= (<? (<fulltext-values (d/db conn)))
|
||||||
|
[[1 "first fulltext value"]
|
||||||
|
[2 "second fulltext value"]]))
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{[eid1 :test/fulltext 1]
|
||||||
|
[eid1 :test/fulltext 2]
|
||||||
|
[eid1 :test/long 12345]
|
||||||
|
[eid1 :test/long 123456]}))
|
||||||
|
|
||||||
|
(testing "multiple retractAttribute in one transaction"
|
||||||
|
(let [{tx1 :tx} (<? (d/<transact! conn [[:db.fn/retractAttribute eid1 :test/long]
|
||||||
|
[:db.fn/retractAttribute eid1 :test/fulltext]]))]
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{})))))))
|
||||||
|
|
||||||
|
(deftest-db test-retract-attribute-fulltext conn
|
||||||
|
(let [tx0 (:tx (<? (d/<transact! conn retract-schema)))]
|
||||||
|
|
||||||
|
(testing "retractAttribute, fulltext"
|
||||||
|
(let [report (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/fulltext ["first fulltext value" "second fulltext value"]}
|
||||||
|
{:db/id (d/id-literal :db.part/user -2) :test/ref (d/id-literal :db.part/user -1)}]))
|
||||||
|
eid1 (get-in report [:tempids (d/id-literal :db.part/user -1)])
|
||||||
|
eid2 (get-in report [:tempids (d/id-literal :db.part/user -2)])]
|
||||||
|
(is (= (<? (<fulltext-values (d/db conn)))
|
||||||
|
[[1 "first fulltext value"]
|
||||||
|
[2 "second fulltext value"]]))
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{[eid1 :test/fulltext 1]
|
||||||
|
[eid1 :test/fulltext 2]
|
||||||
|
[eid2 :test/ref eid1]}))
|
||||||
|
|
||||||
|
(testing "retractAttribute retracts datoms, fulltext"
|
||||||
|
(let [{tx1 :tx} (<? (d/<transact! conn [[:db.fn/retractAttribute eid2 :test/ref]]))]
|
||||||
|
;; fulltext values are not purged.
|
||||||
|
(is (= (<? (<fulltext-values (d/db conn)))
|
||||||
|
[[1 "first fulltext value"]
|
||||||
|
[2 "second fulltext value"]]))
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{[eid1 :test/fulltext 1]
|
||||||
|
[eid1 :test/fulltext 2]})))
|
||||||
|
|
||||||
|
(let [{tx2 :tx} (<? (d/<transact! conn [[:db.fn/retractAttribute eid1 :test/fulltext]]))]
|
||||||
|
;; fulltext values are not purged.
|
||||||
|
(is (= (<? (<fulltext-values (d/db conn)))
|
||||||
|
[[1 "first fulltext value"]
|
||||||
|
[2 "second fulltext value"]]))
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{}))))))))
|
||||||
|
|
||||||
|
(deftest-db test-retract-entity conn
|
||||||
|
(let [tx0 (:tx (<? (d/<transact! conn retract-schema)))]
|
||||||
|
|
||||||
|
(testing "retractEntity"
|
||||||
|
(let [report (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/long [12345 123456]}
|
||||||
|
{:db/id (d/id-literal :db.part/user -2) :test/ref (d/id-literal :db.part/user -1)}
|
||||||
|
{:db/id (d/id-literal :db.part/user -3) :test/long 0xdeadbeef}]))
|
||||||
|
eid1 (get-in report [:tempids (d/id-literal :db.part/user -1)])
|
||||||
|
eid2 (get-in report [:tempids (d/id-literal :db.part/user -2)])
|
||||||
|
eid3 (get-in report [:tempids (d/id-literal :db.part/user -3)])]
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{[eid1 :test/long 12345]
|
||||||
|
[eid1 :test/long 123456]
|
||||||
|
[eid2 :test/ref eid1]
|
||||||
|
[eid3 :test/long 0xdeadbeef]}))
|
||||||
|
|
||||||
|
(testing "retractEntity with no matching datoms succeeds"
|
||||||
|
(<? (d/<transact! conn [[:db.fn/retractEntity 0xdeadbeef]]))
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{[eid1 :test/long 12345]
|
||||||
|
[eid1 :test/long 123456]
|
||||||
|
[eid2 :test/ref eid1]
|
||||||
|
[eid3 :test/long 0xdeadbeef]})))
|
||||||
|
|
||||||
|
(testing "retractEntity retracts datoms"
|
||||||
|
(let [{tx1 :tx} (<? (d/<transact! conn [[:db.fn/retractEntity eid3]]))]
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{[eid1 :test/long 12345]
|
||||||
|
[eid1 :test/long 123456]
|
||||||
|
[eid2 :test/ref eid1]}))))
|
||||||
|
|
||||||
|
(testing "retractEntity retracts datoms and references"
|
||||||
|
(let [{tx2 :tx} (<? (d/<transact! conn [[:db.fn/retractEntity eid1]]))]
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
;; [eid2 :test/ref eid1] is gone, since the ref eid1 is gone.
|
||||||
|
#{}))))))))
|
||||||
|
|
||||||
|
(deftest-db test-retract-entity-multiple conn
|
||||||
|
(let [tx0 (:tx (<? (d/<transact! conn retract-schema)))]
|
||||||
|
|
||||||
|
(let [report (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/long [12345 123456]}
|
||||||
|
{:db/id (d/id-literal :db.part/user -2) :test/fulltext ["first fulltext value" "second fulltext value"]}]))
|
||||||
|
eid1 (get-in report [:tempids (d/id-literal :db.part/user -1)])
|
||||||
|
eid2 (get-in report [:tempids (d/id-literal :db.part/user -2)])]
|
||||||
|
(is (= (<? (<fulltext-values (d/db conn)))
|
||||||
|
[[1 "first fulltext value"]
|
||||||
|
[2 "second fulltext value"]]))
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{[eid2 :test/fulltext 1]
|
||||||
|
[eid2 :test/fulltext 2]
|
||||||
|
[eid1 :test/long 12345]
|
||||||
|
[eid1 :test/long 123456]}))
|
||||||
|
|
||||||
|
(testing "multiple retractEntity in one transaction"
|
||||||
|
(let [{tx1 :tx} (<? (d/<transact! conn [[:db.fn/retractEntity eid1]
|
||||||
|
[:db.fn/retractEntity eid2]]))]
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{})))))))
|
||||||
|
|
||||||
|
(deftest-db test-retract-entity-fulltext conn
|
||||||
|
(let [tx0 (:tx (<? (d/<transact! conn retract-schema)))]
|
||||||
|
|
||||||
|
(testing "retractEntity, fulltext"
|
||||||
|
(let [report (<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/fulltext ["first fulltext value" "second fulltext value"]}
|
||||||
|
{:db/id (d/id-literal :db.part/user -2) :test/ref (d/id-literal :db.part/user -1)}
|
||||||
|
{:db/id (d/id-literal :db.part/user -3) :test/fulltext "other fulltext value"}]))
|
||||||
|
eid1 (get-in report [:tempids (d/id-literal :db.part/user -1)])
|
||||||
|
eid2 (get-in report [:tempids (d/id-literal :db.part/user -2)])
|
||||||
|
eid3 (get-in report [:tempids (d/id-literal :db.part/user -3)])]
|
||||||
|
(is (= (<? (<fulltext-values (d/db conn)))
|
||||||
|
[[1 "first fulltext value"]
|
||||||
|
[2 "second fulltext value"]
|
||||||
|
[3 "other fulltext value"]]))
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{[eid1 :test/fulltext 1]
|
||||||
|
[eid1 :test/fulltext 2]
|
||||||
|
[eid2 :test/ref eid1]
|
||||||
|
[eid3 :test/fulltext 3]}))
|
||||||
|
|
||||||
|
(testing "retractEntity with no matching datoms succeeds, fulltext"
|
||||||
|
(<? (d/<transact! conn [[:db.fn/retractEntity 0xdeadbeef]]))
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{[eid1 :test/fulltext 1]
|
||||||
|
[eid1 :test/fulltext 2]
|
||||||
|
[eid2 :test/ref eid1]
|
||||||
|
[eid3 :test/fulltext 3]})))
|
||||||
|
|
||||||
|
(testing "retractEntity retracts datoms, fulltext"
|
||||||
|
(let [{tx1 :tx} (<? (d/<transact! conn [[:db.fn/retractEntity eid3]]))]
|
||||||
|
;; fulltext values are not purged.
|
||||||
|
(is (= (<? (<fulltext-values (d/db conn)))
|
||||||
|
[[1 "first fulltext value"]
|
||||||
|
[2 "second fulltext value"]
|
||||||
|
[3 "other fulltext value"]]))
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
#{[eid1 :test/fulltext 1]
|
||||||
|
[eid1 :test/fulltext 2]
|
||||||
|
[eid2 :test/ref eid1]}))))
|
||||||
|
|
||||||
|
(testing "retractEntity retracts datoms and references, fulltext"
|
||||||
|
(let [{tx2 :tx} (<? (d/<transact! conn [[:db.fn/retractEntity eid1]]))]
|
||||||
|
(is (= (<? (<datoms-after (d/db conn) tx0))
|
||||||
|
;; [eid2 :test/ref eid1] is gone, since the ref eid1 is gone.
|
||||||
|
#{}))))))))
|
||||||
|
|
||||||
|
#_ (time (t/run-tests))
|
||||||
|
|
Loading…
Reference in a new issue