From 85ac0a90cb2e49fb3012e6fbe515df09d6d9de68 Mon Sep 17 00:00:00 2001 From: Kirill Chernyshov Date: Fri, 20 May 2022 17:56:06 +0200 Subject: [PATCH] Allow dependencies initialise in parallel ```clojure (defmethod ig/init-key ::foo [_ timeout] (Thread/sleep timeout) nil) (defmethod ig/init-key ::bar [_ [timeout _]] (Thread/sleep timeout) nil) (time (-> {[::foo ::o] 1000 [::foo ::p] 1000 [::foo ::q] 1000 ::bar [1000 (ig/refset ::foo)]} (ig/init))) ;; => "Elapsed time: 2005.345024 msecs" ``` --- src/integrant/core.cljc | 77 ++++++++++++++++++++++++++++++++--------- 1 file changed, 61 insertions(+), 16 deletions(-) diff --git a/src/integrant/core.cljc b/src/integrant/core.cljc index aa44e67..296db84 100644 --- a/src/integrant/core.cljc +++ b/src/integrant/core.cljc @@ -151,18 +151,43 @@ [graph] (dep/topo-comparator #(compare (str %1) (str %2)) graph)) +(defn node->depth-mapping + "Generate a map of node to depth from a graph" + [graph] + (loop [levels {} + current-level 0 + g graph] + (if-let [free-nodes (seq (sequence + (comp (filter #(empty? (dep/immediate-dependencies g %))) + (distinct)) + (dep/nodes g)))] + (recur (reduce (fn [acc node] + (assoc acc node current-level)) + levels + free-nodes) + (inc current-level) + (reduce + (fn [graph node] + (dep/remove-all graph node)) + g + free-nodes)) + levels))) + (defn- find-keys [config keys f] (let [graph (dependency-graph config {:include-refsets? false}) - keyset (set (mapcat #(map key (find-derived config %)) keys))] + keyset (set (mapcat #(map key (find-derived config %)) keys)) + comparator (key-comparator (dependency-graph config))] (->> (f graph keyset) (set/union keyset) - (sort (key-comparator (dependency-graph config)))))) + (group-by (node->depth-mapping (dependency-graph config))) + (sort-by first) + (map (comp (partial sort comparator) second))))) (defn- dependent-keys [config keys] (find-keys config keys dep/transitive-dependencies-set)) (defn- reverse-dependent-keys [config keys] - (reverse (find-keys config keys dep/transitive-dependents-set))) + (map reverse (reverse (find-keys config keys dep/transitive-dependents-set)))) (def ^:private default-readers {'ig/ref ref, 'ig/refset refset}) @@ -203,6 +228,7 @@ (load-namespaces config (keys config))) ([config keys] (doall (->> (dependent-keys config keys) + (mapcat identity) (mapcat #(conj (ancestors %) %)) (mapcat key->namespaces) (distinct) @@ -258,9 +284,15 @@ (defn- run-loop [system keys f] (loop [completed (), remaining keys] (when (seq remaining) - (let [k (first remaining)] - (try-run-action system completed remaining f k) - (recur (cons k completed) (rest remaining)))))) + (let [ks (first remaining)] + (recur (loop [completed' completed, + remaining' ks] + (if (seq remaining') + (let [k (first remaining')] + (try-run-action system completed' (reduce concat (rest remaining') remaining) f k) + (recur (cons k completed') (rest remaining'))) + completed')) + (rest remaining)))))) (defn- system-origin [system] (-> system meta ::origin (select-keys (keys system)))) @@ -305,12 +337,25 @@ (catch #?(:clj Throwable :cljs :default) t (throw (build-exception system f k v t))))) -(defn- build-key [f assertf resolvef system [k v]] - (let [v' (expand-key system resolvef v)] - (assertf system k v') - (-> system - (assoc k (try-build-action system f k v')) - (vary-meta assoc-in [::build k] v')))) +(defn- build-keys [f assertf resolvef config system ks] + (reduce + (fn [system fut] + (let [[k v v'] #?(:clj (try + @fut + (catch java.util.concurrent.ExecutionException e + (throw (.getCause e)))) + :cljs fut)] + (-> system + (assoc k v') + (vary-meta assoc-in [::build k] v)))) + system + (mapv (fn [k] + (#?(:clj future + :cljs identity) + (let [v' (expand-key system resolvef (config k))] + (assertf system k v') + [k v' (try-build-action system f k v')]))) + ks))) (defn build "Apply a function f to each key value pair in a configuration map. Keys are @@ -325,16 +370,16 @@ ([config keys f assertf resolvef] {:pre [(map? config)]} (let [relevant-keys (dependent-keys config keys) - relevant-config (select-keys config relevant-keys)] + relevant-config (select-keys config (reduce concat relevant-keys))] (when-let [invalid-key (first (invalid-composite-keys config))] (throw (invalid-composite-key-exception config invalid-key))) (when-let [ref (first (ambiguous-refs relevant-config))] (throw (ambiguous-key-exception config ref (map key (find-derived config ref))))) (when-let [refs (seq (missing-refs relevant-config))] (throw (missing-refs-exception config refs))) - (reduce (partial build-key f assertf resolvef) + (reduce (partial build-keys f assertf resolvef config) (with-meta {} {::origin config}) - (map (fn [k] [k (config k)]) relevant-keys))))) + relevant-keys)))) (defmulti resolve-key "Return a value to substitute for a reference prior to initiation. By default @@ -449,7 +494,7 @@ (reverse-run! system keys halt-key!))) (defn- missing-keys [system ks] - (remove (set ks) (keys system))) + (remove (reduce into #{} ks) (keys system))) (defn- halt-missing-keys! [config system keys] (let [graph (-> system meta ::origin dependency-graph)