kc datomic util

datomic_util.cljc

(ns kc.datomic
  "Datomic utility functions

  Usage Notes:

  Some functions in this namespace take sequences of facts and return them modified in some way. Some up-front modifications are useful for those functions, like replacing all map-form facts with vector-form facts. In order to avoid doing these modifications repeatedly to same the same set of facts (which would be harmless but wasteful), two versions of these functions exist: a \"safe\" version that does those up-front modifications, and an \"unsafe\" version that expects those modifications to already have been performed. The unsafe versions are named like the safe ones, but with a single quote appended.

  TODO:
  - consider implementing all fns that branch based on operation as multimethods
    These fns mostly support :db/add, :db/retract :db.fn/retractEntity, :db.fn/cas,
    but it would be nice if that set were open."
  (:refer-clojure :exclude [clone ancestors descendants exists?])
  (:require [clojure.set :as set]
            [clojure.string :as string]
            [clojure.walk :as walk]
            [kc.util :as util]
            #?(:clj [datomic.api :as d]
               :cljs [datascript.core :as d])))

;; -- Connection-management ----------------------------------------------------

#?(:clj (def mem-db-uri-base "datomic:mem://"))

#?(:clj (defn scratch-conn
          "Returns a connection to a new in-memory database."
          []
          (let [uri (str mem-db-uri-base (d/squuid))]
            (d/delete-database uri)
            (d/create-database uri)
            (d/connect uri))))

;; -- Schema-inspecting functions ---------------------------------------------

(defn attr-type
  "Get the :db/valueType of an attribute.
  In datascript, only returns the type for attributes with a specified schema - all other attributes will return nil."
  [db attribute]
  #?(:clj (:value-type (d/attribute db attribute))
     :cljs (some-> db :schema attribute :db/valueType)))

(defn component-attr?
  "Is `attribute` (passed as a keyword or id) :db/isComponent ?"
  [db attribute]
  #?(:clj (:is-component (d/attribute db attribute))
     :cljs (some-> db :schema attribute :db/isComponent)))

(defn ref-attr?
  "Is `attribute` (passed as a keyword or id) of type :db.type/ref ?"
  [db attribute]
  (= :db.type/ref (attr-type db attribute)))

(defn cardinality-many-attr?
  "Is `attribute` (passed as a keyword or id) cardinality-many?"
  [db attribute]
  #?(:cljs (= :db.cardinality/many (some-> db :schema attribute :db/cardinality))
     :clj (= :db.cardinality/many (:cardinality (d/attribute db attribute)))))

(defn ref-non-component-attr?
  "Is `attr` an attribute of type :db.type/ref AND defined as :db/isComponent=true?"
  [db attr]
  (and (ref-attr? db attr)
       (not (component-attr? db attr))))

(defn unique-attr?
  "Returns a boolean indicating whether attribute is :db.unique/value or :db.unique/identity."
  [db attribute]
  #?(:clj (:unique (d/attribute db attribute))
     :cljs (some-> db :schema attribute :db/unique)))

;; -- Query Functions ---------------------------------------------------------

(defn entity-pull
  "Like d/pull, but returns values consistent with d/entity, i.e.,
  entities with :db/ident are represented as keywords and sets are
  used instead of vectors.
  Source: https://gist.github.com/favila/6366516f2bef6b77b07f7349d4ff009e"
  ([db eid]
   (entity-pull db '[*] eid))
  ([db pat eid]
   (->> (d/pull db pat eid)
        (walk/prewalk
         (fn [x]
           (cond
             (and (not (map-entry? x))
                  (vector? x)) (set x)
             (and (map? x) (:db/ident x)) (:db/ident x)
             (and (map? x) (:db/id x)) (or
                                        (:db/ident (d/entity db (:db/id x)))
                                        x)
             :else x))))))

(defn pull-attr
  "Return the value of a single attribute of `e`, using d/pull."
  [db e attr]
  (attr (d/pull db [attr] e)))

(defn entity-attr
  "Return the value of a single attribute of `e`, using d/entity."
  [db e attr]
  (attr (d/entity db e)))

(defn exists?
  "Returns a boolean indicating whether entity w/ id `entity-id` exists in `db`.
  An entity exists if there are any facts about it."
  [db entity-id]
  (some? (seq (d/q '[:find ?e :in $ ?e :where [?e]]
                   db entity-id))))

;; -- Heirarchy-related Query Functions ---------------------------------------

;; In order to optimize the search for parent entities in datascript,
;; we need to know what attrs are ref+component.
#?(:cljs (defn- -schema->ref-component-attrs [schema]
           (into #{}
                 (comp
                  (filter (fn [[_ attr-spec]]
                            (and (:db/isComponent attr-spec)
                                 (= (:db/valueType attr-spec) :db.type/ref))))
                  (map (fn [[attr _]] attr)))
                 schema)))

#?(:cljs (def ^:private schema->ref-component-attrs
           (memoize -schema->ref-component-attrs)))

#?(:cljs (defn- ref-component-attrs [db]
           (schema->ref-component-attrs (:schema db))))

#?(:cljs
   (defn parent-datom
     "Return the datom asserting `e` as a child of its parent.
  You can use this to get the parent id and the attr in one call.
  Example: (let [{parent :e attr :a} (parent-datom db e)])"
     ([db e] (parent-datom db e (ref-component-attrs db)))
     ([db e possible-attrs]
      (let [datoms (mapcat #(d/datoms db :avet % e) possible-attrs)]
        (if-let [d (first datoms)]
          d))))
   :clj
   (defn parent-datom
     "Return the datom asserting `e` as a child of its parent.
  You can use this to get the parent id and the attr in one call.
  Example: (let [{parent :e attr :a} (parent-datom db e)])"
     [db e]
     (if-let [res (d/q '[:find [?parent ?a]
                         :in $ ?e
                         :where
                         [?parent ?attr ?e]
                         [?attr :db/isComponent true]
                         [?attr :db/ident ?a]]
                       db e)]
       (let [[e a] res]
         {:e e :a a}))))

#?(:clj
   (defn parent
     "Get the immediate parent of an entity, returning either the parent's eid or nil."
     [db e]
     (d/q '[:find ?parent .
            :in $ ?e
            :where
            [?parent ?attr ?e]
            [?attr :db/isComponent true]]
          db e))

   ;; Datascript doesn't (yet?) support VAET indexes, which means
   ;; searching for an entity's parent the way we do w/ datomic is slow.
   ;; This solution makes use of AVET indexes instead, which is faster than
   ;; any alternatives I'm aware of.
   :cljs
   (defn parent
     "Get the immediate parent of an entity, returning either the parent's eid or nil.
      `possible-attrs` indicates the set of attrs that might possibly point to this child from the parent. When it is not provided, the set of all ref+component attributes in the db is used."
     ([db e] (parent db e (ref-component-attrs db)))
     ([db e possible-attrs]
      (:e (parent-datom db e possible-attrs)))))

(defn closest-matching-ancestor
  "Given a datomic database, an id, and a function,
  return the first ancestor of the entity with id `id` for which `f` is truthy."
  [db id f]
  (let [ancestor (parent db id)]
    (if ancestor
      (if (f ancestor)
        ancestor
        (closest-matching-ancestor db ancestor f)))))

;; TODO: this fn should be lazy.
#?(:clj
   (defn ancestors
     "Return a sequence of the ancestors of e, ordered from closest (direct parent) to furthest (primordial ooze)"
     [db e]
     (loop [ancestors []
            e e]
       (if-let [parent (parent db e)]
         (recur (conj ancestors parent) parent)
         ancestors)))
   :cljs
   (defn ancestors
     "Return a sequence of the ancestors of e, ordered from closest (direct parent) to furthest (primordial ooze)"
     ([db e] (ancestors db e (ref-component-attrs db)))
     ([db e possible-attrs]
      (loop [ancestors []
             e e]
        (if-let [parent (parent db e possible-attrs)]
          (recur (conj ancestors parent) parent)
          ancestors)))))

(defn ultimate-ancestor
  "Return the ultimate/farthest ancestor of entity w/ :db/id = `id`"
  [db id]
  (let [parent (parent db id)]
    (if parent
      (recur db parent)
      id)))

(defn descendants
  "Find descendants of `id`, optionally limiting to those for which `pred` is truthy."
  ([db id] (descendants db identity id))
  ([db pred id]
   (let [m (entity-pull db '[*] id)
         ids* (atom #{})
         _ (util/postwalk-maps
            (fn [m]
              (when (pred m)
                (swap! ids* conj (:db/id m)))
              m)
            m)]
     (swap! ids* disj id))))

(defn ancestor?
  "Returns a boolean indicating whether maybe-ancestor is an ancestor of maybe-descendant."
  [db maybe-ancestor maybe-descendant]
  (boolean
   (closest-matching-ancestor db maybe-descendant (fn [e] (= e maybe-ancestor)))))

(defn- references-
  "Returns the set of entities referenced (recursively) by entity `id`.
  Entities referenced by `id` or some descendant or referent of `id` that are descendants of another entity referenced by `id` may be included in the result set.
  `exclusions`: a set of attrs to exclude when searching for references
  `found`: a set of already-found references. Avoids needless repeat work + the possibility of infinite recursion."
  [db id exclusions found]
  (let [already-found? (fn [found id] (contains? found id))
        reduce-owned-entity (fn [found {:keys [db/id] :as ent}]
                              (references- db id exclusions found))
        reduce-non-owned-entity (fn [found {:keys [db/id] :as ent}]
                                  ;; References to idents don't count.
                                  (if (or #?(:clj (d/ident db id) :cljs false)
                                          (already-found? found id))
                                    found
                                    ;; This is a legitimate reference to another entity
                                    (conj (references- db id exclusions found)
                                          id)))
        found
        (reduce-kv
         (fn [found attr val]
           (if (and (ref-attr? db attr) (not (contains? exclusions attr)))
             (let [reducer (if (component-attr? db attr)
                             reduce-owned-entity
                             reduce-non-owned-entity)]
               (if (cardinality-many-attr? db attr)
                 (reduce reducer found val)
                 (reducer found val)))
             found))
         ;; add the entity for which we are finding references to the set of
         ;; found references so that we don't search it again if it is
         ;; referenced by some relation.
         (conj found id)
         (d/pull db '[*] id))
        ;; Then pop it out again, since an entity doesn't reference itself.
        found (disj found id)]
    found))

(defn remove-descendants
  "Filter the eids set to only contain those that are not descendants of any others in the set."
  [db eids]
  (reduce
   (fn [new-eids eid]
     (if (some (fn [e] (ancestor? db e eid)) eids)
       new-eids
       (conj new-eids eid)))
   #{}
   eids))

(defn non-recursive-references [db id exclusions]
  (into #{}
        (comp
         (filter (fn [[attr val]]
                   (and (ref-non-component-attr? db attr)
                        (not (contains? exclusions attr)))))
         (mapcat (fn [[attr val]]
                   (if (cardinality-many-attr? db attr)
                     (filter identity
                             (map (fn [x]
                                    (if-let [id (:db/id x)]
                                      id))
                                  val))
                     (if-let [id (:db/id val)]
                       [id])))))
        (d/entity db id)))

(defn references
  "Returns the set of entities referenced (optionally, recursively) by entity `id`.
  Entities referenced by `id` or some descendant or referent of `id` that are descendants of another entity referenced by `id` are not included in the result set unless `descendants` is true.
  Additionally, references to transaction entities are excluded.
  `exclusions`: a set of attrs to exclude when searching for references.
  `recursive`: set to false to make the search only consider direct references from `id`.
  `descendants`: set to true to possibly include descendants in the result set."
  ([db id]
   (references db id #{}))
  ([db id exclusions]
   (references db id exclusions true))
  ([db id exclusions recursive]
   (references db id exclusions recursive false))
  ([db id exclusions recursive descendants]
   (let [refs (if recursive
                (references- db id exclusions #{})
                (non-recursive-references db id exclusions))
         refs (if descendants
                refs
                (remove-descendants db refs))]
     refs)))

;; -- Temp ids -----------------------------------------------------------------

(defn tempid?
  "On jvm, checks whether `id` is a datomic.db.DbId. On js, just checks that it's less than 0."
  [id]
  #?(:cljs (< id 0)
     :clj (instance? datomic.db.DbId id)))

(def ^:redef default-tempid-partition
  "Default partition to use when creating tempids with `tempid`.
  Can rebind with `alter-var-root`; direct linking is disabled for this var."
  :db.part/user)

(def ^:dynamic *tempid*
  "Rebindable tempid-returning function.
  By default, just returns a temp id in the given partition w/ the given index.
  Bound by `with-tempid-generator` to allow the creation of sequential ids."
  (fn
    ([] (d/tempid default-tempid-partition))
    ([n] (d/tempid default-tempid-partition n))
    ([part n] (d/tempid part n))))

(defn tempid-generator
  "Returns a function that can be called repeatedly to generate sequential tempids."
  ([start-num] (tempid-generator start-num default-tempid-partition))
  ([start-num part]
   (let [id-seq (atom (range start-num -1000000 -1))]
     (fn []
       (let [n (first @id-seq)]
         (swap! id-seq next)
         (d/tempid part n))))))

(defmacro with-tempid-generator
  "Evaluate `body` with `*tempid* bound to a `tempid-generator` function starting at `n` and with partition `default-tempid-partition`"
  [n & body]
  `(binding [*tempid* (tempid-generator ~n)]
     ~@body))

(defmacro with-partitioned-tempid-generator
  "Evaluate `body` with `tempid` bound to a `tempid-generator` function starting at `n` and with partition `partition`."
  [n partition & body]
  `(binding [*tempid* (tempid-generator ~n ~partition)]
     ~@body))

;; -- Transaction helpers -----------------------------------------------------

(defn map->facts
  "Given a map that could be passed to datomic in some transaction data, return a sequence of facts equivalent to the map.
  Optionally provide a tempid generator fn."
  ([m] (map->facts m *tempid*))
  ([m tempid]
   (let [id (or (:db/id m) (tempid))
         process-kv (fn [k v]
                      (cond
                        ;; In clj, need to check for a datomic id up front because
                        ;; (map? tempid) is true.
                        ;; Not necessary in cljs because datascript uses numbers for tempids.
                        #?@(:clj [(tempid? v)
                                  [[:db/add id k v]]])
                        (map? v) (let [subid (or (:db/id v) (tempid))]
                                   (into [[:db/add id k subid]]
                                         (map->facts (assoc v :db/id subid) tempid)))
                        (coll? v) (mapcat
                                   (fn [x]
                                     (cond
                                       ;; same as above.
                                       #?@(:clj [(tempid? x) [[:db/add id k x]]])
                                       (map? x) (let [subid (or (:db/id x) (tempid))]
                                                  (into [[:db/add id k subid]]
                                                        (map->facts (assoc x :db/id subid)
                                                                    tempid)))
                                       (coll? x) (throw (ex-info "Bad facts" {:bad-facts m}))
                                       :else [[:db/add id k x]]))
                                   v)
                        :else [[:db/add id k v]]))]
     (mapcat (fn [[k v]]
               (process-kv k v))
             (dissoc m :db/id)))))

(defn flatten-facts-xducer
  "Returns a transducer to flatten -- replace maps in -- a sequence of facts."
  ([] (flatten-facts-xducer *tempid*))
  ([tempid] (mapcat
             (fn [fact]
               (if (map? fact)
                 (map->facts fact tempid)
                 [fact])))))

;; TODO: wouldn't `normalize-facts` be a better name?
(defn flatten-facts
  "Given a sequence of facts that could be passed to datomic, replace any maps with vector-form facts.
  Optionally provide a tempid generator fn."
  ([facts] (flatten-facts facts *tempid*))
  ([facts tempid]
   (into [] (flatten-facts-xducer tempid) facts)))

(def facts->clj-data-types-xducer
  "A transducer that coverts fact sequences to use idiomatic clj datatypes.
  This is helpful in transactor functions because datomic gives vector-form facts back to us as java.util.Arrays$ArrayLists."
  (map (fn [f]
         (cond
           (map? f) (into {} f)
           ;; What we give to datomic as vectors, datomic gives us back
           ;; as java.util.Arrays$ArrayLists.
           (seqable? f) (seq f)))))

(defn tx-data->idiomatic-data-types
  "Given a sequence of facts from datomic (in a transaction fn),
  convert the datatypes of the facts to idiomatic clojure types."
  [facts]
  (into [] facts->clj-data-types-xducer facts))

(defn clean-facts
  "Convert facts to be easier to work with; ArrayLists are replaced with seqs and map-form facts are replaced with vector-form facts."
  [facts]
  (into []
        (comp
         ;; Convert java types to clojure types (important when run as a transactor fn)
         facts->clj-data-types-xducer
         ;; Convert map-form facts to vector-form
         (flatten-facts-xducer))
        facts))

(defn- double-attr?
  "Returns a boolean indicating whether `attr` is of type :db.type/double.
  Private because making this public would imply that we should have public predicates for all attribute types."
  [db attr]
  (= (attr-type db attr) :db.type/double))

(defn replace-longs-with-doubles'
  "Given a sequence of facts, return a sequence of facts w/ all :db.type/double attribute values as doubles.
  This is often necessary when accepting input from browsers since datomic doesn't automatically convert longs to doubles and javascript doesn't differentiate the two."
  [db facts]
  (let [double? (fn [attr] (double-attr? db attr))
        maybe-double (fn [a x] (if (double? a) (double x) x))]
    (map
     (fn [[op :as fact]]
       (case op
         :db/add (update fact 3 #(maybe-double (nth fact 2) %))
         :db.fn/cas (-> fact
                        (update 3 #(maybe-double (nth fact 2) %))
                        (update 4 #(maybe-double (nth fact 2) %)))
         :db/retract (update fact 3 #(maybe-double (nth fact 2) %))
         fact))
     facts)))

(defn replace-longs-with-doubles
  "Given a sequence of facts, return a sequence of facts w/ all :db.type/double attribute values as doubles.
  This is often necessary when accepting input from browsers since datomic doesn't automatically convert longs to doubles and javascript doesn't differentiate the two."
  [db facts]
  (replace-longs-with-doubles' db (clean-facts facts)))

(defn retractAttribute->retract
  "Given a sequence of facts, return a sequence of facts w/ all :db.fn/retractAttribute facts replaced with a :db/retract fact."
  [db facts]
  (mapcat
   (fn [[op :as fact]]
     (if (= op :db.fn/retractAttribute)
       (let [[_ e a] fact
             val (pull-attr db e a)]
         (cond
           (nil? val) []
           (map? val) [[:db/retract e a (:db/id val)]]
           (sequential? val) (map (fn [x]
                                    (if (map? x)
                                      [:db/retract e a (:db/id x)]
                                      [:db/retract e a x]))
                                  val)
           :else [[:db/retract e a val]]))
       [fact]))
   facts))

(defn reassigned-parent?
  "Returns a boolean indicating whether the entity with id `entity-id` is reassigned
  ownership/parent in the fact sequence `tx-data`.
  Ownership is assigned by setting the entity as the value of a ref+component attr of an entity that is not its current parent."
  ([db entity-id tx-data]
   (reassigned-parent? db entity-id tx-data nil))
  ([db entity-id tx-data current-parent]
   (let [parent-changing-fact? (fn [e a v]
                                 (and (= v entity-id)
                                      (component-attr? db a)
                                      (ref-attr? db a)
                                      (not= e (if current-parent
                                                current-parent
                                                (parent db entity-id)))))]
     (some (fn [tx-datom]
             (if (sequential? tx-datom)
               (let [[op e a v] tx-datom]
                 (case op
                   :db/add (parent-changing-fact? e a v)
                   (:db/cas :db.fn/cas) (let [[op e a old new] tx-datom]
                                          (parent-changing-fact? e a new))
                   false))))
           (flatten-facts tx-data)))))

(defn retractEntity->retract
  "Converts :db.fn/retractEntity and :db/retractEntity datoms into n :db/retract datoms.
  Differs from the built-in :db.fn/retractEntity in that entities owned by the target of the retraction that are reassigned a new owner/parent in the same transaction will not be deleted along with the former parent."
  [db init-tx-data]
  (let [new-parent? (fn [db entity-id current-parent-id]
                      (reassigned-parent? db entity-id init-tx-data current-parent-id))]
    (loop [tx-data init-tx-data
           out-tx-data []
           ;; We only track `ents-to-retract` as a safeguard against infinite recourse.
           ;; I'm not totally sure it's necessary.
           ents-to-retract #{}]
      (let [[tx-datom & tx-datoms] tx-data]
        (if (empty? tx-data)
          out-tx-data
          (cond
            (map? tx-datom) (recur tx-datoms
                                   (conj out-tx-data tx-datom)
                                   ents-to-retract)
            ;; tx facts are handed to us as java.util.Arrays$ArrayLists
            ;; so `sequential?` doesn't work.
            (seqable? tx-datom)
            (let [[op e a v] (seq tx-datom)]
              ;; If this fact is an entity retraction AND we haven't already
              ;; processed the retraction of the entity
              (if (and (or (= op :db.fn/retractEntity)
                           (= op :db/retractEntity))
                       (not (contains? ents-to-retract e)))
                (let [e-datoms (d/datoms db :eavt e)
                      v-datoms (d/datoms db :vaet e)]
                  (recur
                   ;; add :db/retractEntity to the tx-data for references
                   ;; to entities that are not changing parent.
                   (into tx-datoms
                         (comp
                          (filter (fn [{:keys [a] :as datom}]
                                    (and (ref-attr? db a)
                                         (component-attr? db a))))
                          (remove (fn [datom] (new-parent? db (:v datom) (:e datom))))
                          (map (fn [datom] [:db.fn/retractEntity (:v datom)])))
                         e-datoms)
                   ;; add to the out tx data the retraction of the facts about this ent
                   (into out-tx-data
                         (map (fn [{:keys [e a v]}] [:db/retract e a v]))
                         (concat e-datoms v-datoms))
                   (conj ents-to-retract e)))
                (recur tx-datoms
                       (conj out-tx-data tx-datom)
                       ents-to-retract)))
            :else (try (ex-info "Unsupported fact type." {:datom tx-datom}))))))))

(defn entity-retraction-rules
  "Returns a seq of vectors like [entity-id, attribute-name, on-retract-behavior],
  where each entity-id is an entity that references `id` at ref, non-component attr attribute-name, with retraction behavior on-retract-behavior.
  Possible retraction behaviors are :on-retract/allow, :on-retract/restrict, and :on-retract/cascade.
  Read the docstring for `entity-retractions-with-fk-safeguards` for more info."
  [db id]
  (d/q '[:find ?e ?attr-name ?on-retract-kw
         :in $ ?retracted-entity
         :where
         [?e ?a ?retracted-entity]
         [?a :db/valueType :db.type/ref]
         [?a :db/ident ?attr-name]
         [(get-else $ ?a :db/isComponent false) ?component]
         [(= ?component false)]
         [?restrict :db/ident :on-retract/restrict]
         [(get-else $ ?a :ref/on-retract ?restrict) ?on-retract]
         [?on-retract :db/ident ?on-retract-kw]]
       db id))

(defn entity-retraction-fact? [fact]
  (if (sequential? fact)
    (let [[op] fact]
      (or (= op :db.fn/retractEntity)
          (= op :db/retractEntity)))))

(defn entity-retractions
  "Given a seq of facts that could be passed to d/transact, return the set of entities that are targets of :retractEntity facts."
  [facts]
  (into #{}
        (comp
         (filter entity-retraction-fact?)
         (map (fn [[_ e]] e)))
        facts))

(defn entity-retractions-with-fk-safeguards
  "Given a `db` and a seq of entity ids to maybe retract (`retractions`),
  returns a set of entity ids to definitely retract, ensuring that retracted entities cascade appropriately.
  Installed attributes may have the attribute :ref/on-retract, which may have one of three values:
   :on-retract/allow
   :on-retract/restrict (the default if the :ref/on-retract key is not present)
   :on-retract/cascade.
  Use these attributes to control cascading deletes, allowing deletes, and preventing deletes.
  Note that the :ref/on-retract key is only useful on attributes of type :ref with :db/isComponent=false.
  An example use case:
   Suppose you define a survey, then put that survey in a control group's whitelist.
   The default behavior if you try to transact [:db.fn/retractEntity survey-id] without this fn is to retract the survey AND the reference to the survey in the whitelist.
   Using this fn you have three options for that situation:
   - :on-retract/allow is the same as the default behavior without this fn - it allows the retraction to go through.
   - :on-retract/restrict would prevent the survey from being retracted. You might want this in cases where an entity is referenced by another, and is essential for that other entity.
   - :on-retract/cascade would cause the retraction to cascade up the heirarchy until another ref, non-component attribute is found.

  Required schema for this to work:
  [{:db/ident :on-retract/allow}
   {:db/ident :on-retract/cascade}
   {:db/ident :on-retract/restrict}
   {:db/ident :ref/on-retract,
    :db/valueType :db.type/ref,
    :db/cardinality :db.cardinality/one,
    :db/isComponent false,
    :db/doc \"Specifies the behavior for when the entity referenced by a non-component :ref type attribute is retracted.\"}]"
  [db retractions]
  (let [get-entity-references (fn [id] (entity-retraction-rules db id))
        get-entities-to-retract
        (fn get-entities-to-retract [eid]
          (let [references (get-entity-references eid)]
            (if (seq references)
              (if (some (fn [[referencer attr on-retract]]
                          (= on-retract :on-retract/restrict))
                        references)
                ;; If any retraction rule specifies `restrict`, the retraction for
                ;; this entity cannot go through.
                [:no-retract]
                ;; otherwise every reference is either :allow
                ;; or :cascade.
                ;; for :allows, we just retract the entity.
                ;; for :cascades, we must also retract the referencing
                ;; entity (and do this procedure for _that_ entity too)
                (let [references-to-retract
                      (mapcat
                       (fn [[referencer attr on-retract]]
                         (if (= on-retract :on-retract/allow)
                           []
                           ;; otherwise it's :on-retract/cascade
                           (get-entities-to-retract referencer)))
                       references)]
                  (if (some (fn [item]
                              (= item :no-retract))
                            references-to-retract)
                    [:no-retract]
                    (conj references-to-retract eid))))
              ;; The entity has no retraction rules, so it's the only
              ;; entity to retract.
              [eid])))
        entities-to-definitely-retract (into #{}
                                             (comp
                                              (mapcat get-entities-to-retract)
                                              (remove #(= % :no-retract)))
                                             retractions)]
    entities-to-definitely-retract))

(defn with-fk-on-retract-behavior'
  "Given a sequence of vector-form facts, returns the sequence of facts with any disallowed retractions removed and any required retractions added.
  Refer to entity-retractions-with-fk-safeguards for details."
  [db facts]
  (let [fact-groups (group-by entity-retraction-fact? facts)
        non-retract-ent-facts (get fact-groups false)
        retract-ent-facts     (get fact-groups true)
        ents-to-maybe-retract (into #{}
                                    (map (fn [[_ e]] e))
                                    retract-ent-facts)
        ents-to-retract (kc.datomic/entity-retractions-with-fk-safeguards
                         db ents-to-maybe-retract)
        facts (into non-retract-ent-facts
                    (map (fn [e] [:db.fn/retractEntity e]))
                    ents-to-retract)]
    ;; TODO: shouldn't I also remove from non-retract-ent-facts any assertions
    ;; about anything in `ents-to-retract`?
    facts))

(defn with-fk-on-retract-behavior
  "Given a sequence of any kinds of facts, returns the sequence of facts with any disallowed retractions removed and any required retractions added.
  Refer to entity-retractions-with-fk-safeguards for details."
  [db facts]
  (with-fk-on-retract-behavior' db (clean-facts facts)))

(defn- replace-if-tempid [db val tempids]
  (if (tempid? val)
    (or (d/resolve-tempid db tempids val) val)
    val))

(defn- replace-tempids
  "Replace the tempid objects in `fact` with realids using d/resolve-tempid."
  [db [op e a v v2 :as fact] tempids]
  (case op
    (:db/add :db/retract)
    [op (replace-if-tempid db e tempids) a (replace-if-tempid db v tempids)]

    :db.fn/cas
    [op (replace-if-tempid db e tempids) a
     (replace-if-tempid db v tempids)
     (replace-if-tempid db v2 tempids)]

    :db.fn/retractEntity
    [op (replace-if-tempid db e tempids)]))

(defn -simplify-fact-seqs [db fact-seqs xform]
  (let [replace-tempids-global replace-tempids]
    (reduce
     (fn [{:keys [replace-tempids realid->tempid db tx-datas]} facts]
       (let [tempids-in (reduce (fn [ids [op e a v v2]]
                                  (into ids (filter tempid? [e v v2])))
                                #{}
                                facts)
             facts (map replace-tempids facts)
             ;; Here's where the actual fact-altering transformation takes place.
             facts (xform db facts)
             tx-result (d/with db facts)
             {:keys [tempids db-after]} tx-result
             transaction-id (-> tx-result :tx-data first :tx)
             tempid->realid (reduce (fn [m tempid]
                                      (assoc m tempid (d/resolve-tempid db-after tempids tempid)))
                                    {}
                                    tempids-in)
             realid->tempid (merge realid->tempid (set/map-invert tempid->realid))]
         {:replace-tempids (fn [fact]
                             (as-> fact f
                               (replace-tempids-global db-after f tempids)
                               (replace-tempids f)))
          :realid->tempid realid->tempid
          :db db-after
          :tx-datas (conj tx-datas
                          (->> (:tx-data tx-result)
                               (map
                                (fn [{:keys [e a v added]}]
                                  [(if added :db/add :db/retract)
                                   ;; If e came from a tempid, we need that tempid.
                                   (get realid->tempid e e)
                                   a
                                   ;; If v came from a tempid, we need that tempid.
                                   ;; Need to check if attribute is ref, because if its
                                   ;; a long, there's a small chance of a false positive.
                                   (if (ref-attr? db-after a)
                                     (get realid->tempid v v)
                                     v)]))
                               ;; Get rid of any fact that was added about this tx.
                               (remove (fn [[_ e]] (= e transaction-id)))))}))
     {:replace-tempids identity
      :realid->tempid {}
      :db db
      :tx-datas []}
     fact-seqs)))

(defn simplify-fact-seqs
  "Given any number of sequences of facts, return the same number of sequences of facts, with all higher-order facts (ie any fact other than a :db/add or :db/retract) replaced with some number of :db/add and :db/retract facts.

  Each output fact-seq is derived by speculatively transacting (using d/with) each previous fact-seq, optionally transforming the current iteration's fact-seq with `xform`, speculatively transacting the current iteration's fact-seq, and converting the tx-result's :tx-data back to transactable facts.

  Tempids are consistent across the fact sequences; tempid -1 in fact seq 1 refers to the same entity as tempid -1 in fact seq 2. The returned fact-seqs include tempids - the real entity ids produced by d/with are replaced with the input tempids.

  If `xform` is provided, its signature is [db, facts] -> facts and it is applied to each fact-seq before speculatively transacting it but AFTER the fact-seq's tempids are replaced with realids.

  Hint: call merge-facts and remove-tempid-retractions on this fn's return value to produce a single transactable sequence of facts."
  ([db fact-seqs]
   (simplify-fact-seqs db fact-seqs (fn [db facts] facts)))
  ([db fact-seqs xform]
   (:tx-datas (-simplify-fact-seqs db fact-seqs xform))))

(defn- remove-conflicting-cardinality-one-facts [facts [op e a v]]
  (remove
   (fn [[op2 e2 a2 v2]]
     ;; Facts conflict for our purposes if:
     ;; 1) They specify the same op, e, and a.
     ;;    Example: [:db/add 1 :artist/name "Bad Religion"]
     ;;             [:db/add 1 :artist/name "Grumpy Old Men"]
     ;;    These would conflict, so we only keep that last.
     ;; 2) They specify the same e, a, and v, and different op.
     ;;    Example: [:db/add 3 :artist/name "Bad Religion"]
     ;;             [:db/retract 3 :artist/name "Bad Religion"]
     ;;    The retraction should win here, so we drop the add.
     ;; Note that redundant facts - equal op,e,a,v -
     ;; are harmless, so they're ignored here.
     ;; Another form of redundancy is also ignored:
     ;; [retract 1 name "old name"] [add 1 name "new name"]
     ;; The second implies the first, but including both
     ;; is fine.
     (and (= e e2)
          (= a a2)
          (or
           (= op op2)
           ;; We can assume (not= op op2)
           (= v v2))))
   facts))

(defn- remove-conflicting-cardinality-many-facts [facts [op e a v]]
  (remove
   (fn [[op2 e2 a2 v2]]
     ;; Facts conflict for our purposes if:
     ;; 1) They specify the same e, a, and v, and different op.
     ;;    Example: [:db/add 3 :artist/albums "Suffer"]
     ;;             [:db/retract 3 :artist/albums "Suffer"]
     ;;    The retraction should win here, so we drop the add.
     ;; Note that redundant facts - equal op,e,a,v -
     ;; are harmless, so they're ignored here.
     ;; Another form of redundancy is also ignored:
     ;; [retract 1 name "old name"] [add 1 name "new name"]
     ;; The second implies the first, but including both
     ;; is fine.
     (and (= e e2)
          (= a a2)
          (= v v2)
          (not= op op2)))
   facts))

(defn merge-facts
  "Given any number of vector-form fact sequences that could individually be transacted, return a single fact seq that is equivalent.
  The only allowed fact types are :db/add and :db/retract."
  [db fact-seqs]
  (reduce
   (fn [facts [op e a v :as fact]]
     (if (cardinality-many-attr? db a)
       (conj (remove-conflicting-cardinality-many-facts facts fact) fact)
       (conj (remove-conflicting-cardinality-one-facts facts fact) fact)))
   []
   (apply concat fact-seqs)))

(defn remove-tempid-retractions
  "Return `facts` less any :db/retract facts with a tempid in entity or value position.
  Assumes that all facts are either :db/add or :db/retract."
  [facts]
  (remove
   (fn [[op e a v]]
     (and (= op :db/retract)
          (or (tempid? e)
              (tempid? v))))
   facts))

(defn transact-many-validated
  "Given any number of fact sequences, reduce them to a single fact sequence without any conflicting datoms.
  Handles foreign-key relationships with entity-retractions-with-fk-safeguards.
  Handles entity retractions with retractEntity->retract.
  Deduplicates/merges with merge-facts"
  [db fact-seqs]
  (let [fact-seqs (map clean-facts fact-seqs)
        fact-seqs (map #(with-fk-on-retract-behavior' db %) fact-seqs)
        fact-seqs (simplify-fact-seqs db fact-seqs retractEntity->retract)
        facts     (merge-facts db fact-seqs)
        facts     (remove-tempid-retractions facts)]
    facts))