From bdf237e1962243324e2cd6aa7d8a8acff969bcef Mon Sep 17 00:00:00 2001
From: Bryce Covert <bryce@brycecovertoperations.com>
Date: Mon, 20 Mar 2023 16:40:05 -0700
Subject: [PATCH] more work on initial ion.

---
 .gitignore                       |   2 +
 deps.edn                         |   8 ++-
 resources/datomic/ion-config.edn |   9 ++-
 src/clj/iol_ion/tx.clj           | 113 +++++++++++++++++++++++++++++++
 4 files changed, 126 insertions(+), 6 deletions(-)
 create mode 100644 src/clj/iol_ion/tx.clj

diff --git a/.gitignore b/.gitignore
index c239061c..a77ae86f 100644
--- a/.gitignore
+++ b/.gitignore
@@ -27,3 +27,5 @@ node_modules
 *.~undo-tree~
 backups
 terraform/.gitx
+.cpcache
+.datomic-ions
diff --git a/deps.edn b/deps.edn
index aa7725e1..57fa0d04 100644
--- a/deps.edn
+++ b/deps.edn
@@ -1 +1,7 @@
-{:paths ["src" "resources"]}
+{:paths ["src" "resources"]
+ :deps {com.cognitect/anomalies {:mvn/version "0.1.12"}
+        com.datomic/client-cloud {:mvn/version "1.0.122"}
+        com.datomic/ion {:mvn/version "1.0.62"}
+        org.clojure/clojure {:mvn/version "1.10.1"}
+        org.clojure/data.json {:mvn/version "0.2.6"}}
+ :mvn/repos {"datomic-cloud" {:url "s3://datomic-releases-1fc2183a/maven/releases"}}}
diff --git a/resources/datomic/ion-config.edn b/resources/datomic/ion-config.edn
index 42ead8f7..edd6559e 100644
--- a/resources/datomic/ion-config.edn
+++ b/resources/datomic/ion-config.edn
@@ -1,5 +1,4 @@
-{:xforms [dump-edn/codify]
- :allow [auto-ap.datomic/upsert-entity
-         auto-ap.datomic/reset-scalars
-         auto-ap.datomic/reset-rels]
- :app-name "integreat-ion"}
+{ :allow [iol-ion/upsert-entity
+         iol-ion/reset-scalars
+         iol-ion/reset-rels] 
+ :app-name "iol-cloud"}
diff --git a/src/clj/iol_ion/tx.clj b/src/clj/iol_ion/tx.clj
new file mode 100644
index 00000000..d075f8b5
--- /dev/null
+++ 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))
+