Add :db.fn/retractAttribute and :db.fn/retractEntity. Fixes #46.
There's no distinction made for fulltext attributes, since the values found by the retractAttributes SELECT are already rowids into the fulltext_values table and therefore need no additional mapping.
This commit is contained in:
Nick Alexander
parent
94bac9704b
commit
362bdb2028
|
|
@ -172,15 +172,64 @@
|
|||
:table-alias source/gensym-table-alias
|
||||
: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]
|
||||
(let
|
||||
[f-q
|
||||
"WITH vv AS (SELECT rowid FROM fulltext_values WHERE text = ?)
|
||||
[f-q
|
||||
"WITH vv AS (SELECT rowid FROM fulltext_values WHERE text = ?)
|
||||
INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, sv, svalue_type_tag)
|
||||
VALUES (?, ?, (SELECT rowid FROM vv), ?, 0, ?, (SELECT rowid FROM vv), ?)"
|
||||
|
||||
non-f-q
|
||||
"INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, sv, svalue_type_tag)
|
||||
non-f-q
|
||||
"INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, sv, svalue_type_tag)
|
||||
VALUES (?, ?, ?, ?, 0, ?, ?, ?)"]
|
||||
(map
|
||||
(fn [[_ e a v]]
|
||||
|
|
@ -394,7 +443,7 @@
|
|||
SELECT e, a, v, ?, 0, value_type_tag
|
||||
FROM tx_lookup
|
||||
WHERE added0 IS 2 AND ((sv IS NOT NULL) OR (sv IS NULL AND v0 IS NOT v)) AND v IS NOT NULL" tx] ;; TODO: get rid of magic value 2.
|
||||
]
|
||||
]
|
||||
(go-pair
|
||||
(doseq [q [build-indices insert-into-tx-lookup
|
||||
t-datoms-not-already-present
|
||||
|
|
@ -431,9 +480,12 @@
|
|||
queries (atom [])
|
||||
operations (group-by first entities)]
|
||||
|
||||
(when-not (clojure.set/subset? (keys operations) #{:db/retract :db/add})
|
||||
(raise (str "Unknown operations " (keys operations))
|
||||
{:error :transact/syntax, :operations (dissoc operations :db/retract :db/add)}))
|
||||
;; Belt and braces. At this point, we should have already errored out if op is not known.
|
||||
(let [known #{:db/retract :db/add :db.fn/retractAttribute :db.fn/retractEntity}]
|
||||
(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.
|
||||
;; 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
|
||||
;; 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)]
|
||||
(swap!
|
||||
queries concat (retractions->queries retractions tx fulltext? ->SQLite)))
|
||||
|
|
|
|||
|
|
@ -119,12 +119,13 @@
|
|||
entity))
|
||||
|
||||
(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)
|
||||
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
|
||||
(db/entid db v))]
|
||||
(when-not (integer? a)
|
||||
(when (and a (not (integer? a)))
|
||||
(raise "Unknown attribute " a
|
||||
{:form orig :attribute a}))
|
||||
[op e a v tx]))
|
||||
|
|
@ -138,34 +139,63 @@
|
|||
;; n.b., this must not be symbolic -- it's inserted after we map idents -> entids.
|
||||
[:db/add tx (db/entid db :db/txInstant) txInstant]))
|
||||
|
||||
(defn ensure-entity-form [[op e a v & rest :as entity]]
|
||||
(cond
|
||||
(not (sequential? entity))
|
||||
(defn ensure-entity-form [entity]
|
||||
(when-not (sequential? entity)
|
||||
(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)
|
||||
(raise "Bad entity: nil e in " entity
|
||||
{:error :transact/bad-entity :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? 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 })
|
||||
|
||||
(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 })))
|
||||
|
||||
(some? rest)
|
||||
(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 })
|
||||
|
||||
true
|
||||
entity))
|
||||
(nil? a)
|
||||
(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 & _]]
|
||||
(and (= op :db/add)
|
||||
|
|
@ -373,7 +403,8 @@
|
|||
(go-pair
|
||||
(let [schema (db/schema db)]
|
||||
(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))
|
||||
|
||||
(defn <transact-tx-data
|
||||
|
|
|
|||
|
|
@ -574,4 +574,211 @@
|
|||
ExceptionInfo #"unique constraint"
|
||||
(<? (d/<transact! conn [{:db/id (d/id-literal :db.part/user -1) :test/x 12345 :test/y 99999}])))))))
|
||||
|
||||
(def retract-schema
|
||||
[{: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