From 103a86f440144e337c02d19e5581552d49cced6f Mon Sep 17 00:00:00 2001
From: Richard Newman <rnewman@twinql.com>
Date: Fri, 18 Nov 2016 15:27:42 -0800
Subject: [PATCH] Add a :none migration for schema management. Fixes #113.
 r=grisha

This allows for code to run before and after a schema fragment is
added for the first time.

The anticipated use for this is twofold:

1. To do initial setup, e.g., defining global entities.
2. To 'adopt' unmanaged attributes already defined in the store.

This 'pre' would manually alter or retract attributes so that the
transact of the new schema datoms can complete.

For example, if properties :foo/bar and :foo/baz will be unchanged,
but :noo/zob needs to change from a string to an integer, the :none
pre-function can alter the ident, and the :none post-function can
migrate and clean up.
---
 src/common/datomish/schema_management.cljc | 43 ++++++++++--------
 test/datomish/schema_management_test.cljc  | 52 ++++++++++++++++++++++
 2 files changed, 77 insertions(+), 18 deletions(-)

diff --git a/src/common/datomish/schema_management.cljc b/src/common/datomish/schema_management.cljc
index 3a57597d..4ad779bb 100644
--- a/src/common/datomish/schema_management.cljc
+++ b/src/common/datomish/schema_management.cljc
@@ -183,29 +183,36 @@
     [body
      (mapcat
        (fn [{:keys [name version attributes] :as fragment}]
-         (if-let [existing-version (get schema-fragment-versions name)]
-           ;; It's a change.
-           ;; Spit out any pre/post for this fragment, with a
-           ;; transact of the datoms to effect the change and
-           ;; bump the schema fragment version in the middle.
+         (let [existing-version (get schema-fragment-versions name)
+
+               datoms
+               [[:transact
+                 (if existing-version
+                   ;; It's a change.
+                   ;; Transact the datoms to effect the change and
+                   ;; bump the schema fragment version.
+                   (changed-schema-fragment->datoms
+                     (d/entid db name)
+                     symbolic-schema
+                     name
+                     attributes
+                     version)
+
+                   ;; It's new! Just do it.
+                   (managed-schema-fragment->datoms fragment))]]]
+
+           ;; We optionally allow you to provide a `:none` migration here, which
+           ;; is useful in the case where a vocabulary might have been added
+           ;; outside of the schema management system.
            (concat
              (when-let [fragment-pre-for-this
-                        (get-in fragment-pre [name existing-version])]
+                        (get-in fragment-pre [name (or existing-version :none)])]
                [[:call fragment-pre-for-this]])
-             [[:transact
-               (changed-schema-fragment->datoms (d/entid db name)
-                                                symbolic-schema
-                                                name
-                                                attributes
-                                                version)]]
+             datoms
              (when-let [fragment-post-for-this
-                        (get-in fragment-post [name existing-version])]
-               [[:call fragment-post-for-this]]))
+                        (get-in fragment-post [name (or existing-version :none)])]
+               [[:call fragment-post-for-this]]))))
 
-           ;; It's new! Just do it.
-           ;; There can't be any fragment pre/post, 'cos there's no previous
-           ;; version to come from.
-           [[:transact (managed-schema-fragment->datoms fragment)]]))
        fragments)]
 
     (concat
diff --git a/test/datomish/schema_management_test.cljc b/test/datomish/schema_management_test.cljc
index c9a95dac..dbf5b26b 100644
--- a/test/datomish/schema_management_test.cljc
+++ b/test/datomish/schema_management_test.cljc
@@ -342,6 +342,58 @@
                     :bar/noo :com.example.bar}
                    (<? (sm/<collect-schema-fragment-attributes db))))))))))
 
+(deftest-db test-none-migration conn
+  (testing "A fragment that's never existed in the DB triggers :none pre and post."
+    (let [db (atom (d/db conn))
+
+          v1-fragment
+          {:name :com.example.foo
+           :version 1
+           :attributes
+           {:foo/bar
+            {:db/valueType :db.type/long
+             :db/cardinality :db.cardinality/many}}}
+
+          fail-called (atom nil)
+          pre-called (atom nil)
+          post-called (atom nil)
+
+          v1-migration
+          {:fragments [v1-fragment]
+           :fragment-pre {:com.example.foo
+                          {:none (fn [db _]
+                                   (reset! pre-called true)
+                                   nil)
+                           1 (fn [db _]
+                               (reset! fail-called true)
+                               nil)}}
+           :fragment-post {:com.example.foo
+                           {:none (fn [db _]
+                                    (reset! post-called true)
+                                    nil)
+                            1 (fn [db _]
+                                (reset! fail-called true)
+                                nil)}}}]
+
+      (is (empty? (<? (sm/<collect-schema-fragment-versions @db))))
+
+      ;; Apply the v1 schema.
+      (reset!
+        db
+        (:db-after
+           (<? (sm/<apply-schema-alteration
+                 conn
+                 v1-migration))))
+
+      (is @pre-called)
+      (is @post-called)
+      (is (not @fail-called))
+
+      (is (= {:com.example.foo 1}
+             (<? (sm/<collect-schema-fragment-versions @db))))
+      (is (= {:foo/bar :com.example.foo}
+             (<? (sm/<collect-schema-fragment-attributes @db)))))))
+
 (deftest-db test-functions-can-do-work conn
   (let
     [;; Use an atom to keep this long test fairly flat.