This commit is contained in:
Michiel Borkent 2021-05-08 11:06:34 +02:00
parent 9a8bf7d0c3
commit f3a441ee3c

View file

@ -27,13 +27,13 @@
(println (format "[bb %s]" (:name @task)) (str/join " " strs)))))) (println (format "[bb %s]" (:name @task)) (str/join " " strs))))))
#_(defn log-error [& strs] #_(defn log-error [& strs]
(let [log-level @log-level] (let [log-level @log-level]
(when (or (when (or
;; log error also in case of info level ;; log error also in case of info level
(identical? :info log-level) (identical? :info log-level)
(identical? :error log-level)) (identical? :error log-level))
(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- handle-non-zero [proc opts] (defn- handle-non-zero [proc opts]
(when proc (when proc
@ -181,7 +181,7 @@
task task
(namespace task) (namespace task)
prog)] prog)]
prog) prog)
(let [prog (pr-str task) (let [prog (pr-str task)
prog (wrap-enter-leave task-name prog enter leave) prog (wrap-enter-leave task-name prog enter leave)
prog (wrap-depends prog depends parallel?) prog (wrap-depends prog depends parallel?)
@ -241,14 +241,14 @@
order)))))) order))))))
#_(defn tasks->dependees [task-names tasks] #_(defn tasks->dependees [task-names tasks]
(let [tasks->depends (zipmap task-names (map #(:depends (get tasks %)) task-names))] (let [tasks->depends (zipmap task-names (map #(:depends (get tasks %)) task-names))]
(persistent! (persistent!
(reduce (fn [acc [task depends]] (reduce (fn [acc [task depends]]
(reduce (fn [acc dep] (reduce (fn [acc dep]
(assoc! acc dep (conj (or (get acc dep) (assoc! acc dep (conj (or (get acc dep)
#{}) #{})
task))) task)))
acc depends)) (transient {}) tasks->depends)))) acc depends)) (transient {}) tasks->depends))))
(defn assemble-task [task-name parallel?] (defn assemble-task [task-name parallel?]
(let [task-name (symbol task-name) (let [task-name (symbol task-name)
@ -328,11 +328,11 @@
(defn doc-from-task [sci-ctx tasks task] (defn doc-from-task [sci-ctx tasks task]
(or (:doc task) (or (:doc task)
(when-let [fn-sym (cond (qualified-symbol? task) (when-let [fn-sym (cond (qualified-symbol? task)
task task
(map? task) (map? task)
(let [t (:task task)] (let [t (:task task)]
(when (qualified-symbol? t) (when (qualified-symbol? t)
t)))] t)))]
(let [requires (:requires tasks) (let [requires (:requires tasks)
requires (map (fn [x] requires (map (fn [x]
(list 'quote x)) (list 'quote x))
@ -360,14 +360,14 @@
loc (zip/find-value loc :tasks) loc (zip/find-value loc :tasks)
loc (zip/right loc) loc (zip/right loc)
loc (zip/down loc)] loc (zip/down loc)]
(->> (into []
loc (comp
(iterate zip/right) (take-nth 2 )
(take-nth 2 ) (take-while #(not (zip/end? %)))
(take-while #(not (zip/end? %))) (filter zip/sexpr-able?)
(filter zip/sexpr-able?) (map zip/sexpr)
(map zip/sexpr) (filter symbol?))
(filter symbol?)))) (iterate zip/right loc))))
(defn list-tasks (defn list-tasks
[sci-ctx] [sci-ctx]