Introduce migrations so we can clean up locations more easily

resources/co/gaiwan/compass/system.edn

@@ -3,4 +3,5 @@
                   :dynamic? #config :dynamic-routes?}
  :compass/router {:dynamic? #config :dynamic-routes?}
  :compass/db     {:url #config :datomic/url}
- :tito/sync      {:interval-seconds #config :tito/sync-interval-seconds}}
+ :tito/sync      {:db #ig/ref :compass/db
+                  :interval-seconds #config :tito/sync-interval-seconds}}

resources/public/css/styles.css

@@ -395,12 +395,13 @@ body {
   background-position: 50% 50%;
 }
 
-.profiles-profile_detail .profiles-image_frame {
+.profiles-attendee_card .profiles-image_frame {
   width: 100px;
 }
 
-.profiles-attendee_card .profiles-image_frame {
+.profiles-profile_detail .profiles-image_frame {
   width: 100px;
+  --profiles-arc-thickness: 7%;
 }
 
 .profiles-profile_form label, .profiles-profile_form input {

src/co/gaiwan/compass/db.clj

@@ -1,25 +1,27 @@
 (ns co.gaiwan.compass.db
   (:require
    [clojure.walk :as walk]
-   [co.gaiwan.compass.db.data :as data]
+   [co.gaiwan.compass.db.migrations :as migrations]
    [co.gaiwan.compass.db.schema :as schema]
    [datomic.api :as d]
    [integrant.core :as ig]
    [integrant.repl.state :as state]
    [io.pedestal.log :as log]
+   [lambdaisland.wagontrain :as wagontrain]
    [potemkin.collections :as po-coll]))
 
 (declare transact)
 
 (def event-time-zone (java.time.ZoneId/of "Europe/Brussels"))
 
+(declare munge-to-db)
+
 (defmethod ig/init-key :compass/db [_ {:keys [url]}]
   (d/create-database url)
   (let [conn (d/connect url)]
-    @(transact conn (schema/schema-tx))
-    @(transact conn (data/locations))
-    @(transact conn (data/session-types))
-    @(transact conn (data/schedule))
+    @(transact conn (concat (schema/schema-tx)
+                            wagontrain/schema))
+    (wagontrain/migrate! conn (munge-to-db migrations/all))
     conn))
 
 (defmethod ig/halt-key! :compass/db [_ conn])
@@ -40,7 +42,7 @@
   (meta [this] (meta e))
   (with-meta [this m] (->munged-entity (with-meta e m))))
 
-(defn munge-to-db [value]
+(defn munge-1-to-db [value]
   (cond
     (instance? java.time.Instant value)
     (java.util.Date/from value)
@@ -51,7 +53,12 @@
     :else
     value))
 
-(defn munge-from-db [value]
+(defn munge-to-db [value]
+  (if (coll? value)
+    (walk/postwalk munge-1-to-db value)
+    value))
+
+(defn munge-1-from-db [value]
   (cond
     (instance? java.util.Date value)
     (java.time.ZonedDateTime/ofInstant
@@ -64,18 +71,23 @@
     :else
     value))
 
+(defn munge-from-db [value]
+  (if (coll? value)
+    (walk/postwalk munge-1-from-db value)
+    value))
+
 (defn pull [selector id]
-  (walk/postwalk munge-from-db (d/pull (db) selector id)))
+  (munge-from-db (d/pull (db) selector id)))
 
 (defn transact
   ([tx-data]
    (transact (conn) tx-data))
   ([conn tx-data]
    (log/trace :datomic/transacting tx-data)
-   (d/transact conn (walk/postwalk munge-to-db tx-data))))
+   (d/transact conn (munge-to-db tx-data))))
 
 (defn q [& args]
-  (walk/postwalk munge-from-db (apply d/q args)))
+  (munge-from-db (apply d/q args)))
 
 (defn entity [lookup]
   (when-let [e (d/entity (db) lookup)]

src/co/gaiwan/compass/db/migrations.clj

@@ -0,0 +1,13 @@
+(ns co.gaiwan.compass.db.migrations
+  (:require [co.gaiwan.compass.db.data :as data]))
+
+(def all
+  [{:label :add-locations
+    :tx-data (data/locations)}
+
+   {:label :add-session-types
+    :tx-data (data/session-types)}
+
+   {:label :add-initial-schedule
+    :tx-data (data/schedule)}
+   ])

src/lambdaisland/wagontrain.clj

@@ -0,0 +1,72 @@
+(ns lambdaisland.wagontrain
+  (:require
+   [datomic.api :as d]))
+
+(def schema
+  [{:db/ident       :wagontrain.tx/label,
+    :db/valueType   :db.type/keyword,
+    :db/doc         "Label identifiying the transaction, so it only gets applied once."
+    :db/cardinality :db.cardinality/one}
+   {:db/ident       :wagontrain.tx/direction,
+    :db/valueType   :db.type/keyword,
+    :db/doc         "Is this an up or a down migration?",
+    :db/cardinality :db.cardinality/one}
+   {:db/ident       :wagontrain.tx/reverses,
+    :db/valueType   :db.type/ref,
+    :db/doc         "Reference to a past transaction that this migration reverses",
+    :db/cardinality :db.cardinality/one}
+   {:db/ident       :wagontrain.tx/reversed-by,
+    :db/valueType   :db.type/ref,
+    :db/doc         "Reference to a future transaction that reverses this transaction.",
+    :db/cardinality :db.cardinality/one}])
+
+(defn up-tx [label tx-data]
+  (into
+   [{:db/id "datomic.tx"
+     :wagontrain.tx/direction :up
+     :wagontrain.tx/label label}]
+   tx-data))
+
+(defn down-tx [label up-tx-id tx-data]
+  (into
+   [{:db/id "datomic.tx"
+     :wagontrain.tx/direction :down
+     :wagontrain.tx/label label
+     :wagontrain.tx/reverses up-tx-id}
+    {:db/id up-tx-id
+     :wagontrain.tx/reversed-by "datomic.tx"}]
+   tx-data))
+
+(defn up-tx-id [conn label]
+  (d/q '[:find ?tx .
+         :in $ ?label
+         :where
+         [?tx :wagontrain.tx/label ?label]
+         [?tx :wagontrain.tx/direction :up]
+         (not [?tx :wagontrain.tx/reversed-by])]
+       (d/db conn)
+       label))
+
+(defn applied? [conn label]
+  (boolean (up-tx-id conn label)))
+
+(defn migrate1
+  [conn {:keys [label tx-data]}]
+  @(d/transact conn (up-tx label tx-data)))
+
+(defn migrate! [conn migrations]
+  (run! (partial migrate1 conn) migrations))
+
+(defn rollback!
+  [conn label]
+  (let [tx-id (up-tx-id conn label)]
+    (if-not tx-id
+      (throw (ex-info {:label label} "Migration not found"))
+      (let [datoms (seq (:data (first (d/tx-range (d/log conn) tx-id nil))))]
+        @(d/transact
+          conn
+          (down-tx
+           label
+           tx-id
+           (for [[e a v t add?] (remove #(= tx-id (.e ^datomic.Datom %)) datoms)]
+             [(if add? :db/retract :db/add) e a v])))))))