diff --git a/src/common/datomish/db.cljc b/src/common/datomish/db.cljc index c280b154..a240ed39 100644 --- a/src/common/datomish/db.cljc +++ b/src/common/datomish/db.cljc @@ -121,10 +121,6 @@ (SQLite schema a v) - yield-datom - (fn [rows] - (when-let [row (first rows)] - (row->Datom schema row)))] - (go-pair - (->> - ;; TODO: generalize columns. - ["SELECT e, a, v, tx, 1 AS added FROM all_datoms - WHERE index_avet = 1 AND a = ? AND value_type_tag = ? AND v = ? - LIMIT 1" a tag v] - - (s/all-rows (:sqlite-connection db)) - id-av (fn [[op id-literal a v]] [id-literal [a v]]) + ;; Like {[id-literal [[:a1 :v1] [:a2 :v2] ...]] ...}. + id->avs (util/group-by-kv ->id-av upserts-e) + ;; Like [[:a1 :v1] [:a2 v2] ...]. + avs (apply concat (vals id->avs)) + ;; Like {[[:a1 :v1] e1] ...}. + av->e (es (fn [avs] (set (keep (partial get av->e) avs))) + + id->es (util/mapvals avs->es id->avs)] + + (into {} + ;; nil is dropped. + (map (fn [[id es]] + (when-let [e (first es)] + (when (second es) + (raise "Conflicting upsert: " id " resolves" + " to more than one entid " es + {:error :transact/upsert :tempid id :entids es})) + [id e]))) + id->es))))) + +(defn evolve-upserts-e [id->e upserts-e] + (let [evolve1 + (fn [[op id-e a v]] + (let [e* (get id->e id-e)] + (if e* + [:upserted [op e* a v]] + [:allocations-e [op id-e a v]])))] + (util/group-by-kv evolve1 upserts-e))) + +(defn evolve-upserts-ev [id->e upserts-ev] + "Given a map id->e of id-literals to integer entids, evolve the given entities. Returns a map + whose keys are generations and whose values are vectors of entities in those generations." + (let [evolve1 + (fn [[op id-e a id-v]] + (let [e* (get id->e id-e) + v* (get id->e id-v)] + (if e* + (if v* + [:resolved [op e* a v*]] + [:allocations-v [op e* a id-v]]) + (if v* + [:upserts-e [op id-e a v*]] + [:upserts-ev [op id-e a id-v]]))))] + (util/group-by-kv evolve1 upserts-ev))) + +(defn evolve-allocations-e [id->e allocations-e] + "Given a map id->e of id-literals to integer entids, evolve the given entities. Returns a map + whose keys are generations and whose values are vectors of entities in those generations." + (let [evolve1 + (fn [[op id-e a v]] + (let [e* (get id->e id-e)] + (if e* + [:resolved [op e* a v]] + [:allocations-e [op id-e a v]])))] + (util/group-by-kv evolve1 allocations-e))) + +(defn evolve-allocations-v [id->e allocations-v] + "Given a map id->e of id-literals to integer entids, evolve the given entities. Returns a map + whose keys are generations and whose values are vectors of entities in those generations." + (let [evolve1 + (fn [[op e a id-v]] + (let [v* (get id->e id-v)] + (if v* + [:resolved [op e a v*]] + [:allocations-v [op e a id-v]])))] + (util/group-by-kv evolve1 allocations-v))) + +(defn evolve-allocations-ev [id->e allocations-ev] + "Given a map id->e of id-literals to integer entids, evolve the entities in allocations-ev. Returns a + map whose keys are generations and whose values are vectors of entities in those generations." + (let [evolve1 + (fn [[op id-e a id-v]] + (let [e* (get id->e id-e) + v* (get id->e id-v)] + (if e* + (if v* + [:resolved [op e* a v*]] + [:allocations-v [op e* a id-v]]) + (if v* + [:allocations-e [op id-e a v*]] + [:allocations-ev [op id-e a id-v]]))))] + (util/group-by-kv evolve1 allocations-ev))) + +(defn e will upsert; some will not. + Some :upserts-e evolve to become actual :upserts (they upserted!); any other :upserts-e evolve to + become :allocations-e (they did not upsert, and will not upsert this transaction). + + Using the newly upserted id-literals, some :upserts-ev evolve to become :resolved; + some :upserts-ev evolve to become :upserts-e; and some :upserts-ev remain :upserts-ev. + + Likewise, some :allocations-ev evolve to become :allocations-e, :allocations-v, or :resolved; some + :allocations-e evolve to become :resolved; and some :allocations-v evolve to become :resolved. + + If we have *new* :upserts-e (i.e., some :upserts-ev become :upserts-e), then we may be able to + make more progress. We recurse, trying to resolve these new :upserts-e. + + Eventually we will have no :upserts-e. At this point, :upserts-ev become :allocations-ev, and now + we have :entities, :upserted, :resolved, and various :allocations-*. + + As a future optimization, :upserts do not need to be inserted; they upserted, so they already + exist in the DB. (We still need to verify uniqueness and ensure no overlapping can occur.) + Similary, :allocations-* do not need to be checked for existence, so they can be written to the DB + faster." + (go-pair + (let [{:keys [upserted resolved upserts-ev upserts-e allocations-ev allocations-e allocations-v entities]} evolution] + (if-not upserts-e + ;; No more progress to be made. Any upserts-ev must just be allocations. + {:allocations-ev (concat upserts-ev allocations-ev) + :allocations-e allocations-e + :allocations-v allocations-v + :upserted upserted + :resolved resolved + :entities entities} + ;; Progress can be made. Try to evolve further. + (let [id->e (e ;; TODO: ensure we handle conflicting upserts across generations correctly here. + :upserted upserted + :resolved resolved + :entities entities} + (evolve-upserts-ev id->e upserts-ev) + (evolve-upserts-e id->e upserts-e) + (evolve-allocations-ev id->e allocations-ev) + (evolve-allocations-e id->e allocations-e) + (evolve-allocations-v id->e allocations-v))))))) + +;; TODO: do this in one step, rather than iterating. +(defn allocate [report evolution] + "Given a maximally evolved map of generations, allocate entids for all id-literals that did not + get upserted." + (let [{:keys [tempids upserted resolved allocations-ev allocations-e allocations-v entities]} evolution + initial-report (assoc report :tempids tempids)] + (loop [report + (assoc initial-report + ;; TODO: drop :upserted, they already exist in the DB; and don't search for + ;; :allocations-*, they definitely don't already exist in the DB. + :entities (concat upserted resolved entities)) + + es + (concat allocations-ev allocations-e allocations-v)] + (let [[[op e a v :as entity] & entities] es] + (cond + (nil? entity) + report + + (id-literal? e) + (let [eid (or (get-in report [:tempids e]) (-next-eid! (:part-map-atom report) e))] + (recur (allocate-eid report e eid) (cons [op eid a v] entities))) + + (id-literal? v) + (let [eid (or (get-in report [:tempids v]) (-next-eid! (:part-map-atom report) v))] + (recur (allocate-eid report v eid) (cons [op e a eid] entities))) + + true + (recur (transact-entity report entity) entities) + ))))) + (defn