Implement ident renaming. Fixes #103.

src/common/datomish/db.cljc

@@ -133,8 +133,8 @@
     "Apply entities to the store, returning sequence of datoms transacted.")
 
   (<apply-db-ident-assertions
-    [db added-idents merge]
+    [db added-idents retracted-idents]
-    "Apply added idents to the store, using `merge` as a `merge-with` function.")
+    "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))]
+      (if (and (empty? added-idents)
-        ;; TODO: batch insert.
+               (empty? retracted-idents))
-        (doseq [[ident entid] added-idents]
+        db
-          (<? (exec
-                ["INSERT INTO idents VALUES (?, ?)" (sqlite-schema/->SQLite ident) entid]))))
 
-      (let [db (update db :ident-map #(merge-with merge % added-idents))
+        ;; We have a bunch of additions and a bunch of retractions.
-            db (update db :ident-map #(merge-with merge % (clojure.set/map-invert added-idents)))]
+        ;; Some of these will pair up, indicating a rename.
-        db)))
+        ;;
+        ;; 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

src/common/datomish/db_factory.cljc

@@ -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)
+        (let [fail-alter-attr  (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)
                                                (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.

src/common/datomish/transact.cljc

@@ -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)
+              (recur (assoc-in report [(if (:added ia)
-              (raise "Cannot assert a :db/ident with a non-keyword value, got " 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
+  (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-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
                                               {: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

src/common/datomish/util.cljc

@@ -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]

test/datomish/db_test.cljc

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

test/datomish/schema_changes_test.cljc

@@ -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.api :as d]
-   [datomish.sqlite :as s]
-
    [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]
+   #?@(:cljs [[datomish.js-sqlite]
-              [datomish.test-macros :refer-macros [deftest-async]]
+              [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}))))))