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
(def ctx (volatile! nil))
(def bb-edn (volatile! nil))
(def verbose? (volatile! false))

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

@ -19,6 +19,7 @@
{;; placeholder
'absolute? (sci/copy-var fs/absolute? fns)
'absolutize (sci/copy-var fs/absolutize fns)
'canonicalize (sci/copy-var fs/canonicalize fns)
'components (sci/copy-var fs/components fns)
'copy (sci/copy-var fs/copy fns)
'copy-tree (sci/copy-var fs/copy-tree fns)
@ -52,6 +53,7 @@
'list-dir (sci/copy-var fs/list-dir fns)
'list-dirs (sci/copy-var fs/list-dirs 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)
'normalize (sci/copy-var fs/normalize 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."))))

54
src/babashka/main.clj
View file

@ -31,6 +31,7 @@
[babashka.impl.reify :refer [reify-fn]]
[babashka.impl.repl :as repl]
[babashka.impl.socket-repl :as socket-repl]
[babashka.impl.tasks :as tasks :refer [tasks-namespace]]
[babashka.impl.test :as t]
[babashka.impl.tools.cli :refer [tools-cli-namespace]]
[babashka.nrepl.server :as nrepl-server]
@ -80,9 +81,6 @@
(defn print-version []
(println (str "babashka v" version)))
(def bb-edn
(volatile! nil))
(defn command? [x]
(case x
("clojure"
@ -303,7 +301,8 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
'clojure.core.protocols protocols-namespace
'babashka.process process-namespace
'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/yaml? (assoc 'clj-yaml.core @(resolve 'babashka.impl.yaml/yaml-namespace)
'flatland.ordered.map @(resolve 'babashka.impl.ordered/ordered-map-ns))
@ -405,9 +404,19 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
(line-seq (java.io.BufferedReader. in)))
(defn parse-opts [options]
(let [opt (first options)]
(cond (and (command? opt)
(not (fs/regular-file? opt)))
(let [opt (first options)
tasks (into #{} (map str) (keys (:tasks @common/bb-edn)))]
(when opt
(cond (contains? tasks opt)
{:run opt
:command-line-args (rest options)}
(fs/regular-file? opt)
(if (str/ends-with? opt ".jar")
{:jar opt
:command-line-args (rest options)}
{:file opt
:command-line-args (rest options)})
(command? opt)
(recur (cons (str "--" opt) (next options)))
:else
(let [opts (loop [options options
@ -519,8 +528,15 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
(let [options (next options)]
(recur (next options)
(assoc opts-map :main (first options))))
("--run")
(let [options (next options)]
(recur (next options)
(assoc opts-map :run (first options))))
("--tasks")
(assoc opts-map :list-tasks true
:command-line-args (next options))
;; fallback
(if (some opts-map [:file :jar :socket-repl :expressions :main])
(if (some opts-map [:file :jar :socket-repl :expressions :main :run])
(assoc opts-map
:command-line-args options)
(let [trimmed-opt (str/triml opt)
@ -532,10 +548,11 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
(assoc :command-line-args (next options)))
(assoc opts-map
(if (str/ends-with? opt ".jar")
:jar :file) opt
:jar
:file) opt
:command-line-args (next options)))))))
opts-map))]
opts))))
opts)))))
(def env (atom {}))
@ -552,7 +569,7 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
:verbose? :classpath
:main :uberscript :describe?
:jar :uberjar :clojure
:doc]}
:doc :run :list-tasks]}
opts
_ (when verbose? (vreset! common/verbose? true))
_ (do ;; set properties
@ -577,13 +594,7 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
_ (if classpath
(cp/add-classpath classpath)
;; when classpath isn't set, we calculate it from bb.edn, if present
(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! 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))))
(when-let [bb-edn @common/bb-edn] (deps/add-deps bb-edn)))
abs-path (when file
(let [abs-path (.getAbsolutePath (io/file file))]
(vars/bindRoot sci/file abs-path)
@ -647,6 +658,7 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
"-main")]
[[(format "(ns user (:require [%1$s])) (apply %1$s/%2$s *command-line-args*)"
ns var-name)] nil])
run (tasks/assemble-task run)
file (try [[(read-file file)] nil]
(catch Exception e
(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]
nrepl [(start-nrepl! nrepl sci-ctx) 0]
uberjar [nil 0]
list-tasks [(tasks/list-tasks) 0]
expressions
(sci/binding [sci/file abs-path]
(try
@ -735,6 +748,11 @@ When no eval opts or subcommand is provided, the implicit subcommand is repl.")
exit-code))))
(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)]
(exec opts)))

5
test/babashka/test_utils.clj
View file

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