diff --git a/fs b/fs index 580639b6..9e489e8d 160000 --- a/fs +++ b/fs @@ -1 +1 @@ -Subproject commit 580639b6441f4f07755bcc1bfc2ce83f681e9189 +Subproject commit 9e489e8d643a54cf4e7f2a5b8316a64cbf0e32dd diff --git a/src/babashka/impl/common.clj b/src/babashka/impl/common.clj index 6b87a5f5..3fa52fb2 100644 --- a/src/babashka/impl/common.clj +++ b/src/babashka/impl/common.clj @@ -2,4 +2,5 @@ ;; placeholder for ctx (def ctx (volatile! nil)) +(def bb-edn (volatile! nil)) (def verbose? (volatile! false)) diff --git a/src/babashka/impl/fs.clj b/src/babashka/impl/fs.clj index 996a55a6..01ae05b7 100644 --- a/src/babashka/impl/fs.clj +++ b/src/babashka/impl/fs.clj @@ -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) diff --git a/src/babashka/impl/tasks.clj b/src/babashka/impl/tasks.clj new file mode 100644 index 00000000..d4d84b1a --- /dev/null +++ b/src/babashka/impl/tasks.clj @@ -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.")))) + diff --git a/src/babashka/main.clj b/src/babashka/main.clj index ed61ca8a..14d44998 100644 --- a/src/babashka/main.clj +++ b/src/babashka/main.clj @@ -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)) @@ -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.test.alpha @(resolve 'babashka.impl.spec/test-namespace))) features/rewrite-clj? (assoc 'rewrite-clj.node - @(resolve 'babashka.impl.rewrite-clj/node-namespace) - 'rewrite-clj.paredit - @(resolve 'babashka.impl.rewrite-clj/paredit-namespace) - 'rewrite-clj.parser - @(resolve 'babashka.impl.rewrite-clj/parser-namespace) - 'rewrite-clj.zip - @(resolve 'babashka.impl.rewrite-clj/zip-namespace) - 'rewrite-clj.zip.subedit - @(resolve 'babashka.impl.rewrite-clj/subedit-namespace)))) + @(resolve 'babashka.impl.rewrite-clj/node-namespace) + 'rewrite-clj.paredit + @(resolve 'babashka.impl.rewrite-clj/paredit-namespace) + 'rewrite-clj.parser + @(resolve 'babashka.impl.rewrite-clj/parser-namespace) + 'rewrite-clj.zip + @(resolve 'babashka.impl.rewrite-clj/zip-namespace) + 'rewrite-clj.zip.subedit + @(resolve 'babashka.impl.rewrite-clj/subedit-namespace)))) (def imports '{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))) (defn parse-opts [options] - (let [opt (first options)] - (cond (and (command? opt) - (not (fs/regular-file? opt))) - (recur (cons (str "--" opt) (next options))) - :else - (let [opts (loop [options options - opts-map {}] - (if options - (let [opt (first options)] - (case opt - ("--") (assoc opts-map :command-line-args (next options)) - ("--clojure") (assoc opts-map :clojure true - :command-line-args (rest 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) + (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 + opts-map {}] + (if options + (let [opt (first options)] + (case opt + ("--") (assoc opts-map :command-line-args (next options)) + ("--clojure") (assoc opts-map :clojure true + :command-line-args (rest 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 - :describe? true)) - ("--stream") (recur (next options) - (assoc opts-map - :stream? true)) - ("-i") (recur (next options) - (assoc opts-map - :shell-in true)) - ("-I") (recur (next options) - (assoc opts-map - :edn-in true)) - ("-o") (recur (next options) - (assoc opts-map - :shell-out true)) - ("-O") (recur (next options) - (assoc opts-map - :edn-out true)) - ("-io") (recur (next options) - (assoc opts-map - :shell-in true - :shell-out true)) - ("-iO") (recur (next options) - (assoc opts-map - :shell-in true - :edn-out true)) - ("-Io") (recur (next options) - (assoc opts-map - :edn-in true - :shell-out true)) - ("-IO") (recur (next options) - (assoc opts-map - :edn-in true - :edn-out true)) - ("--classpath", "-cp") - (let [options (next options)] - (recur (next options) - (assoc opts-map :classpath (first options)))) - ("--uberscript") - (let [options (next options)] - (recur (next options) - (assoc opts-map - :uberscript (first options)))) - ("--uberjar") - (let [options (next options)] - (recur (next options) - (assoc opts-map - :uberjar (first options)))) - ("-f" "--file") - (let [options (next options)] - (recur (next options) - (assoc opts-map - :file (first options)))) - ("--jar" "-jar") - (let [options (next options)] - (recur (next options) - (assoc opts-map - :jar (first options)))) - ("--repl") - (let [options (next options)] - (recur (next options) - (assoc opts-map - :repl true))) - ("--socket-repl") - (let [options (next options) - opt (first options) - opt (when (and opt (not (str/starts-with? opt "-"))) - opt) - options (if opt (next options) - options)] - (recur options - (assoc opts-map - :socket-repl (or opt "1666")))) - ("--nrepl-server") - (let [options (next options) - opt (first options) - opt (when (and opt (not (str/starts-with? opt "-"))) - opt) - options (if opt (next options) - options)] - (recur options - (assoc opts-map - :nrepl (or opt "1667")))) - ("--eval", "-e") - (let [options (next options)] - (recur (next options) - (update opts-map :expressions (fnil conj []) (first options)))) - ("--main", "-m",) - (let [options (next options)] - (recur (next options) - (assoc opts-map :main (first options)))) - ;; fallback - (if (some opts-map [:file :jar :socket-repl :expressions :main]) - (assoc opts-map - :command-line-args options) - (let [trimmed-opt (str/triml opt) - c (.charAt trimmed-opt 0)] - (case c - (\( \{ \[ \* \@ \#) - (-> opts-map - (update :expressions (fnil conj []) (first options)) - (assoc :command-line-args (next options))) - (assoc opts-map - (if (str/ends-with? opt ".jar") - :jar :file) opt - :command-line-args (next options))))))) - opts-map))] - opts)))) + :stream? true)) + ("-i") (recur (next options) + (assoc opts-map + :shell-in true)) + ("-I") (recur (next options) + (assoc opts-map + :edn-in true)) + ("-o") (recur (next options) + (assoc opts-map + :shell-out true)) + ("-O") (recur (next options) + (assoc opts-map + :edn-out true)) + ("-io") (recur (next options) + (assoc opts-map + :shell-in true + :shell-out true)) + ("-iO") (recur (next options) + (assoc opts-map + :shell-in true + :edn-out true)) + ("-Io") (recur (next options) + (assoc opts-map + :edn-in true + :shell-out true)) + ("-IO") (recur (next options) + (assoc opts-map + :edn-in true + :edn-out true)) + ("--classpath", "-cp") + (let [options (next options)] + (recur (next options) + (assoc opts-map :classpath (first options)))) + ("--uberscript") + (let [options (next options)] + (recur (next options) + (assoc opts-map + :uberscript (first options)))) + ("--uberjar") + (let [options (next options)] + (recur (next options) + (assoc opts-map + :uberjar (first options)))) + ("-f" "--file") + (let [options (next options)] + (recur (next options) + (assoc opts-map + :file (first options)))) + ("--jar" "-jar") + (let [options (next options)] + (recur (next options) + (assoc opts-map + :jar (first options)))) + ("--repl") + (let [options (next options)] + (recur (next options) + (assoc opts-map + :repl true))) + ("--socket-repl") + (let [options (next options) + opt (first options) + opt (when (and opt (not (str/starts-with? opt "-"))) + opt) + options (if opt (next options) + options)] + (recur options + (assoc opts-map + :socket-repl (or opt "1666")))) + ("--nrepl-server") + (let [options (next options) + opt (first options) + opt (when (and opt (not (str/starts-with? opt "-"))) + opt) + options (if opt (next options) + options)] + (recur options + (assoc opts-map + :nrepl (or opt "1667")))) + ("--eval", "-e") + (let [options (next options)] + (recur (next options) + (update opts-map :expressions (fnil conj []) (first options)))) + ("--main", "-m",) + (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 :run]) + (assoc opts-map + :command-line-args options) + (let [trimmed-opt (str/triml opt) + c (.charAt trimmed-opt 0)] + (case c + (\( \{ \[ \* \@ \#) + (-> opts-map + (update :expressions (fnil conj []) (first options)) + (assoc :command-line-args (next options))) + (assoc opts-map + (if (str/ends-with? opt ".jar") + :jar + :file) opt + :command-line-args (next options))))))) + opts-map))] + 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))) diff --git a/test/babashka/test_utils.clj b/test/babashka/test_utils.clj index 894bc138..720765bc 100644 --- a/test/babashka/test_utils.clj +++ b/test/babashka/test_utils.clj @@ -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.))