nil-to-retract.edn

{:db/id    #db/id [:db.part/user]
 :db/ident :nil->retract
 :db/fn    #db/fn {:lang :clojure
                   :params [db m & opts]
                   :code (letfn [(remove-nil
                                   [m]
                                   (let [f (fn [[k v]] (when (not (nil? v)) [k v]))]
                                     (clojure.walk/postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m)))
                                 
                                 (empty-coll->nil
                                   [m]
                                   (clojure.walk/postwalk
                                     (fn [x] (cond (and (coll? x) (empty? x)) nil
                                                   (and (map? x) (every? nil? (vals x))) nil
                                                   :else x))
                                     m))
                                 
                                 (elem->match
                                   [elem candidates match-ids]
                                   (->> (for [cand candidates
                                              match-id (conj match-ids :db/id)]
                                          (when (and (some? (get elem match-id))
                                                     (= (get elem match-id)
                                                        (get cand match-id)))
                                            cand))
                                        (drop-while nil?)
                                        (first)))
                                 
                                 (deduce-db-ids
                                   [db-ent ent match-ids]
                                   (reduce-kv
                                     (fn [res k v]
                                       (let [dbv (get db-ent k)]
                                         (cond (vector? v)
                                               (assoc res k (vec (for [elem v]
                                                                   (if-let [match (elem->match elem dbv match-ids)]
                                                                     (deduce-db-ids match elem match-ids)
                                                                     elem))))
                                               (map? v) (assoc res k (deduce-db-ids dbv v match-ids))
                                               :else (assoc res k v))))
                                     (select-keys db-ent [:db/id])
                                     ent))
                                 
                                 (add-index
                                   [path ent]
                                   (let [k (first path)
                                         v (get ent k)]
                                     (cond (and (= 2 (count path))
                                                (vector? v))
                                           (assoc ent k (vec (map-indexed (fn [idx x] (assoc x (last path) idx)) v)))
                                 
                                           (vector? v)
                                           (assoc ent k (mapv (fn [x] (add-index (drop 1 path) x)) v))
                                 
                                           (map? v)
                                           (assoc ent k (add-index (drop 1 path) v))
                                 
                                           :else ent)))
                                 
                                 (ref? [x]
                                   (and (map? x) (:db/id x) (= x (select-keys x [:db/id]))))
                                 
                                 (comp-ref? [x]
                                   (and (map? x) (:db/id x) (not= x (select-keys x [:db/id]))))
                                 
                                 (enum->maps
                                   [db ent]
                                   (reduce-kv
                                     (fn [res k v]
                                       (cond (keyword? v)
                                             (assoc res k (d/pull db '[:*] v))
                                             (map? v)
                                             (assoc res k (enum->maps db v))
                                             (vector? v)
                                             (assoc res k (mapv (fn [v] (if (keyword? v)
                                                                          (d/pull db '[:*] v)
                                                                          (enum->maps db v))) v))
                                             :else (assoc res k v)))
                                     {}
                                     ent))
                                 
                                 (nil->retracts
                                   [db-ent ent]
                                   (reduce-kv
                                     (fn [res k v]
                                       (let [dbv (get db-ent k)]
                                         (cond (vector? dbv)
                                               (reduce into res (for [elem dbv]
                                                                  (if-let [match (elem->match elem v [:db/id])]
                                                                    (nil->retracts elem match)
                                                                    (if (comp-ref? elem)
                                                                      [[:db.fn/retractEntity (:db/id elem)]]
                                                                      [[:db/retract (:db/id ent) k (:db/id elem)]]))))
                                 
                                               (map? v) (into res (nil->retracts dbv v))
                                 
                                               (and (comp-ref? dbv) (nil? v))
                                               (into res [[:db.fn/retractEntity (:db/id dbv)]])
                                 
                                               (and (ref? dbv) (nil? v))
                                               (into res [[:db/retract (:db/id ent) k (:db/id dbv)]])
                                 
                                               (and (some? dbv) (nil? v))
                                               (into res [[:db/retract (:db/id ent) k dbv]])
                                               :else res)))
                                     []
                                     ent))
                                 
                                 (nil->retract
                                   [db m match-ids add-indexes]
                                   (if-let [db-id (:db/id m)]
                                     (let [db-ent (d/pull db '[:*] db-id)
                                           m (empty-coll->nil m)
                                           m (reduce (fn [o p] (add-index p o)) m add-indexes)
                                           m (assoc m :db/id (:db/id db-ent))
                                           m (deduce-db-ids db-ent m match-ids)]
                                       (into [(remove-nil m)] (nil->retracts db-ent (enum->maps db m))))
                                     [(remove-nil (empty-coll->nil m))]))] (nil->retract db m (first opts) (second opts)))}}