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

Implement ident renaming. Fixes #103.

Browse source
This commit is contained in:
Richard Newman 2016-10-19 19:31:40 -07:00
parent a08dc13480
commit 9d81abace5
6 changed files with 170 additions and 63 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

83
src/common/datomish/db.cljc
View file

@ -133,8 +133,8 @@
"Apply entities to the store, returning sequence of datoms transacted.")
(<apply-db-ident-assertions
[db added-idents merge]
"Apply added idents to the store, using `merge` as a `merge-with` function.")
[db added-idents retracted-idents]
"Apply added and retracted idents to the store, using `merge` as a `merge-with` function for additions.")
(<apply-db-install-assertions
[db fragment merge]
@ -715,17 +715,78 @@
pairs))))))
(assoc db :part-map part-map)))
(<apply-db-ident-assertions [db added-idents merge]
(<apply-db-ident-assertions [db added-idents retracted-idents]
(go-pair
(let [exec (partial s/execute! (:sqlite-connection db))]
;; TODO: batch insert.
(doseq [[ident entid] added-idents]
(<? (exec
["INSERT INTO idents VALUES (?, ?)" (sqlite-schema/->SQLite ident) entid]))))
(if (and (empty? added-idents)
(empty? retracted-idents))
db
(let [db (update db :ident-map #(merge-with merge % added-idents))
db (update db :ident-map #(merge-with merge % (clojure.set/map-invert added-idents)))]
db)))
;; We have a bunch of additions and a bunch of retractions.
;; Some of these will pair up, indicating a rename.
;;
;; We flip the incoming maps to get eid->ident, then we find
;; the renames, pure additions, and pure retractions.
;;
;; We delete the retracted idents, insert the added idents,
;; and update the renames.
;;
;; Finally, we update the :ident-map and :symbolic-schema
;; accordingly.
(let [inverted-additions (clojure.set/map-invert added-idents)
inverted-retractions (clojure.set/map-invert retracted-idents)
renamed-eids (clojure.set/intersection (set (keys inverted-retractions))
(set (keys inverted-additions)))
pure-additions (apply dissoc inverted-additions renamed-eids)
pure-retractions (apply dissoc inverted-retractions renamed-eids)]
(let [exec (partial s/execute! (:sqlite-connection db))]
;; We're about to delete then recreate an ident.
;; That might violate foreign key constraints, so we defer constraint
;; checking for the duration of this transaction.
(when-not (empty? renamed-eids)
(<? (exec ["PRAGMA defer_foreign_keys = 1"])))
;; TODO: batch insert and delete.
(doseq [[entid ident] pure-retractions]
(when-not (contains? renamed-eids entid)
(<? (exec
["DELETE FROM idents WHERE ident = ? AND entid = ?" (sqlite-schema/->SQLite ident) entid]))))
(doseq [[entid ident] pure-additions]
(when-not (contains? renamed-eids entid)
(<? (exec
["INSERT INTO idents VALUES (?, ?)" (sqlite-schema/->SQLite ident) entid]))))
;; Renames.
(let [renames
(into (sorted-map)
(map (fn [eid] [(get inverted-retractions eid)
(get inverted-additions eid)])
renamed-eids))]
(doseq [[from to] renames]
(let [from (sqlite-schema/->SQLite from)
to (sqlite-schema/->SQLite to)]
(<? (exec ["UPDATE schema SET ident = ? WHERE ident = ?"
to from]))
(<? (exec ["UPDATE idents SET ident = ? WHERE ident = ?"
to from]))))
(-> db
;; Remove retractions -- eid and ident -- from the ident map.
(util/dissoc-from :ident-map (concat (vals pure-retractions)
(keys pure-retractions)))
;; Remove idents from the schema.
(util/dissoc-from :symbolic-schema (vals pure-retractions))
;; Rename renamed attributes in the schema.
(update :symbolic-schema clojure.set/rename-keys renames)
;; Remove old idents (and, coincidentally, 'from' idents for renames).
(update :ident-map (fn [m] (apply dissoc m (keys renames))))
;; Add new ones, and the results of renames.
(update :ident-map (fn [m] (merge m added-idents)))
(update :ident-map (fn [m] (merge m (clojure.set/map-invert added-idents)))))))))))
(<apply-db-install-assertions [db fragment merge]
(go-pair

8
src/common/datomish/db_factory.cljc
View file

@ -87,11 +87,7 @@
bootstrapped? (<? (db/<bootstrapped? db))]
(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)
(let [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))]
@ -115,7 +111,7 @@
;; 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)
(transact/<with-internal (bootstrap/tx-data) fail-alter-attr)
(<?))))
;; We just bootstrapped, or we are returning to an already bootstrapped DB.

28
src/common/datomish/transact.cljc
View file

@ -81,6 +81,7 @@
part-map ;; Map {:db.part/user {:start 0x10000 :idx 0x10000}, ...}.
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.
retracted-idents ;; The map of idents -> entid removed during the transaction.
added-attributes ;; The map of schema attributes (ident -> schema fragment) added during the transaction, via :db.part/db :db.install/attribute.
])
@ -641,7 +642,7 @@
(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."
Collect :db/ident assertions into :added-idents and :retracted-idents here."
[db report]
{:pre [(db/db? db) (report? report)]}
@ -656,17 +657,14 @@
(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
(recur (assoc-in report [(if (:added ia)
:added-idents
:retracted-idents)
ident] (:e ia)) ias)
(raise "Cannot add or retract a :db/ident with a non-keyword value, got " ia
{:error :schema/idents
:op ia }))))))))
@ -690,7 +688,7 @@
(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]
(defn <with-internal [db tx-data merge-attr]
(go-pair
(let [part-map-atom
(atom (db/part-map db))
@ -714,6 +712,7 @@
:tempids {}
:added-parts {}
:added-idents {}
:retracted-idents {}
:added-attributes {}
})
@ -734,7 +733,8 @@
(<?)
(->> (p :apply-db-part-changes))
(db/<apply-db-ident-assertions (:added-idents report) merge-ident)
(db/<apply-db-ident-assertions (:added-idents report)
(:retracted-idents report))
(<?)
(->> (p :apply-db-ident-assertions))
@ -746,11 +746,9 @@
(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
(let [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)))
(<with-internal db tx-data fail-touch-attr)))
(defn <db-with [db tx-data]
(go-pair

6
src/common/datomish/util.cljc
View file

@ -62,6 +62,12 @@
[fn-kw x]
(keyword (str "%" (name fn-kw) "." (name x))))
(defn dissoc-from
"Given a map `m` and a key `k`, find the sub-map named by `k`
and remove all of its keys in `vs`."
[m k vs]
(assoc m k (apply dissoc (get m k) vs)))
(defn concat-in
{:static true}
[m [k & ks] vs]

23
test/datomish/db_test.cljc
View file

@ -306,29 +306,6 @@
(is (= (tempids report)
{-1 101}))))))
(deftest-db test-add-ident conn
(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]]))
eid (get-in report [:tempids (d/id-literal :db.part/db -1)])]
(is (= eid (d/entid (d/db conn) :test/ident)))
(is (= :test/ident (d/ident (d/db conn) eid))))
;; TODO: This should fail, but doesn't, due to stringification of :test/ident.
;; (is (thrown-with-msg?
;; ExceptionInfo #"Retracting a :db/ident is not yet supported, got "
;; (<? (d/<transact! conn [[:db/retract 44 :db/ident :test/ident]]))))
;; ;; Renaming looks like retraction and then assertion.
;; (is (thrown-with-msg?
;; ExceptionInfo #"Retracting a :db/ident is not yet supported, got"
;; (<? (d/<transact! conn [[:db/add 44 :db/ident :other-name]]))))
;; (is (thrown-with-msg?
;; ExceptionInfo #"Re-asserting a :db/ident is not yet supported, got"
;; (<? (d/<transact! conn [[:db/add 55 :db/ident :test/ident]]))))
)
(deftest-db test-add-schema conn
(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)

85
test/datomish/schema_changes_test.cljc
View file

@ -9,21 +9,22 @@
[datomish.node-tempfile-macros :refer [with-tempfile]]
[cljs.core.async.macros :as a :refer [go]]))
(:require
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
[datomish.sqlite :as s]
[datomish.api :as d]
[datomish.datom :refer [datom]]
[datomish.schema-changes :refer [datoms->schema-fragment]]
[datomish.sqlite :as s]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
[datomish.db :as dm]
#?@(:clj [[datomish.pair-chan :refer [go-pair <?]]
#?@(:clj [[datomish.jdbc-sqlite]
[datomish.pair-chan :refer [go-pair <?]]
[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.core.async :refer [go <! >!]]])
#?@(:cljs [[datomish.pair-chan]
[datomish.test-macros :refer-macros [deftest-async]]
#?@(:cljs [[datomish.js-sqlite]
[datomish.pair-chan]
[datomish.test-macros :refer-macros [deftest-async deftest-db]]
[datomish.node-tempfile :refer [tempfile]]
[cljs.test :as t :refer-macros [is are deftest testing async]]
[cljs.core.async :as a :refer [<! >!]]]))
@ -86,3 +87,71 @@
[1 :db/valueType :db.value/string]]
(map ->datom)
(datoms->schema-fragment)))))))
(deftest-db test-add-and-change-ident conn
;; Passes through on failure.
(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]]))
eid (get-in report [:tempids (d/id-literal :db.part/db -1)])]
(is (= eid (d/entid (d/db conn) :test/ident)))
(is (= :test/ident (d/ident (d/db conn) eid)))
(testing "idents can be reasserted."
(<? (d/<transact! conn [[:db/add eid :db/ident :test/ident]])))
(testing "idents can't be reused while they're still active."
(is (thrown-with-msg?
ExceptionInfo #"Transaction violates unique constraint"
(<? (d/<transact! conn [[:db/add 5555 :db/ident :test/ident]])))))
(testing "idents can be changed."
;; You can change an entity's ident.
(<? (d/<transact! conn [[:db/add eid :db/ident :test/anotherident]]))
(is (= eid (d/entid (d/db conn) :test/anotherident)))
(is (= :test/anotherident (d/ident (d/db conn) eid)))
(is (not (= eid (d/entid (d/db conn) :test/ident))))
;; Passes through on failure.
(is (= :test/ident (d/entid (d/db conn) :test/ident))))
(testing "Once freed up, an ident can be reused."
(<? (d/<transact! conn [[:db/add 5555 :db/ident :test/ident]]))
(is (= 5555 (d/entid (d/db conn) :test/ident))))))
(deftest-db test-change-schema-ident conn
;; If an ident names an attribute, and is altered, then that attribute has
;; changed in the schema.
(let [tempid (d/id-literal :db.part/db -1)
es [[:db/add :db.part/db :db.install/attribute tempid]
{:db/id tempid
:db/ident :test/someattr
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one}]
report (<? (d/<transact! conn es))
db-after (:db-after report)
eid (get-in report [:tempids tempid])]
(testing "New ident is allocated"
(is (some? (d/entid db-after :test/someattr))))
(testing "Schema is modified"
(is (= (get-in db-after [:symbolic-schema :test/someattr])
{:db/valueType :db.type/string,
:db/cardinality :db.cardinality/one})))
(is (= eid (d/entid (d/db conn) :test/someattr)))
(testing "schema idents can be altered."
(let [report (<? (d/<transact! conn [{:db/id eid
:db/ident :test/otherattr}]))
db-after (:db-after report)]
(is (= eid (d/entid (d/db conn) :test/otherattr)))
;; Passes through on failure.
(is (keyword? (d/entid (d/db conn) :test/someattr)))
(is (nil? (get-in db-after [:symbolic-schema :test/someattr])))
(is (= (get-in db-after [:symbolic-schema :test/otherattr])
{:db/valueType :db.type/string,
:db/cardinality :db.cardinality/one}))))))