[#865] Use print-meta when emitting tasks

This commit is contained in:
Michiel Borkent 2021-05-30 11:27:11 +02:00
parent 9347bfd3d3
commit 94fc8298e6
2 changed files with 75 additions and 80 deletions

View file

@ -31,15 +31,6 @@
(binding [*out* *err*] (binding [*out* *err*]
(println (format "[bb %s]" (:name @task)) (str/join " " strs)))))) (println (format "[bb %s]" (:name @task)) (str/join " " strs))))))
#_(defn log-error [& strs]
(let [log-level @log-level]
(when (or
;; log error also in case of info level
(identical? :info log-level)
(identical? :error log-level))
(binding [*out* *err*]
(println (format "[bb %s]" (:name @task)) (str/join " " strs))))))
(defn- handle-non-zero [proc opts] (defn- handle-non-zero [proc opts]
(when proc (when proc
(when-let [proc (deref proc)] (when-let [proc (deref proc)]
@ -268,7 +259,7 @@
(if (seq requires) (if (seq requires)
(format "(:require %s)" (str/join " " requires)) (format "(:require %s)" (str/join " " requires))
"") "")
(str init) (pr-str init)
prog)) prog))
(defn target-order (defn target-order
@ -303,75 +294,70 @@
enter (:enter tasks) enter (:enter tasks)
leave (:leave tasks) leave (:leave tasks)
task (get tasks task-name)] task (get tasks task-name)]
(if task (binding [*print-meta* true]
(let [m? (map? task) (if task
requires (get tasks :requires) (let [m? (map? task)
init (get tasks :init) requires (get tasks :requires)
prog (if-let [depends (when m? (:depends task))] init (get tasks :init)
(let [[targets error] prog (if (when m? (:depends task))
(try [(target-order tasks task-name)] (let [[targets error]
(catch clojure.lang.ExceptionInfo e (try [(target-order tasks task-name)]
[nil (ex-message e)])) (catch clojure.lang.ExceptionInfo e
#_#_dependees (tasks->dependees targets tasks) [nil (ex-message e)]))
task-map (cond-> {} task-map (cond-> {}
enter (assoc :enter enter) enter (assoc :enter enter)
leave (assoc :leave leave) leave (assoc :leave leave)
parallel? (assoc :parallel parallel?))] parallel? (assoc :parallel parallel?))]
(if error (if error
[(binding [*out* *err*] [(binding [*out* *err*]
(println error)) 1] (println error)) 1]
(loop [prog "" (loop [prog ""
targets (seq targets) targets (seq targets)
done [] done []
extra-paths [] extra-paths []
extra-deps nil extra-deps nil
requires requires] requires requires]
(let [t (first targets) (let [t (first targets)
targets (next targets) targets (next targets)
#_#_ depends-on-t (get dependees t) task-map (assoc task-map
task-map (cond-> :name t)]
(assoc task-map (if targets
:name t (if-let [task (get tasks t)]
#_#_:started done) (recur (str prog "\n" (assemble-task-1 task-map task parallel?))
#_#_targets (assoc :pending (vec targets)) targets
#_#_depends-on-t (assoc :dependents depends-on-t))] (conj done t)
(if targets (concat extra-paths (:extra-paths task))
(if-let [task (get tasks t)] (merge extra-deps (:extra-deps task))
(recur (str prog "\n" (assemble-task-1 task-map task parallel?)) (concat requires (:requires task)))
targets [(binding [*out* *err*]
(conj done t) (println "No such task:" t)) 1])
(concat extra-paths (:extra-paths task)) (if-let [task (get tasks t)]
(merge extra-deps (:extra-deps task)) (let [prog (str prog "\n"
(concat requires (:requires task))) #_(wait-tasks depends) #_(apply str (map deref-task depends))
[(binding [*out* *err*] "\n"
(println "No such task:" t)) 1]) (assemble-task-1 task-map task parallel? true))
(if-let [task (get tasks t)] extra-paths (concat extra-paths (:extra-paths task))
(let [prog (str prog "\n" extra-deps (merge extra-deps (:extra-deps task))
#_(wait-tasks depends) #_(apply str (map deref-task depends)) requires (concat requires (:requires task))]
"\n" [[(format-task init extra-paths extra-deps requires prog)] nil])
(assemble-task-1 task-map task parallel? true)) [(binding [*out* *err*]
extra-paths (concat extra-paths (:extra-paths task)) (println "No such task:" t)) 1]))))))
extra-deps (merge extra-deps (:extra-deps task)) [[(format-task
requires (concat requires (:requires task))] init
[[(format-task init extra-paths extra-deps requires prog)] nil]) (:extra-paths task)
[(binding [*out* *err*] (:extra-deps task)
(println "No such task:" t)) 1])))))) (concat requires (:requires task))
[[(format-task (assemble-task-1 (cond-> {:name task-name}
init enter (assoc :enter enter)
(:extra-paths task) leave (assoc :leave leave)
(:extra-deps task) parallel? (assoc :parallel parallel?))
(concat requires (:requires task)) task parallel? true))] nil])]
(assemble-task-1 (cond-> {:name task-name} (when @debug
enter (assoc :enter enter) (binding [*out* *err*]
leave (assoc :leave leave) (println (ffirst prog))))
parallel? (assoc :parallel parallel?)) prog)
task parallel? true))] nil])] [(binding [*out* *err*]
(when @debug (println "No such task:" task-name)) 1]))))
(binding [*out* *err*]
(println (ffirst prog))))
prog)
[(binding [*out* *err*]
(println "No such task:" task-name)) 1])))
(defn doc-from-task [sci-ctx tasks task] (defn doc-from-task [sci-ctx tasks task]
(or (:doc task) (or (:doc task)

View file

@ -236,7 +236,16 @@
:task (do (Thread/sleep 10) :task (do (Thread/sleep 10)
(+ 1 2 3))} (+ 1 2 3))}
c (do (Thread/sleep 10) :c)}} c (do (Thread/sleep 10) :c)}}
(is (= [6 6 :c] (bb "run" "--prn" "a"))))))) (is (= [6 6 :c] (bb "run" "--prn" "a"))))))
(testing "dynamic vars"
(test-utils/with-config '{:tasks
{:init (def ^:dynamic *foo* true)
a (do
(def ^:dynamic *bar* false)
(binding [*foo* false
*bar* true]
[*foo* *bar*]))}}
(is (= [false true] (bb "run" "--prn" "a"))))))
(deftest list-tasks-test (deftest list-tasks-test
(test-utils/with-config {} (test-utils/with-config {}