Implement schema alteration. Fixes #78.

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.

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.")
 
+  (<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

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

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

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 (<? (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)))))))