diff --git a/src/common/datomish/db.cljc b/src/common/datomish/db.cljc index 4f894c3d..dcdf290c 100644 --- a/src/common/datomish/db.cljc +++ b/src/common/datomish/db.cljc @@ -140,6 +140,9 @@ [db fragment merge] "Apply added schema fragment to the store, using `merge` as a `merge-with` function.") + (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)))) + (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 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 (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 diff --git a/src/common/datomish/schema.cljc b/src/common/datomish/schema.cljc index 664a34b6..1ae3967e 100644 --- a/src/common/datomish/schema.cljc +++ b/src/common/datomish/schema.cljc @@ -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 diff --git a/src/common/datomish/transact.cljc b/src/common/datomish/transact.cljc index 7fb970b2..47047441 100644 --- a/src/common/datomish/transact.cljc +++ b/src/common/datomish/transact.cljc @@ -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 db @@ -740,7 +781,12 @@ (db/> (p :apply-db-install-assertions))) + (->> (p :apply-db-install-assertions)) + + (db/> (p :apply-db-alter-assertions)) + ) ] (-> report (assoc-in [:db-after] db-after))))) diff --git a/test/datomish/schema_changes_test.cljc b/test/datomish/schema_changes_test.cljc index bfdd51e5..7cfeccbc 100644 --- a/test/datomish/schema_changes_test.cljc +++ b/test/datomish/schema_changes_test.cljc @@ -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 (