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

Add :db.fn/retractAttribute and :db.fn/retractEntity. Fixes #46. r=rnewman

Browse source
This commit is contained in:
Nick Alexander 2016-09-06 13:13:30 -07:00
parent 8e8dd21164 362bdb2028
commit 562ced372d
5 changed files with 736 additions and 548 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

76
src/datomish/db.cljc
View file

@ -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)))

1
src/datomish/db_factory.cljc
View file

@ -97,7 +97,6 @@
new))]
(let [exec (partial s/execute! (:sqlite-connection db))
part->vector (fn [[part {:keys [start idx]}]]
(println "part->vector" part start idx)
[(sqlite-schema/->SQLite part) start idx])]
;; TODO: allow inserting new parts.
;; TODO: think more carefully about allocating new parts and bitmasking part ranges.

21
src/datomish/test_macros.cljc
View file

@ -5,8 +5,7 @@
(ns datomish.test-macros
#?(:cljs
(:require-macros
[datomish.test-macros]
[datomish.node-tempfile-macros]))
[datomish.test-macros]))
(:require
[datomish.pair-chan]))
@ -44,16 +43,8 @@
(defmacro deftest-db
[n conn-var & body]
`(deftest-async ~n
(if-cljs
(datomish.node-tempfile-macros/with-tempfile [t# (datomish.node-tempfile/tempfile)]
(let [~conn-var (datomish.pair-chan/<? (datomish.api/<connect t#))]
(try
~@body
(finally
(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)))))))))
(let [~conn-var (datomish.pair-chan/<? (datomish.api/<connect ""))]
(try
~@body
(finally
(datomish.pair-chan/<? (datomish.api/<close ~conn-var)))))))

79
src/datomish/transact.cljc
View file

@ -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

1107
test/datomish/db_test.cljc
View file

File diff suppressed because it is too large Load diff