more work on initial ion.

2023-03-20 16:40:05 -07:00
parent d32f340cd5
commit bdf237e196
4 changed files with 126 additions and 6 deletions
--- a/src/clj/iol_ion/tx.clj
+++ b/src/clj/iol_ion/tx.clj
@@ -0,0 +1,113 @@
+(ns iol-ion.tx
+  (:require [datomic.client.api :as dc])
+  (:import [java.util UUID]))
+
+(defn random-tempid []
+  (str (UUID/randomUUID)))
+
+(defn by
+  ([f xs]
+   (by f identity xs))
+  ([f fv xs]
+   (reduce
+     #(assoc %1 (f %2) (fv %2))
+     {}
+     xs)))
+
+(defn pull-many [db read ids ]
+  (->> (dc/q '[:find (pull ?e r)
+               :in $ [?e ...] r]
+             db
+             ids
+             read)
+       (map first)))
+
+(declare upsert-entity)
+
+(defn reset-rels [db e a vs]
+  (assert (every? :db/id vs) (format "In order to reset attribute %s, every value must have :db/id" a))
+  (let [ids         (when-not (string? e)
+                      (->> (dc/q '[:find  ?z
+                                   :in    $ ?e ?a
+                                   :where [?e ?a ?z]]
+                                 db e a)
+                           (map first)))
+        new-id-set  (set (map :db/id vs))
+        retract-ids (filter (complement new-id-set) ids)
+        {is-component? :db/isComponent} (dc/pull db [:db/isComponent] a)
+        new-rels      (filter (complement (set ids)) (map :db/id vs))]
+    (-> []
+        (into (map (fn [i] (if is-component?
+                                [:db/retractEntity i]
+                                [:db/retract e a i ])) retract-ids))
+        (into (map (fn [i] [:db/add e a i]) new-rels))
+        (into (mapcat (fn [i] (upsert-entity db i)) vs)))))
+
+(defn reset-scalars [db e a vs]
+  
+  (let [extant   (when-not (string? e)
+                   (->> (dc/q '[:find  ?z
+                                :in    $ ?e ?a
+                                :where [?e ?a ?z]]
+                              db e a)
+                        (map first)))
+        retracts (filter (complement (set vs)) extant)
+        new      (filter (complement (set extant)) vs)]
+    (-> []
+        (into (map (fn [i] [:db/retract e a i ]) retracts))
+        (into (map (fn [i] [:db/add e a i]) new)))))
+
+
+;; TODO unit test this
+(defn upsert-entity [db entity]
+  (assert (:db/id entity) "Cannot upsert without :db/id")
+  (let [e             (:db/id entity)
+        is-new?       (string? e)
+        extant-entity (when-not is-new?
+                        (dc/pull db (keys entity) (:db/id entity)))
+        ident->value-type (by :db/ident (comp :db/ident
+                                              :db/valueType)
+                              (pull-many
+                                db
+                                [:db/valueType :db/ident]
+                                (keys entity)))
+        ops           (->> entity
+                           (reduce
+                             (fn [ops [a v]]
+                               (cond
+                                 (= :db/id a)
+                                 ops
+
+                                 (or (= v (a extant-entity))
+                                     (= v (:db/ident (a extant-entity) :nope))
+                                     (= v (:db/id (a extant-entity)) :nope))
+                                 ops
+                                 
+                                 (and (nil? v)
+                                      (not (nil? (a extant-entity))))
+                                 (conj ops [:db/retract e a (cond-> (a extant-entity)
+                                                              (:db/id (a extant-entity)) :db/id)])
+
+                                 (nil? v)
+                                 ops
+
+                                 ;; reset relationships if it's refs, and not a lookup (i.e., seq of maps, or empty seq)
+                                 (and (sequential? v) (= :db.type/ref (ident->value-type a)) (every? map? v))
+                                 (into ops (reset-rels db e a v))
+
+                                 (and (sequential? v) (not= :db.type/ref (ident->value-type a)))
+                                 (into ops (reset-scalars db e a v))
+
+                                 (and (map? v)
+                                      (= :db.type/ref (ident->value-type a)))
+                                 (let [id (or (:db/id v) (random-tempid))]
+                                   (-> ops
+                                       (conj [:db/add e a id])
+                                       (into (upsert-entity db (assoc v :db/id id)))))
+
+                                 :else
+                                 (conj ops [:db/add e a v])
+                                 ))
+                             []))]
+    ops))
+