Tasks: detect cycles

This commit is contained in:
Michiel Borkent 2021-05-02 15:04:07 +02:00
parent 12c29eb308
commit 70e0566647

View file

@ -230,7 +230,7 @@
(let [task (tasks task-name) (let [task (tasks task-name)
depends (:depends task)] depends (:depends task)]
(when (contains? processing task-name) (when (contains? processing task-name)
(throw (Exception. (str "Cyclic task: " task-name)))) (throw (ex-info (str "Cyclic task: " task-name) {})))
(loop [deps (seq depends)] (loop [deps (seq depends)]
(let [deps (remove #(contains? @processed %) deps) (let [deps (remove #(contains? @processed %) deps)
order (vec (mapcat #(target-order tasks % processed (conj processing task-name)) deps))] order (vec (mapcat #(target-order tasks % processed (conj processing task-name)) deps))]
@ -261,47 +261,53 @@
requires (get tasks :requires) requires (get tasks :requires)
init (get tasks :init) init (get tasks :init)
prog (if-let [depends (when m? (:depends task))] prog (if-let [depends (when m? (:depends task))]
(let [targets (target-order tasks task-name) (let [[targets error]
(try [(target-order tasks task-name)]
(catch clojure.lang.ExceptionInfo e
[nil (ex-message e)]))
#_#_dependees (tasks->dependees targets tasks) #_#_dependees (tasks->dependees targets tasks)
task-map (cond-> {} task-map (cond-> {}
enter (assoc :enter enter) enter (assoc :enter enter)
leave (assoc :leave leave))] leave (assoc :leave leave))]
(loop [prog "" (if error
targets (seq targets) [(binding [*out* *err*]
done [] (println error)) 1]
extra-paths [] (loop [prog ""
extra-deps nil targets (seq targets)
requires requires] done []
(let [t (first targets) extra-paths []
targets (next targets) extra-deps nil
#_#_ depends-on-t (get dependees t) requires requires]
task-map (cond-> (let [t (first targets)
(assoc task-map targets (next targets)
:name t #_#_ depends-on-t (get dependees t)
#_#_:started done) task-map (cond->
#_#_targets (assoc :pending (vec targets)) (assoc task-map
#_#_depends-on-t (assoc :dependents depends-on-t))] :name t
(if targets #_#_:started done)
(if-let [task (get tasks t)] #_#_targets (assoc :pending (vec targets))
(recur (str prog "\n" (assemble-task-1 task-map task parallel?)) #_#_depends-on-t (assoc :dependents depends-on-t))]
targets (if targets
(conj done t) (if-let [task (get tasks t)]
(concat extra-paths (:extra-paths task)) (recur (str prog "\n" (assemble-task-1 task-map task parallel?))
(merge extra-deps (:extra-deps task)) targets
(concat requires (:requires task))) (conj done t)
[(binding [*out* *err*] (concat extra-paths (:extra-paths task))
(println "No such task:" t)) 1]) (merge extra-deps (:extra-deps task))
(if-let [task (get tasks t)] (concat requires (:requires task)))
(let [prog (str prog "\n" [(binding [*out* *err*]
(apply str (map deref-task depends)) (println "No such task:" t)) 1])
"\n" (if-let [task (get tasks t)]
(assemble-task-1 task-map task parallel? true)) (let [prog (str prog "\n"
extra-paths (concat extra-paths (:extra-paths task)) (apply str (map deref-task depends))
extra-deps (merge extra-deps (:extra-deps task)) "\n"
requires (concat requires (:requires task))] (assemble-task-1 task-map task parallel? true))
[[(format-task init extra-paths extra-deps requires prog)] nil]) extra-paths (concat extra-paths (:extra-paths task))
[(binding [*out* *err*] extra-deps (merge extra-deps (:extra-deps task))
(println "No such task:" t)) 1]))))) requires (concat requires (:requires task))]
[[(format-task init extra-paths extra-deps requires prog)] nil])
[(binding [*out* *err*]
(println "No such task:" t)) 1]))))))
[[(format-task [[(format-task
init init
(:extra-paths task) (:extra-paths task)