luciano/babashka
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[#805] Support :enter and :leave hooks + current-task fn (#813)

Browse source
This commit is contained in:
Michiel Borkent 2021-04-30 11:11:12 +02:00 committed by GitHub
parent a8247c9762
commit 06be620d71
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 104 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

123
src/babashka/impl/tasks.clj
View file

@ -13,7 +13,10 @@
(def sci-ns (sci/create-ns 'babashka.tasks nil)) (def sci-ns (sci/create-ns 'babashka.tasks nil))
(def default-log-level :error) (def default-log-level :error)
(def log-level (sci/new-dynamic-var '*-log-level* default-log-level {:ns sci-ns})) (def log-level (sci/new-dynamic-var '*-log-level* default-log-level {:ns sci-ns}))
(def task-name (sci/new-dynamic-var '*-task-name* nil {:ns sci-ns})) ;; (def task-name (sci/new-dynamic-var '*-task-name* nil {:ns sci-ns}))
(def task (sci/new-dynamic-var '*task* nil {:ns sci-ns}))
(def current-task (sci/new-dynamic-var 'current-task (fn [] @task) {:ns sci-ns}))
(def state (sci/new-var 'state (atom {}) {:ns sci-ns}))
(defn log-info [& strs] (defn log-info [& strs]
(let [log-level @log-level] (let [log-level @log-level]
@ -21,7 +24,7 @@
;; do not log when level is :error ;; do not log when level is :error
(identical? :info log-level) (identical? :info log-level)
(binding [*out* *err*] (binding [*out* *err*]
(println (format "[bb %s]" @task-name) (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]
@ -30,7 +33,7 @@
(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]" @task-name) (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
@ -111,7 +114,9 @@
{'shell (sci/copy-var shell sci-ns) {'shell (sci/copy-var shell sci-ns)
'clojure (sci/copy-var clojure sci-ns) 'clojure (sci/copy-var clojure sci-ns)
'-wait (sci/copy-var -wait sci-ns) '-wait (sci/copy-var -wait sci-ns)
'*-task-name* task-name '*task* task
'current-task current-task
'current-state state
'*-log-level* log-level '*-log-level* log-level
'-log-info (sci/copy-var log-info sci-ns) '-log-info (sci/copy-var log-info sci-ns)
'-log-error (sci/copy-var log-error sci-ns)}) '-log-error (sci/copy-var log-error sci-ns)})
@ -126,26 +131,39 @@
(format "(when %s %s)" (second when-expr) expr) (format "(when %s %s)" (second when-expr) expr)
expr)) expr))
(defn wrap-body [task-name prog parallel? log-level] (defn wrap-body [task-map prog parallel? log-level]
(format "(binding [babashka.tasks/*-task-name* \"%s\" (format "(binding [
babashka.tasks/*-log-level* %s] babashka.tasks/*-log-level* %s
babashka.tasks/*task* '%s]
(babashka.tasks/-log-info) (babashka.tasks/-log-info)
%s)" task-name %s)"
log-level log-level
(pr-str task-map)
(if parallel? (if parallel?
(format "(future %s)" prog) (format "(future %s)" prog)
prog))) prog)))
(defn wrap-def [task-name prog parallel? last? log-level] (defn wrap-def [task-map prog parallel? last? log-level]
(format "(def %s %s) %s" (let [task-name (:name task-map)]
task-name (wrap-body task-name prog parallel? log-level) (format "(def %s %s) %s"
(if (and parallel? last?) task-name (wrap-body task-map prog parallel? log-level)
(format "(babashka.tasks/-wait %s)" task-name) (if (and parallel? last?)
task-name))) (format "(babashka.tasks/-wait %s)" task-name)
task-name))))
(defn deref-task [dep] (defn deref-task [dep]
(format "(def %s (babashka.tasks/-wait %s))" dep dep)) (format "(def %s (babashka.tasks/-wait %s))" dep dep))
(defn wrap-enter-leave [prog enter leave]
(str (pr-str enter) "\n"
(if leave
(format "
(let [res %s]
%s
res)"
prog (pr-str leave))
prog)))
(defn wrap-depends [prog depends parallel?] (defn wrap-depends [prog depends parallel?]
(if parallel? (if parallel?
(format "(do %s)" (str (str/join "\n" (map deref-task depends)) "\n" prog)) (format "(do %s)" (str (str/join "\n" (map deref-task depends)) "\n" prog))
@ -153,23 +171,32 @@
(defn assemble-task-1 (defn assemble-task-1
"Assembles task, does not process :depends." "Assembles task, does not process :depends."
([task-name task log-level parallel?] ([task-map task log-level parallel?]
(assemble-task-1 task-name task log-level parallel? nil nil)) (assemble-task-1 task-map task log-level parallel? nil))
([task-name task log-level parallel? last?] (assemble-task-1 task-name task log-level parallel? last? nil)) ([task-map task log-level parallel? last?]
([task-name task log-level parallel? last? depends] (let [[task depends task-map]
(let [[task depends] (if (map? task) (if (map? task)
[(:task task) (:depends task)] [(:task task)
[task depends]) (:depends task)
(merge task-map task)]
[task nil (assoc task-map :task task)])
enter (:enter task-map)
leave (:leave task-map)
task-name (:name task-map)
private? (or (:private task) private? (or (:private task)
(str/starts-with? task-name "-")) (str/starts-with? task-name "-"))
task-map (if private?
(assoc task-map :private private?)
task-map)
log-level (or (:log-level task) log-level (or (:log-level task)
(when private? (when private?
:error) :error)
log-level)] log-level)]
(if (qualified-symbol? task) (if (qualified-symbol? task)
(let [prog (format "(apply %s *command-line-args*)" task) (let [prog (format "(apply %s *command-line-args*)" task)
prog (wrap-enter-leave prog enter leave)
prog (wrap-depends prog depends parallel?) prog (wrap-depends prog depends parallel?)
prog (wrap-def task-name prog parallel? last? log-level) prog (wrap-def task-map prog parallel? last? log-level)
prog (format " prog (format "
(when-not (resolve '%s) (require (quote %s))) (when-not (resolve '%s) (require (quote %s)))
%s" %s"
@ -177,9 +204,10 @@
(namespace task) (namespace task)
prog)] prog)]
prog) prog)
(let [task (pr-str task) (let [prog (pr-str task)
prog (wrap-depends task depends parallel?) prog (wrap-enter-leave prog enter leave)
prog (wrap-def task-name prog parallel? last? log-level)] prog (wrap-depends prog depends parallel?)
prog (wrap-def task-map prog parallel? last? log-level)]
prog))))) prog)))))
(defn format-task [init extra-paths extra-deps requires prog] (defn format-task [init extra-paths extra-deps requires prog]
@ -196,8 +224,13 @@
(when-not (resolve 'shell) (when-not (resolve 'shell)
(intern *ns* 'shell babashka.tasks/shell)) (intern *ns* 'shell babashka.tasks/shell))
(when-not (resolve 'current-task)
(intern *ns* 'current-task babashka.tasks/current-task))
%s %s
%s" %s
"
(if (seq extra-paths) (if (seq extra-paths)
(format "(babashka.classpath/add-classpath \"%s\")" (str/join cp/path-sep extra-paths)) (format "(babashka.classpath/add-classpath \"%s\")" (str/join cp/path-sep extra-paths))
"") "")
@ -224,10 +257,22 @@
(conj order task-name)) (conj order task-name))
order)))))) order))))))
#_(defn tasks->dependees [task-names tasks]
(let [tasks->depends (zipmap task-names (map #(:depends (get tasks %)) task-names))]
(persistent!
(reduce (fn [acc [task depends]]
(reduce (fn [acc dep]
(assoc! acc dep (conj (or (get acc dep)
#{})
task)))
acc depends)) (transient {}) tasks->depends))))
(defn assemble-task [task-name parallel? log-level] (defn assemble-task [task-name parallel? log-level]
(let [task-name (symbol task-name) (let [task-name (symbol task-name)
bb-edn @bb-edn bb-edn @bb-edn
tasks (get bb-edn :tasks) tasks (get bb-edn :tasks)
enter (:enter tasks)
leave (:leave tasks)
log-level (or log-level (:log-level tasks) default-log-level) log-level (or log-level (:log-level tasks) default-log-level)
task (get tasks task-name)] task (get tasks task-name)]
(if task (if task
@ -235,18 +280,31 @@
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 (target-order tasks task-name)
#_#_dependees (tasks->dependees targets tasks)
task-map (cond-> {}
enter (assoc :enter enter)
leave (assoc :leave leave))]
(loop [prog "" (loop [prog ""
targets (seq targets) targets (seq targets)
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 (cond->
(assoc task-map
:name t
#_#_:started done)
#_#_targets (assoc :pending (vec targets))
#_#_depends-on-t (assoc :dependents depends-on-t))]
(if targets (if targets
(if-let [task (get tasks t)] (if-let [task (get tasks t)]
(recur (str prog "\n" (assemble-task-1 t task log-level parallel?)) (recur (str prog "\n" (assemble-task-1 task-map task log-level parallel?))
targets targets
(conj done t)
(concat extra-paths (:extra-paths task)) (concat extra-paths (:extra-paths task))
(merge extra-deps (:extra-deps task)) (merge extra-deps (:extra-deps task))
(concat requires (:requires task))) (concat requires (:requires task)))
@ -256,7 +314,7 @@
(let [prog (str prog "\n" (let [prog (str prog "\n"
(apply str (map deref-task depends)) (apply str (map deref-task depends))
"\n" "\n"
(assemble-task-1 t task log-level parallel? true)) (assemble-task-1 task-map task log-level parallel? true))
extra-paths (concat extra-paths (:extra-paths task)) extra-paths (concat extra-paths (:extra-paths task))
extra-deps (merge extra-deps (:extra-deps task)) extra-deps (merge extra-deps (:extra-deps task))
requires (concat requires (:requires task))] requires (concat requires (:requires task))]
@ -268,7 +326,10 @@
(:extra-paths task) (:extra-paths task)
(:extra-deps task) (:extra-deps task)
(concat requires (:requires task)) (concat requires (:requires task))
(assemble-task-1 task-name task log-level parallel? true))] nil])] (assemble-task-1 (cond-> {:name task-name}
enter (assoc :enter enter)
leave (assoc :leave leave))
task log-level parallel? true))] nil])]
(when (= "true" (System/getenv "BABASHKA_DEV")) (when (= "true" (System/getenv "BABASHKA_DEV"))
(.println System/out (ffirst prog))) (.println System/out (ffirst prog)))
prog) prog)

13
test/babashka/bb_edn_test.clj
View file

@ -143,7 +143,18 @@
(test-utils/with-config {:tasks '{foo {:extra-deps {medley/medley {:mvn/version "1.3.0"}} (test-utils/with-config {:tasks '{foo {:extra-deps {medley/medley {:mvn/version "1.3.0"}}
:requires ([medley.core :as m]) :requires ([medley.core :as m])
:task (m/index-by :id [{:id 1} {:id 2}])}}} :task (m/index-by :id [{:id 1} {:id 2}])}}}
(is (= {1 {:id 1}, 2 {:id 2}} (bb "run" "--prn" "foo")))))) (is (= {1 {:id 1}, 2 {:id 2}} (bb "run" "--prn" "foo")))))
(testing "enter / leave"
(test-utils/with-config '{:tasks {:init (do (def enter-ctx (atom []))
(def leave-ctx (atom [])))
:enter (swap! enter-ctx conj (:name (current-task)))
:leave (swap! leave-ctx conj (:name (current-task)))
foo {:depends [bar]
:task [@enter-ctx @leave-ctx]}
bar {:depends [baz]}
baz {:enter nil
:leave nil}}}
(is (= '[[bar foo] [bar]] (bb "run" "--prn" "foo"))))))
(deftest list-tasks-test (deftest list-tasks-test
(test-utils/with-config {} (test-utils/with-config {}