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

Implement schema alteration. Fixes #78.

Browse source 
Altering uniqueness and cardinality attributes works, with the exception
of enabling uniqueness from nothing.

:db/noHistory and :db/isComponent changes are implemented but untested,
and aren't really supported by Datomish anyway.
This commit is contained in:
Richard Newman 2016-10-21 08:40:20 -07:00
parent 46269fe720
commit 9d361055d3
4 changed files with 322 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -140,6 +140,9 @@
[db fragment merge]
"Apply added schema fragment to the store, using `merge` as a `merge-with` function.")
(<apply-db-alter-assertions
[db altered-attributes])
(<apply-db-part-map
[db part-map]
"Apply updated partition map."))
@ -595,6 +598,9 @@
;; We index on tx, so the following is fast.
["SELECT * FROM transactions WHERE tx = ?" tx])))))))
(defn symbolic-schema->schema [db symbolic-schema]
(ds/schema (into {} (map (fn [[k v]] [(entid db k) v]) symbolic-schema))))
(defrecord DB [sqlite-connection schema ident-map part-map]
;; ident-map maps between keyword idents and integer entids. The set of idents and entids is
;; disjoint, so we represent both directions of the mapping in the same map for simplicity. Also
@ -807,11 +813,163 @@
v tag]))))))
(let [symbolic-schema (merge-with merge (:symbolic-schema db) fragment)
schema (ds/schema (into {} (map (fn [[k v]] [(entid db k) v]) symbolic-schema)))]
schema (symbolic-schema->schema db symbolic-schema)]
(assoc db
:symbolic-schema symbolic-schema
:schema schema))))
(<apply-db-alter-assertions [db altered-attributes]
;; altered-attributes is a sequence of [e a v].
;; Note that the 'e' is the attribute being altered, and the 'a's
;; are the attribute's attributes!
(if (empty? altered-attributes)
(go-pair db)
(let [schema (.-schema db)
exec (partial s/execute! (:sqlite-connection db))
run (partial s/all-rows (:sqlite-connection db))
update-schema
(fn [v ent attr]
["UPDATE schema SET value = ? WHERE ident = ? AND attr = ?"
v
(sqlite-schema/->SQLite ent)
(sqlite-schema/->SQLite attr)])
alter-eav
(fn [{:keys [checks statements symbolic-schema :as acc]} [e a v]]
(let [ent (ident db e)
attr (ident db a)
new (if (= (ds/valueType schema a) :db.type/ref)
(ident db v)
(ds/<-SQLite schema a v))
old (get-in symbolic-schema [ent attr])
datoms-table (if (ds/fulltext? schema e)
"fulltext_datoms"
"datoms")]
;; Future:
;; :db/index => set index_avet.
;; Change valueType to ref => set index_vaet.
;; Add fulltext => set index_fulltext.
(if (= old new)
acc
(case attr
(:db/noHistory :db/isComponent)
;; These values are booleans and don't affect the DB.
{:checks checks
:statements
(conj statements (update-schema v ent attr))
:symbolic-schema
(assoc-in symbolic-schema [ent attr] (== 1 new))}
:db/cardinality
(cond
(and (= old :db.cardinality/one)
(= new :db.cardinality/many))
;; See the comment in <apply-db-install-assertions for how we're
;; passing through idents as strings here.
;; Note that we're also assuming that all values for a given schema
;; attribute have the same type tag.
{:checks checks
:statements
(conj statements (update-schema v ent attr))
:symbolic-schema
(assoc-in symbolic-schema [ent attr] new)}
(and (= old :db.cardinality/many)
(= new :db.cardinality/one))
;; There is no SQLite consistency constraint that requires a single
;; value for a given (e, a) pair. So when we convert a multi-valued
;; attribute to a single-valued (cardinality one) attribute, we need
;; to run a query.
;; We collect these in 'checks', and see if they return any results
;; before we change any data.
{:checks
(conj checks
;; In this context we're looking for two datoms which
;; share an entity, both have the right attribute ('e',
;; which is a little confusing), but aren't the same row.
[[ent :db/cardinality]
[(str "SELECT EXISTS(SELECT y.v FROM "
datoms-table " x, "
datoms-table " y WHERE x.e = y.e AND x.a = ? AND y.a = ? AND x.rowid < y.rowid) AS yes") e e]])
:statements
(conj statements (update-schema v ent attr))
:symbolic-schema
(assoc-in symbolic-schema [ent attr] new)}
:else
(raise "Unknown cardinality" new {:error :transact/bad-cardinality :value new}))
:db/unique
(cond
(nil? new)
{:checks checks
:statements
(conj statements
[(str "UPDATE " datoms-table
" SET unique_value = 0 WHERE a = ?") attr]
(update-schema v ent attr))
:symbolic-schema
(update-in symbolic-schema [ent] dissoc attr)}
(or
(and (= old :db.unique/identity)
(= new :db.unique/value))
(and (= old :db.unique/value)
(= new :db.unique/identity)))
{:checks checks
:statements
(conj statements (update-schema v ent attr))
:symbolic-schema
(assoc-in symbolic-schema [ent attr] new)}
;; TODO: enabling uniqueness => set unique_value = 1,
;; with checks.
:else
(raise "Unknown or unsupported uniqueness constraint" new {:error :transact/bad-unique :value new}))
:else
(raise "Unsupported attribute to alter" attr {:error :transact/bad-alter-attribute :attr attr})))))
{:keys [checks statements symbolic-schema]}
(reduce alter-eav
{:checks []
:statements []
:symbolic-schema (:symbolic-schema db)}
altered-attributes)]
(go-pair
(doseq [[[ent prop] check] checks]
(let [r (<? (run check))]
(when (= 1 (:yes (first r)))
(raise "Can't alter " prop " for attribute " ent ": data not suitable."
{:entity ent
:property prop
:query check}))))
(doseq [statement statements]
(<? (exec statement)))
;; We need to rebuild the entid-based schema, then reverse that into
;; the reverse schema, so that operations like `multival?` work.
;; This is simpler than updating all three schema parts in place, but
;; more expensive.
;;
;; TODO: refactor some of this out so we can make rschema private again.
(let [non-symbolic (symbolic-schema->schema db symbolic-schema)
rschema (ds/rschema non-symbolic)]
(assoc db
:symbolic-schema symbolic-schema
:schema non-symbolic
:rschema rschema))))))
(close-db [db] (s/close (.-sqlite-connection db)))
IClock

2
src/common/datomish/schema.cljc
View file

@ -89,7 +89,7 @@
(update-in acc [k] (fnil conj e) v))
{} m))
(defn- rschema [schema]
(defn rschema [schema]
(->>
(for [[a kv] schema
[k v] kv

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

@ -83,6 +83,7 @@
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.
altered-attributes ;; TODO
])
(defn- report? [x]
@ -687,6 +688,41 @@
schema-fragment (datomish.schema-changes/datoms->schema-fragment datoms)]
(assoc-in report [:added-attributes] schema-fragment)))
(defn collect-db-alter-assertions
"Transactions may alter existing attributes."
[db report]
{:pre [(db/db? db) (report? report)]}
;; We walk the tx-data once to find any altered attributes.
;; We walk it again to collect the new properties of those
;; attributes.
(let [tx-data (:tx-data report)
;; This is what we're looking for.
alter-attribute (db/entid db :db.alter/attribute)
altered-attributes (reduce (fn [acc [_ a v & _]]
(if (= a alter-attribute)
(conj acc v)
acc))
#{}
tx-data)]
(if (empty? altered-attributes)
report
(assoc report
:altered-attributes
(reduce
(fn [acc [e a v _ added? :as datom]]
;; We ignore the retraction of the old value.
;; We already have it in our in-memory schema!
(if (and added?
(contains? altered-attributes e))
(conj acc [e a v])
acc))
[]
tx-data)))))
;; TODO: expose this in a more appropriate way.
(defn <with-internal [db tx-data merge-attr]
(go-pair
@ -714,6 +750,7 @@
:added-idents {}
:retracted-idents {}
:added-attributes {}
:altered-attributes {}
})
(<transact-tx-data db)
@ -724,7 +761,11 @@
(p :collect-db-ident-assertions)
(collect-db-install-assertions db)
(p :collect-db-install-assertions))
(p :collect-db-install-assertions)
(collect-db-alter-assertions db)
(p :collect-db-alter-assertions)
)
db-after (->
db
@ -740,7 +781,12 @@
(db/<apply-db-install-assertions (:added-attributes report) merge-attr)
(<?)
(->> (p :apply-db-install-assertions)))
(->> (p :apply-db-install-assertions))
(db/<apply-db-alter-assertions (:altered-attributes report))
(<?)
(->> (p :apply-db-alter-assertions))
)
]
(-> report
(assoc-in [:db-after] db-after)))))

114
test/datomish/schema_changes_test.cljc
View file

@ -12,6 +12,7 @@
[datomish.api :as d]
[datomish.datom :refer [datom]]
[datomish.schema-changes :refer [datoms->schema-fragment]]
[datomish.schema :as ds]
[datomish.sqlite :as s]
[datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise cond-let]]
@ -155,3 +156,116 @@
(is (= (get-in db-after [:symbolic-schema :test/otherattr])
{:db/valueType :db.type/string,
:db/cardinality :db.cardinality/one}))))))
(deftest-db test-alter-schema-cardinality-one-to-many conn
(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/attr
:db/valueType :db.type/long
:db/cardinality :db.cardinality/one}]
report (<? (d/<transact! conn es))
db-after (:db-after report)
eid (get-in report [:tempids tempid])]
(is (= (get-in db-after [:symbolic-schema :test/attr :db/cardinality])
:db.cardinality/one))
;; Add two values for the property. Observe that only one is preserved.
(<? (d/<transact! conn [{:db/id 12345 :test/attr 111}]))
(<? (d/<transact! conn [{:db/id 12345 :test/attr 222}]))
(is (= [222]
(<? (d/<q (d/db conn)
'[:find [?a ...] :in $ :where [12345 :test/attr ?a]]))))
;; Change it to a multi-valued property.
(let [report (<? (d/<transact! conn [{:db/id eid
:db/cardinality :db.cardinality/many
:db.alter/_attribute :db.part/db}]))
db-after (:db-after report)]
(is (= eid (d/entid (d/db conn) :test/attr)))
(is (= (get-in db-after [:symbolic-schema :test/attr :db/cardinality])
:db.cardinality/many))
(is (ds/multival? (.-schema (d/db conn)) eid))
(is (= [222]
(<? (d/<q (d/db conn)
'[:find [?a ...] :in $ :where [12345 :test/attr ?a]]))))
(<? (d/<transact! conn [{:db/id 12345 :test/attr 333}]))
(is (= [222 333]
(<? (d/<q (d/db conn)
'[:find [?a ...] :in $ :where [12345 :test/attr ?a]]
{:order-by [[:a :asc]]})))))))
(deftest-db test-alter-schema-cardinality-many-to-one conn
(let [prop-a (d/id-literal :db.part/db -1)
prop-b (d/id-literal :db.part/db -2)
prop-c (d/id-literal :db.part/db -3)
es [[:db/add :db.part/db :db.install/attribute prop-a]
[:db/add :db.part/db :db.install/attribute prop-b]
[:db/add :db.part/db :db.install/attribute prop-c]
{:db/id prop-a
:db/ident :test/attra
:db/valueType :db.type/long
:db/cardinality :db.cardinality/many}
{:db/id prop-b
:db/ident :test/attrb
:db/valueType :db.type/string
:db/fulltext true
:db/cardinality :db.cardinality/many}
{:db/id prop-c
:db/ident :test/attrc
:db/valueType :db.type/long
:db/cardinality :db.cardinality/many}]
report (<? (d/<transact! conn es))
db-after (:db-after report)
e-a (get-in report [:tempids prop-a])
e-b (get-in report [:tempids prop-b])
e-c (get-in report [:tempids prop-c])]
(is (= (get-in db-after [:symbolic-schema :test/attra :db/cardinality])
:db.cardinality/many))
(is (= (get-in db-after [:symbolic-schema :test/attrb :db/cardinality])
:db.cardinality/many))
;; Add two values for one property, one for another, and none for the last.
;; Observe that only all are preserved.
(<? (d/<transact! conn [{:db/id 12345 :test/attrb "foobar"}]))
(<? (d/<transact! conn [{:db/id 12345 :test/attrc 222}]))
(<? (d/<transact! conn [{:db/id 12345 :test/attrc 333}]))
(is (= []
(<? (d/<q (d/db conn)
'[:find [?a ...] :in $ :where [12345 :test/attra ?a]]))))
(is (= ["foobar"]
(<? (d/<q (d/db conn)
'[:find [?b ...] :in $ :where [12345 :test/attrb ?b]]))))
(is (= [222 333]
(<? (d/<q (d/db conn)
'[:find [?c ...] :in $ :where [12345 :test/attrc ?c]]))))
;; Change each to a single-valued property.
;; 'a' and 'b' should succeed, because they match the new cardinality
;; constraint. 'c' should fail, because it already has two values for 12345.
(let [change
(fn [eid attr]
(go-pair
(let [report (<? (d/<transact!
conn
[{:db/id eid
:db/cardinality :db.cardinality/one
:db.alter/_attribute :db.part/db}]))
db-after (:db-after report)]
(is (= eid (d/entid (d/db conn) attr)))
(is (= (get-in db-after [:symbolic-schema attr :db/cardinality])
:db.cardinality/one))
(is (not (ds/multival? (.-schema (d/db conn)) eid))))))]
(<? (change e-a :test/attra))
(<? (change e-b :test/attrb))
(is (thrown-with-msg?
ExceptionInfo #"Can't alter :db/cardinality"
(<? (change e-c :test/attrc)))))))