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

[#788] First cut of bb tasks

Browse source
This commit is contained in:
Michiel Borkent 2021-04-10 14:42:58 +02:00 committed by GitHub
parent 4dac03da26
commit 1020a8c335
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
6 changed files with 316 additions and 154 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
fs

@ -1 +1 @@
Subproject commit 580639b6441f4f07755bcc1bfc2ce83f681e9189 Subproject commit 9e489e8d643a54cf4e7f2a5b8316a64cbf0e32dd

1
src/babashka/impl/common.clj
View file

@ -2,4 +2,5 @@
;; placeholder for ctx ;; placeholder for ctx
(def ctx (volatile! nil)) (def ctx (volatile! nil))
(def bb-edn (volatile! nil))
(def verbose? (volatile! false)) (def verbose? (volatile! false))

2
src/babashka/impl/fs.clj
View file

@ -19,6 +19,7 @@
{;; placeholder {;; placeholder
'absolute? (sci/copy-var fs/absolute? fns) 'absolute? (sci/copy-var fs/absolute? fns)
'absolutize (sci/copy-var fs/absolutize fns) 'absolutize (sci/copy-var fs/absolutize fns)
'canonicalize (sci/copy-var fs/canonicalize fns)
'components (sci/copy-var fs/components fns) 'components (sci/copy-var fs/components fns)
'copy (sci/copy-var fs/copy fns) 'copy (sci/copy-var fs/copy fns)
'copy-tree (sci/copy-var fs/copy-tree fns) 'copy-tree (sci/copy-var fs/copy-tree fns)
@ -52,6 +53,7 @@
'list-dir (sci/copy-var fs/list-dir fns) 'list-dir (sci/copy-var fs/list-dir fns)
'list-dirs (sci/copy-var fs/list-dirs fns) 'list-dirs (sci/copy-var fs/list-dirs fns)
'millis->file-time (sci/copy-var fs/millis->file-time fns) 'millis->file-time (sci/copy-var fs/millis->file-time fns)
'modified-since (sci/copy-var fs/modified-since fns)
'move (sci/copy-var fs/move fns) 'move (sci/copy-var fs/move fns)
'normalize (sci/copy-var fs/normalize fns) 'normalize (sci/copy-var fs/normalize fns)
'parent (sci/copy-var fs/parent fns) 'parent (sci/copy-var fs/parent fns)

140
src/babashka/impl/tasks.clj Normal file
View file

@ -0,0 +1,140 @@
(ns babashka.impl.tasks
(:require [babashka.impl.common :refer [bb-edn]]
[babashka.impl.deps :as deps]
[babashka.process :as p]
[clojure.java.io :as io]
[clojure.string :as str]
[sci.core :as sci]))
(def sci-ns (sci/create-ns 'babashka.tasks nil))
(defn- exit-non-zero [proc]
(when-let [exit-code (some-> proc deref :exit)]
(when (not (zero? exit-code))
(System/exit exit-code))))
(defn shell [cmd & args]
(let [[opts cmd args]
(if (map? cmd)
[cmd (first args) (rest args)]
[nil cmd args])
opts (if-let [o (:out opts)]
(if (string? o)
(update opts :out io/file)
opts)
opts)]
(exit-non-zero
(p/process (into (p/tokenize cmd) args)
(merge {:in :inherit
:out :inherit
:err :inherit} opts)))))
(defn clojure [cmd & args]
(let [[opts cmd args]
(if (map? cmd)
[cmd (first args) (rest args)]
[nil cmd args])
opts (if-let [o (:out opts)]
(if (string? o)
(update opts :out io/file)
opts)
opts)]
(exit-non-zero
(deps/clojure (into (p/tokenize cmd) args)
(merge {:in :inherit
:out :inherit
:err :inherit} opts)))))
(def tasks-namespace
{'shell (sci/copy-var shell sci-ns)
'clojure (sci/copy-var clojure sci-ns)})
(defn depends-map [tasks target-name]
(let [deps (seq (:depends (get tasks target-name)))
m [target-name deps]]
(into {} (cons m (map #(depends-map tasks %) deps)))))
(defn assemble-task-1
"Assembles task, does not process :depends."
[task]
(cond (qualified-symbol? task)
(format "
(do (require (quote %s))
(apply %s *command-line-args*))"
(namespace task)
task)
(map? task)
(let [task (:task task)]
(assemble-task-1 task))
:else task))
(defn format-task [init when-expr prog]
(format "
(require '[babashka.tasks :refer [shell clojure]])
%s
%s"
(str init)
(if when-expr
(format "(when %s %s)"
when-expr prog)
prog)))
(defn target-order
([tasks task-name] (target-order tasks task-name (volatile! #{})))
([tasks task-name processed]
(let [task (tasks task-name)
depends (:depends task)]
(loop [deps (seq depends)]
(let [p @processed
deps (remove #(contains? p %) deps)
order (vec (mapcat #(target-order tasks % processed) deps))]
(vswap! processed conj task-name)
(conj order task-name))))))
(defn assemble-task [task-name]
(let [task-name (symbol task-name)
tasks (get @bb-edn :tasks)
task (get tasks task-name)]
(if task
(let [init (get tasks :init)
when-expr (get task :when)
prog (if (:depends task)
(let [targets (target-order tasks task-name)]
(loop [prog ""
targets (seq targets)]
(if-let [t (first targets)]
(if-let [task (get tasks t)]
(recur (str prog "\n" (assemble-task-1 task))
(next targets))
[(binding [*out* *err*]
(println "No such task:" task-name)) 1])
[[(format-task init when-expr prog)] nil])))
[[(format-task init when-expr (assemble-task-1 task))] nil])]
prog)
[(binding [*out* *err*]
(println "No such task:" task-name)) 1])))
(defn list-tasks
[]
(let [tasks (:tasks @bb-edn)]
(if (seq tasks)
(let [names (keys tasks)
raw-names (filter symbol? names)
names (map str raw-names)
names (sort names)
longest (apply max (map count names))
fmt (str "%1$-" longest "s")]
(println "The following tasks are available:")
(println)
(doseq [k raw-names
:let [task (get tasks k)]]
(when-not (or (str/starts-with? k "-")
(:private task))
(let [task (if (qualified-symbol? task)
{:doc (format "Runs %s. See `bb doc %s` for more info." task task)}
task)]
(println (str (format fmt k)
(when-let [d (:doc task)]
(str " " d))))))))
(println "No tasks found."))))

320
src/babashka/main.clj
View file

@ -31,6 +31,7 @@
[babashka.impl.reify :refer [reify-fn]] [babashka.impl.reify :refer [reify-fn]]
[babashka.impl.repl :as repl] [babashka.impl.repl :as repl]
[babashka.impl.socket-repl :as socket-repl] [babashka.impl.socket-repl :as socket-repl]
[babashka.impl.tasks :as tasks :refer [tasks-namespace]]
[babashka.impl.test :as t] [babashka.impl.test :as t]
[babashka.impl.tools.cli :refer [tools-cli-namespace]] [babashka.impl.tools.cli :refer [tools-cli-namespace]]
[babashka.nrepl.server :as nrepl-server] [babashka.nrepl.server :as nrepl-server]
@ -80,9 +81,6 @@
(defn print-version [] (defn print-version []
(println (str "babashka v" version))) (println (str "babashka v" version)))
(def bb-edn
(volatile! nil))
(defn command? [x] (defn command? [x]
(case x (case x
("clojure" ("clojure"
@ -303,7 +301,8 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
'clojure.core.protocols protocols-namespace 'clojure.core.protocols protocols-namespace
'babashka.process process-namespace 'babashka.process process-namespace
'clojure.core.server clojure-core-server 'clojure.core.server clojure-core-server
'babashka.deps deps-namespace} 'babashka.deps deps-namespace
'babashka.tasks tasks-namespace}
features/xml? (assoc 'clojure.data.xml @(resolve 'babashka.impl.xml/xml-namespace)) features/xml? (assoc 'clojure.data.xml @(resolve 'babashka.impl.xml/xml-namespace))
features/yaml? (assoc 'clj-yaml.core @(resolve 'babashka.impl.yaml/yaml-namespace) features/yaml? (assoc 'clj-yaml.core @(resolve 'babashka.impl.yaml/yaml-namespace)
'flatland.ordered.map @(resolve 'babashka.impl.ordered/ordered-map-ns)) 'flatland.ordered.map @(resolve 'babashka.impl.ordered/ordered-map-ns))
@ -341,15 +340,15 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
'clojure.spec.gen.alpha @(resolve 'babashka.impl.spec/gen-namespace) 'clojure.spec.gen.alpha @(resolve 'babashka.impl.spec/gen-namespace)
'clojure.spec.test.alpha @(resolve 'babashka.impl.spec/test-namespace))) 'clojure.spec.test.alpha @(resolve 'babashka.impl.spec/test-namespace)))
features/rewrite-clj? (assoc 'rewrite-clj.node features/rewrite-clj? (assoc 'rewrite-clj.node
@(resolve 'babashka.impl.rewrite-clj/node-namespace) @(resolve 'babashka.impl.rewrite-clj/node-namespace)
'rewrite-clj.paredit 'rewrite-clj.paredit
@(resolve 'babashka.impl.rewrite-clj/paredit-namespace) @(resolve 'babashka.impl.rewrite-clj/paredit-namespace)
'rewrite-clj.parser 'rewrite-clj.parser
@(resolve 'babashka.impl.rewrite-clj/parser-namespace) @(resolve 'babashka.impl.rewrite-clj/parser-namespace)
'rewrite-clj.zip 'rewrite-clj.zip
@(resolve 'babashka.impl.rewrite-clj/zip-namespace) @(resolve 'babashka.impl.rewrite-clj/zip-namespace)
'rewrite-clj.zip.subedit 'rewrite-clj.zip.subedit
@(resolve 'babashka.impl.rewrite-clj/subedit-namespace)))) @(resolve 'babashka.impl.rewrite-clj/subedit-namespace))))
(def imports (def imports
'{ArithmeticException java.lang.ArithmeticException '{ArithmeticException java.lang.ArithmeticException
@ -405,137 +404,155 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
(line-seq (java.io.BufferedReader. in))) (line-seq (java.io.BufferedReader. in)))
(defn parse-opts [options] (defn parse-opts [options]
(let [opt (first options)] (let [opt (first options)
(cond (and (command? opt) tasks (into #{} (map str) (keys (:tasks @common/bb-edn)))]
(not (fs/regular-file? opt))) (when opt
(recur (cons (str "--" opt) (next options))) (cond (contains? tasks opt)
:else {:run opt
(let [opts (loop [options options :command-line-args (rest options)}
opts-map {}] (fs/regular-file? opt)
(if options (if (str/ends-with? opt ".jar")
(let [opt (first options)] {:jar opt
(case opt :command-line-args (rest options)}
("--") (assoc opts-map :command-line-args (next options)) {:file opt
("--clojure") (assoc opts-map :clojure true :command-line-args (rest options)})
:command-line-args (rest options)) (command? opt)
("--version") {:version true} (recur (cons (str "--" opt) (next options)))
("--help" "-h" "-?" "help") :else
{:help true (let [opts (loop [options options
:command-line-args (rest options)} opts-map {}]
("--doc") (if options
{:doc true (let [opt (first options)]
:command-line-args (rest options)} (case opt
("--verbose") (recur (next options) ("--") (assoc opts-map :command-line-args (next options))
(assoc opts-map ("--clojure") (assoc opts-map :clojure true
:verbose? true)) :command-line-args (rest options))
("--describe") (recur (next options) ("--version") {:version true}
("--help" "-h" "-?" "help")
{:help true
:command-line-args (rest options)}
("--doc")
{:doc true
:command-line-args (rest options)}
("--verbose") (recur (next options)
(assoc opts-map
:verbose? true))
("--describe") (recur (next options)
(assoc opts-map
:describe? true))
("--stream") (recur (next options)
(assoc opts-map (assoc opts-map
:describe? true)) :stream? true))
("--stream") (recur (next options) ("-i") (recur (next options)
(assoc opts-map (assoc opts-map
:stream? true)) :shell-in true))
("-i") (recur (next options) ("-I") (recur (next options)
(assoc opts-map (assoc opts-map
:shell-in true)) :edn-in true))
("-I") (recur (next options) ("-o") (recur (next options)
(assoc opts-map (assoc opts-map
:edn-in true)) :shell-out true))
("-o") (recur (next options) ("-O") (recur (next options)
(assoc opts-map (assoc opts-map
:shell-out true)) :edn-out true))
("-O") (recur (next options) ("-io") (recur (next options)
(assoc opts-map (assoc opts-map
:edn-out true)) :shell-in true
("-io") (recur (next options) :shell-out true))
(assoc opts-map ("-iO") (recur (next options)
:shell-in true (assoc opts-map
:shell-out true)) :shell-in true
("-iO") (recur (next options) :edn-out true))
(assoc opts-map ("-Io") (recur (next options)
:shell-in true (assoc opts-map
:edn-out true)) :edn-in true
("-Io") (recur (next options) :shell-out true))
(assoc opts-map ("-IO") (recur (next options)
:edn-in true (assoc opts-map
:shell-out true)) :edn-in true
("-IO") (recur (next options) :edn-out true))
(assoc opts-map ("--classpath", "-cp")
:edn-in true (let [options (next options)]
:edn-out true)) (recur (next options)
("--classpath", "-cp") (assoc opts-map :classpath (first options))))
(let [options (next options)] ("--uberscript")
(recur (next options) (let [options (next options)]
(assoc opts-map :classpath (first options)))) (recur (next options)
("--uberscript") (assoc opts-map
(let [options (next options)] :uberscript (first options))))
(recur (next options) ("--uberjar")
(assoc opts-map (let [options (next options)]
:uberscript (first options)))) (recur (next options)
("--uberjar") (assoc opts-map
(let [options (next options)] :uberjar (first options))))
(recur (next options) ("-f" "--file")
(assoc opts-map (let [options (next options)]
:uberjar (first options)))) (recur (next options)
("-f" "--file") (assoc opts-map
(let [options (next options)] :file (first options))))
(recur (next options) ("--jar" "-jar")
(assoc opts-map (let [options (next options)]
:file (first options)))) (recur (next options)
("--jar" "-jar") (assoc opts-map
(let [options (next options)] :jar (first options))))
(recur (next options) ("--repl")
(assoc opts-map (let [options (next options)]
:jar (first options)))) (recur (next options)
("--repl") (assoc opts-map
(let [options (next options)] :repl true)))
(recur (next options) ("--socket-repl")
(assoc opts-map (let [options (next options)
:repl true))) opt (first options)
("--socket-repl") opt (when (and opt (not (str/starts-with? opt "-")))
(let [options (next options) opt)
opt (first options) options (if opt (next options)
opt (when (and opt (not (str/starts-with? opt "-"))) options)]
opt) (recur options
options (if opt (next options) (assoc opts-map
options)] :socket-repl (or opt "1666"))))
(recur options ("--nrepl-server")
(assoc opts-map (let [options (next options)
:socket-repl (or opt "1666")))) opt (first options)
("--nrepl-server") opt (when (and opt (not (str/starts-with? opt "-")))
(let [options (next options) opt)
opt (first options) options (if opt (next options)
opt (when (and opt (not (str/starts-with? opt "-"))) options)]
opt) (recur options
options (if opt (next options) (assoc opts-map
options)] :nrepl (or opt "1667"))))
(recur options ("--eval", "-e")
(assoc opts-map (let [options (next options)]
:nrepl (or opt "1667")))) (recur (next options)
("--eval", "-e") (update opts-map :expressions (fnil conj []) (first options))))
(let [options (next options)] ("--main", "-m",)
(recur (next options) (let [options (next options)]
(update opts-map :expressions (fnil conj []) (first options)))) (recur (next options)
("--main", "-m",) (assoc opts-map :main (first options))))
(let [options (next options)] ("--run")
(recur (next options) (let [options (next options)]
(assoc opts-map :main (first options)))) (recur (next options)
;; fallback (assoc opts-map :run (first options))))
(if (some opts-map [:file :jar :socket-repl :expressions :main]) ("--tasks")
(assoc opts-map (assoc opts-map :list-tasks true
:command-line-args options) :command-line-args (next options))
(let [trimmed-opt (str/triml opt) ;; fallback
c (.charAt trimmed-opt 0)] (if (some opts-map [:file :jar :socket-repl :expressions :main :run])
(case c (assoc opts-map
(\( \{ \[ \* \@ \#) :command-line-args options)
(-> opts-map (let [trimmed-opt (str/triml opt)
(update :expressions (fnil conj []) (first options)) c (.charAt trimmed-opt 0)]
(assoc :command-line-args (next options))) (case c
(assoc opts-map (\( \{ \[ \* \@ \#)
(if (str/ends-with? opt ".jar") (-> opts-map
:jar :file) opt (update :expressions (fnil conj []) (first options))
:command-line-args (next options))))))) (assoc :command-line-args (next options)))
opts-map))] (assoc opts-map
opts)))) (if (str/ends-with? opt ".jar")
:jar
:file) opt
:command-line-args (next options)))))))
opts-map))]
opts)))))
(def env (atom {})) (def env (atom {}))
@ -552,7 +569,7 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
:verbose? :classpath :verbose? :classpath
:main :uberscript :describe? :main :uberscript :describe?
:jar :uberjar :clojure :jar :uberjar :clojure
:doc]} :doc :run :list-tasks]}
opts opts
_ (when verbose? (vreset! common/verbose? true)) _ (when verbose? (vreset! common/verbose? true))
_ (do ;; set properties _ (do ;; set properties
@ -577,13 +594,7 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
_ (if classpath _ (if classpath
(cp/add-classpath classpath) (cp/add-classpath classpath)
;; when classpath isn't set, we calculate it from bb.edn, if present ;; when classpath isn't set, we calculate it from bb.edn, if present
(let [bb-edn-file (or (System/getenv "BABASHKA_EDN") (when-let [bb-edn @common/bb-edn] (deps/add-deps bb-edn)))
"bb.edn")]
(when (fs/exists? bb-edn-file)
(let [edn (edn/read-string (slurp bb-edn-file))]
(vreset! bb-edn edn)))
;; we mutate the atom from tests as well, so despite the above it can contain a bb.edn
(when-let [bb-edn @bb-edn] (deps/add-deps bb-edn))))
abs-path (when file abs-path (when file
(let [abs-path (.getAbsolutePath (io/file file))] (let [abs-path (.getAbsolutePath (io/file file))]
(vars/bindRoot sci/file abs-path) (vars/bindRoot sci/file abs-path)
@ -647,6 +658,7 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
"-main")] "-main")]
[[(format "(ns user (:require [%1$s])) (apply %1$s/%2$s *command-line-args*)" [[(format "(ns user (:require [%1$s])) (apply %1$s/%2$s *command-line-args*)"
ns var-name)] nil]) ns var-name)] nil])
run (tasks/assemble-task run)
file (try [[(read-file file)] nil] file (try [[(read-file file)] nil]
(catch Exception e (catch Exception e
(error-handler e {:expression expressions (error-handler e {:expression expressions
@ -683,6 +695,7 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
repl [(repl/start-repl! sci-ctx) 0] repl [(repl/start-repl! sci-ctx) 0]
nrepl [(start-nrepl! nrepl sci-ctx) 0] nrepl [(start-nrepl! nrepl sci-ctx) 0]
uberjar [nil 0] uberjar [nil 0]
list-tasks [(tasks/list-tasks) 0]
expressions expressions
(sci/binding [sci/file abs-path] (sci/binding [sci/file abs-path]
(try (try
@ -735,6 +748,11 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
exit-code)))) exit-code))))
(defn main [& args] (defn main [& args]
(let [bb-edn-file (or (System/getenv "BABASHKA_EDN")
"bb.edn")]
(when (fs/exists? bb-edn-file)
(let [edn (edn/read-string (slurp bb-edn-file))]
(vreset! common/bb-edn edn))))
(let [opts (parse-opts args)] (let [opts (parse-opts args)]
(exec opts))) (exec opts)))

5
test/babashka/test_utils.clj
View file

@ -2,6 +2,7 @@
(:require (:require
[babashka.fs :as fs] [babashka.fs :as fs]
[babashka.impl.classpath :as cp] [babashka.impl.classpath :as cp]
[babashka.impl.common :as common]
[babashka.main :as main] [babashka.main :as main]
[babashka.process :as p] [babashka.process :as p]
[clojure.edn :as edn] [clojure.edn :as edn]
@ -28,8 +29,8 @@
(reset! cp/cp-state nil) (reset! cp/cp-state nil)
(reset! main/env {}) (reset! main/env {})
(if-let [path *bb-edn-path*] (if-let [path *bb-edn-path*]
(vreset! main/bb-edn (edn/read-string (slurp path))) (vreset! common/bb-edn (edn/read-string (slurp path)))
(vreset! main/bb-edn nil)) (vreset! common/bb-edn nil))
(let [os (java.io.StringWriter.) (let [os (java.io.StringWriter.)
es (if-let [err (:err input-or-opts)] es (if-let [err (:err input-or-opts)]
err (java.io.StringWriter.)) err (java.io.StringWriter.))