diff --git a/src/datomish/db.cljc b/src/datomish/db.cljc index 806660db..dfb73703 100644 --- a/src/datomish/db.cljc +++ b/src/datomish/db.cljc @@ -16,6 +16,7 @@ [datomish.datom :as dd :refer [datom datom? #?@(:cljs [Datom])]] [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]] [datomish.schema :as ds] + [datomish.schema-changes] [datomish.sqlite :as s] [datomish.sqlite-schema :as sqlite-schema] #?@(:clj [[datomish.pair-chan :refer [go-pair DB {:sqlite-connection sqlite-connection :idents idents - :schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) (merge schema default-schema)))) + :symbolic-schema symbolic-schema + :schema (ds/schema (into {} (map (fn [[k v]] [(k idents) v]) symbolic-schema))) :current-tx tx0}))))) (defn connection-with-db [db] @@ -628,14 +661,15 @@ (defn- is-ident? [db [_ a & _]] (= a (get-in db [:idents :db/ident]))) -(defn process-db-idents +(defn process-db-ident-assertions "Transactions may add idents, install new partitions, and install new schema attributes. Handle :db/ident assertions here." - [db tx-data] - {:pre [(db? db)]} + [db report] + {:pre [(db? db) (report? report)]} ;; TODO: use q to filter the report! (let [original-db db + tx-data (:tx-data report) original-ident-assertions (filter (partial is-ident? db) tx-data)] (loop [db original-db ident-assertions original-ident-assertions] @@ -663,6 +697,37 @@ {:error :schema/idents :op ia })))))))) +(defn- symbolicate-datom [db [e a v tx added]] + (let [entids (zipmap (vals (idents db)) (keys (idents db))) + symbolicate (fn [x] + (get entids x x))] + (datom + (symbolicate e) + (symbolicate a) + (symbolicate v) + (symbolicate tx) + added))) + +(defn process-db-install-assertions + "Transactions may add idents, install new partitions, and install new schema attributes. + Handle [:db.part/db :db.install/attribute] assertions here." + [db report] + {:pre [(db? db) (report? report)]} + + ;; TODO: be more efficient; symbolicating each datom is expensive! + (let [datoms (map (partial symbolicate-datom db) (:tx-data report)) + schema-fragment (datomish.schema-changes/datoms->schema-fragment datoms) + fail (fn [old new] (raise "Altering schema elements is not yet supported, got " new " altering existing schema element " old + {:error :schema/alter-schema :old old :new new}))] + + (if (empty? schema-fragment) + db + (let [symbolic-schema (merge-with fail (:symbolic-schema db) schema-fragment) + schema (ds/schema (into {} (map (fn [[k v]] [(k (idents db)) v]) symbolic-schema)))] + (assoc db + :symbolic-schema symbolic-schema + :schema schema))))) + (defn report (assoc-in [:db-after] db-after))))) diff --git a/src/datomish/schema_changes.cljc b/src/datomish/schema_changes.cljc new file mode 100644 index 00000000..a9fa76ec --- /dev/null +++ b/src/datomish/schema_changes.cljc @@ -0,0 +1,60 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. + +(ns datomish.schema-changes + (:require + [datomish.util :as util #?(:cljs :refer-macros :clj :refer) [raise raise-str cond-let]])) + +(defn- is-install? [db [_ a & _]] + (= a (get-in db [:idents :db.install/attribute]))) + +(defn datoms->schema-fragment + "Turn [[:db.part/db :db.install/attribute e] [e :db/ident :attr]] into {:attr {:db/* v}}. + + From http://docs.datomic.com/schema.html, :db/ident, :db/valueType, + and :db/cardinality are required. For us, enforce that valueType and + cardinality are present at schema validation time. + + This code is not pretty, so here's what it does: + + Input: a sequence of datoms, like [e :keyword-attr v _ added]. + 1. Select [:db.part/db :db.install/attribute ... ]. + 2. Fail if any are not (= added true) + 3. For each [ :db.part/db :db.install/attribute e ], collect {e {:db/* v}}. + 4. Map e -> ident; fail if not possible. + 5. Return the map, with ident keys. + + This would be more pleasant with `q` and pull expressions." + + [datoms] + {:pre [(sequential? datoms)]} + + (let [db-install? (fn [datom] + (= [:db.part/db :db.install/attribute] ((juxt :e :a) datom))) + db-installs (filter db-install? datoms)] + (if (empty? db-installs) + {} + (if-let [retracted (first (filter (comp not :added) db-installs))] + (raise "Retracting a :db.install/attribute is not yet supported, got " retracted + {:error :schema/db-install :op retracted}) + (let [by-e (group-by :e datoms) + + ;; TODO: pull entity from database, rather than expecting entire attribute to be in single transaction. + installed-es (select-keys by-e (map :v db-installs)) + ;; select-keys ignores missing keys. We don't want that. + installed-es (merge (into {} (map (juxt :v (constantly {})) db-installs)) installed-es) + + db-*? (fn [datom] + (= "db" (namespace (:a datom))))] + + ;; Just the :db/* attribute-value pairs. + (into {} (for [[e datoms] installed-es] + (let [->av (juxt :a :v) + ;; TODO: transduce! + db-avs (into {} (map ->av (filter db-*? datoms)))] + ;; TODO: get ident from existing datom, to allow [:db.part/db :db.install/attribute existing-id]. + (if-let [ident (:db/ident db-avs)] + [ident db-avs] + (raise ":db.install/attribute requires :db/ident, got " db-avs " for " e + {:error :schema/db-install :op db-avs})))))))))) diff --git a/test/datomish/db_test.cljc b/test/datomish/db_test.cljc index 7ad7c1f2..1ae5e69c 100644 --- a/test/datomish/db_test.cljc +++ b/test/datomish/db_test.cljc @@ -196,35 +196,6 @@ (finally (schema-fragment]] + + [datomish.db :as dm] + #?@(:clj [[datomish.pair-chan :refer [go-pair !]]]) + #?@(:cljs [[datomish.pair-chan] + [datomish.test-macros :refer-macros [deftest-async]] + [datomish.node-tempfile :refer [tempfile]] + [cljs.test :as t :refer-macros [is are deftest testing async]] + [cljs.core.async :as a :refer [!]]])) + #?(:clj + (:import [clojure.lang ExceptionInfo])) + #?(:clj + (:import [datascript.db DB]))) + +#?(:cljs + (def Throwable js/Error)) + +(deftest test-datoms->schema-fragment + (let [tx 10101 + ->datom (fn [xs] + (apply datom (conj xs tx)))] + (are [i o] + (= (datoms->schema-fragment (map ->datom i)) + o) + ;; Base case. + [] + {} + + ;; No matches. + [[0 :not-db/add :not-db/install]] + {} + + ;; Interesting case. + [[:db.part/db :db.install/attribute 1] + [:db.part/db :db.install/attribute 2] + [1 :db/ident :test/attr1] + [1 :db/valueType :db.value/string] + [1 :db/cardinalty :db.cardinality/one] + [1 :db/unique :db.unique/identity] + [2 :db/ident :test/attr2] + [2 :db/valueType :db.value/integer] + [2 :db/cardinalty :db.cardinality/many]] + {:test/attr1 + {:db/ident :test/attr1 + :db/valueType :db.value/string + :db/cardinalty :db.cardinality/one + :db/unique :db.unique/identity} + :test/attr2 + {:db/ident :test/attr2 + :db/valueType :db.value/integer + :db/cardinalty :db.cardinality/many}}) + + ;; :db/ident, :db/valueType, and :db/cardinality are required. valueType and cardinality are + ;; enforced at the schema level. + (testing "Fails without entity" + (is (thrown-with-msg? + ExceptionInfo #":db.install/attribute requires :db/ident, got \{\} for 1" + (->> + [[:db.part/db :db.install/attribute 1]] + (map ->datom) + (datoms->schema-fragment))))) + + (testing "Fails without :db/ident" + (is (thrown-with-msg? + ExceptionInfo #":db.install/attribute requires :db/ident, got \{:db/valueType :db.value/string\} for 1" + (->> + [[:db.part/db :db.install/attribute 1] + [1 :db/valueType :db.value/string]] + (map ->datom) + (datoms->schema-fragment)))))))