Add Auto-Migrate to VMS

README.org

@@ -268,6 +268,72 @@ Then visit [[http://localhost:8000/browse][localhost:8000/browse]]
 bb restore --file <datomic-2024-##-##.dump>
 #+end_src
 
+* Development
+
+** Polylith CLI
+
+The Polylith CLI is available via the =:poly= alias. Run it with:
+
+#+begin_src sh
+clojure -M:poly <command>
+#+end_src
+
+Common commands:
+
+#+begin_src sh
+# Show workspace overview
+clojure -M:poly info
+
+# Show which bricks have changed since last stable point
+clojure -M:poly diff
+
+# Check for dependency issues and circular references
+clojure -M:poly check
+
+# List all libraries and their versions
+clojure -M:poly libs
+
+# Show dependencies between bricks
+clojure -M:poly deps
+#+end_src
+
+See the [[https://cljdoc.org/d/polylith/clj-poly/CURRENT/doc/commands][Polylith documentation]] for the full list of commands.
+
+** Testing
+
+*** Run all tests
+
+#+begin_src sh
+bb test
+#+end_src
+
+This runs =cognitect.test-runner= with the =:dev:test= aliases, which includes
+test paths for all components and bases.
+
+*** Run tests for a single component
+
+#+begin_src sh
+bb test-component schema_migrate
+#+end_src
+
+*** Run tests directly with Clojure CLI
+
+#+begin_src sh
+# All tests
+clojure -M:dev:test -m cognitect.test-runner
+
+# Specific test directory
+clojure -M:dev:test -m cognitect.test-runner -d components/schema_migrate/test
+#+end_src
+
+** Migrations
+
+Migrations live in =development/migrations/=. See the [[file:development/migrations/README.org][Migrations README]] for
+details on how to create and run migrations.
+
+Migrations are automatically applied at startup. Old migrations are marked with
+=^{:migrate/ignore? true}= on their namespace and are skipped by the runner.
+
 * Behave-Lib
 
 The "behave-lib" directory includes the build process for generating a WASM file using c++ code from

components/schema_migrate/src/schema_migrate/interface.clj

@@ -1,5 +1,6 @@
 (ns schema-migrate.interface
-  (:require [schema-migrate.core :as c]))
+  (:require [schema-migrate.core   :as c]
+            [schema-migrate.runner :as r]))
 
 (def ^{:arglists '([conn attr nname])
        :doc      "Get the :bp/uuid using the name for the specified name attribute"}
@@ -141,3 +142,9 @@
 (def ^{:arglists '([s])
        :doc      "add behaveplus: to `s`"}
   bp c/bp)
+
+(def ^{:arglists '([conn dir])
+       :doc      "Run all pending migrations found in `dir`. Skips namespaces
+                  with `^{:migrate/ignore? true}` metadata and migrations
+                  already recorded via `:bp/migration-id`. Halts on failure."}
+  run-pending-migrations! r/run-pending-migrations!)

components/schema_migrate/src/schema_migrate/runner.clj

@@ -0,0 +1,139 @@
+(ns schema-migrate.runner
+  (:require
+   [clojure.java.io :as io]
+   [clojure.string  :as str]
+   [datomic.api     :as d]
+   [datomic-store.main :as ds]
+   [schema-migrate.core :as core]))
+
+(defn migration-applied?
+  "Check if a migration has already been applied."
+  [conn migration-id]
+  (some? (d/q '[:find ?e .
+                :in $ ?id
+                :where [?e :bp/migration-id ?id]]
+              (d/db conn) migration-id)))
+
+(defn- clj-file? [^java.io.File f]
+  (and (.isFile f)
+       (.endsWith (.getName f) ".clj")
+       (not (.startsWith (.getName f) "#"))
+       (not (.startsWith (.getName f) "."))))
+
+(defn- file->ns-sym [^java.io.File f]
+  (-> (.getName f)
+      (str/replace #"\.clj$" "")
+      (str/replace "_" "-")
+      (->> (str "migrations."))
+      symbol))
+
+(defn- read-ns-form
+  "Read the first form from `file` without evaluating it. Returns nil on
+   any read failure."
+  [^java.io.File file]
+  (try
+    (with-open [r (java.io.PushbackReader. (io/reader file))]
+      (binding [*read-eval* false]
+        (read r)))
+    (catch Exception _ nil)))
+
+(defn- ns-ignored?
+  "True when the file's `ns` form carries `:migrate/ignore? true` metadata,
+   either as `^{…}` on the ns symbol or as an attr-map after an optional
+   docstring. Reads only the first form — does not `require` the namespace."
+  [^java.io.File file]
+  (let [form (read-ns-form file)]
+    (boolean
+     (and (seq? form)
+          (= 'ns (first form))
+          (let [symbol-meta (meta (second form))
+                attr-map    (->> (drop 2 form)
+                                 (drop-while string?)
+                                 first)]
+            (or (:migrate/ignore? symbol-meta)
+                (and (map? attr-map)
+                     (:migrate/ignore? attr-map))))))))
+
+(defn discover-migrations
+  "Find all migration namespaces in `dir`.
+   Returns them sorted by name.
+   Skips the template and namespaces with `^{:migrate/ignore? true}`.
+
+   The ignore check reads only each file's `ns` form, so top-level side
+   effects in ignored migrations never fire.
+
+   Each migration must export one of:
+   - `payload-fn`    — a function of `conn` returning transaction data
+   - `payload`       — a def containing transaction data
+   - `payload-steps` — a vector of functions or payloads, executed in order"
+  [dir]
+  (->> (io/file dir)
+       (.listFiles)
+       (filter clj-file?)
+       (remove ns-ignored?)
+       (sort-by #(.getName ^java.io.File %))
+       (keep (fn [^java.io.File f]
+               (let [ns-sym (file->ns-sym f)]
+                 (when-not (= ns-sym 'migrations.template)
+                   ;; load-file so migrations work from any directory,
+                   ;; not just those on the classpath
+                   (load-file (.getAbsolutePath f))
+                   {:id          (name ns-sym)
+                    :ns-sym      ns-sym
+                    :payload-var (or (ns-resolve ns-sym 'payload-fn)
+                                     (ns-resolve ns-sym 'payload))
+                    :steps-var   (ns-resolve ns-sym 'payload-steps)}))))
+       vec))
+
+(defn- resolve-payload
+  "Resolve a payload value — call it if it's a function, otherwise return as-is."
+  [p conn]
+  (if (fn? p) (p conn) p))
+
+(defn- run-single-step!
+  "Transact a single payload with a migration marker. Returns the tx result."
+  [conn payload marker]
+  (ds/transact conn (concat payload [marker])))
+
+(defn- run-multi-step!
+  "Transact each step in order. If any step fails, roll back all
+   previously completed steps in reverse order, then re-throw."
+  [conn steps marker]
+  (let [completed (atom [])]
+    (try
+      (doseq [step steps]
+        (let [payload (resolve-payload step conn)
+              tx-result (ds/transact conn payload)]
+          (swap! completed conj tx-result)))
+      ;; All steps succeeded — record the migration marker
+      (ds/transact conn [marker])
+      (catch Exception e
+        ;; Roll back completed steps in reverse order
+        (doseq [tx-result (reverse @completed)]
+          (try
+            (core/rollback-tx! conn tx-result)
+            (catch Exception rollback-ex
+              (println "  WARNING: rollback failed:" (.getMessage rollback-ex)))))
+        (throw e)))))
+
+(defn run-pending-migrations!
+  "Run all pending migrations in order. Halts on failure.
+   Multi-step migrations are rolled back if any step fails."
+  [conn dir]
+  (let [migrations (discover-migrations dir)]
+    (doseq [{:keys [id payload-var steps-var]} migrations]
+      (cond
+        (migration-applied? conn id)
+        nil
+
+        (and (nil? payload-var) (nil? steps-var))
+        (println "Skipping" id "— no payload-fn, payload, or payload-steps defined")
+
+        :else
+        (do (println "Running migration:" id)
+            (let [marker (core/->migration id)]
+              (if steps-var
+                (run-multi-step! conn @steps-var marker)
+                (let [payload (resolve-payload @payload-var conn)]
+                  (run-single-step! conn payload marker))))
+            (println "  Applied:" id))))))