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

Get rid of conch

Browse source
This commit is contained in:
Michiel Borkent 2021-03-20 12:30:25 +01:00
parent e6905173b6
commit e6b211a030
3 changed files with 159 additions and 173 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
project.clj
View file

@ -67,8 +67,7 @@
:feature/hiccup :feature/hiccup
:feature/test-check :feature/test-check
:feature/spec-alpha :feature/spec-alpha
{:dependencies [[clj-commons/conch "0.9.2"] {:dependencies [[com.clojure-goes-fast/clj-async-profiler "0.4.1"]
[com.clojure-goes-fast/clj-async-profiler "0.4.1"]
[com.opentable.components/otj-pg-embedded "0.13.3"]]}] [com.opentable.components/otj-pg-embedded "0.13.3"]]}]
:uberjar {:global-vars {*assert* false} :uberjar {:global-vars {*assert* false}
:jvm-opts ["-Dclojure.compiler.direct-linking=true" :jvm-opts ["-Dclojure.compiler.direct-linking=true"

309
src/babashka/main.clj
View file

@ -362,172 +362,159 @@ Use -- to separate script command line args from bb command line args.
(println msg) (println msg)
{:exec (fn [] [nil exit])})) {:exec (fn [] [nil exit])}))
(defn parse-opts [options] (def ^:dynamic *bb-edn*
(let [opts (loop [options options
opts-map {}]
(if options
(let [opt (first options)]
(case opt
("--") (assoc opts-map :command-line-args (next options))
("--clojure" ":clojure") (assoc opts-map :clojure true
:command-line-args (rest options))
("--version" ":version") {:version true}
("--help" "-h" "-?") {:help? true}
("--verbose")(recur (next options)
(assoc opts-map
:verbose? true))
("--describe" ":describe") (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" ":uberscript")
(let [options (next options)]
(recur (next options)
(assoc opts-map
:uberscript (first options))))
("--uberjar" ":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" ":repl")
(let [options (next options)]
(recur (next options)
(assoc opts-map
:repl true)))
("--socket-repl" ":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" ":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))))
(":do")
(let [options (next options)
options (into [] (comp (partition-by #(= % ":__"))
(take-nth 2))
options)
parsed (map parse-opts options)]
{:do parsed})
(":invoke")
{:exec-src
(pr-str '(if-let [f (requiring-resolve (symbol (first *command-line-args*)))]
(apply f (rest *command-line-args*))
(throw (Exception. (str "Var not found: " (first *command-line-args*)
" " (babashka.classpath/get-classpath))))))
:command-line-args (next 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)))
(if (fs/exists? opt)
(assoc opts-map
(if (str/ends-with? opt ".jar")
:jar :file) opt
:command-line-args (next options))
(if (str/starts-with? opt ":")
(resolve-task opt {:command-line-args (next options)})
(error (str "File does not exist: " opt) 1))))))))
opts-map))]
opts))
(def bb-edn
(delay (delay
(let [bb-edn-file (or (System/getenv "BABASHKA_EDN") (let [bb-edn-file (or (System/getenv "BABASHKA_EDN")
"bb.edn")] "bb.edn")]
(when (fs/exists? bb-edn-file) (when (fs/exists? bb-edn-file)
(edn/read-string (slurp bb-edn-file)))))) (edn/read-string (slurp bb-edn-file))))))
(defn resolve-task [task {:keys [:command-line-args]}] (defn parse-opts [options]
(if @bb-edn (let [fst (when options (first options))
(if-let [task (get-in @bb-edn [:tasks (keyword (subs task 1))])] key? (when fst (str/starts-with? fst ":"))
(case (:task/type task) k (when key? (keyword (subs fst 1)))
:babashka bb-edn (when k @*bb-edn*)
(let [cmd-line-args (get task :args)] tasks (when (and k bb-edn)
(parse-opts (seq (map str (concat cmd-line-args command-line-args))))) (:tasks bb-edn))
:shell user-task (when tasks (get tasks k))]
(let [args (get task :args) (if user-task (resolve-task user-task {:command-line-args (next options)})
args (into (vec args) command-line-args)] (let [opts (loop [options options
{:exec (fn [] opts-map {}]
[nil (if options
(-> (p/process args {:inherit true}) (let [opt (first options)]
p/check (case opt
:exit)])}) ("--") (assoc opts-map :command-line-args (next options))
(error (str "No such task: " (:task/type task)) 1)) ("--clojure" ":clojure") (assoc opts-map :clojure true
(error (str "No such task: " task) 1)) :command-line-args (rest options))
(error (str "File does not exist: " task) 1))) ("--version" ":version") {:version true}
("--help" "-h" "-?") {:help? true}
("--verbose")(recur (next options)
(assoc opts-map
:verbose? true))
("--describe" ":describe") (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" ":uberscript")
(let [options (next options)]
(recur (next options)
(assoc opts-map
:uberscript (first options))))
("--uberjar" ":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" ":repl")
(let [options (next options)]
(recur (next options)
(assoc opts-map
:repl true)))
("--socket-repl" ":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" ":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))))
(":do")
(let [options (next options)
options (into [] (comp (partition-by #(= % ":--"))
(take-nth 2))
options)
parsed (map parse-opts options)]
{:do parsed})
(":invoke")
{:exec-src
(pr-str '(if-let [f (requiring-resolve (symbol (first *command-line-args*)))]
(apply f (rest *command-line-args*))
(throw (Exception. (str "Var not found: " (first *command-line-args*)
" " (babashka.classpath/get-classpath))))))
:command-line-args (next 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)))
(if (fs/exists? opt)
(assoc opts-map
(if (str/ends-with? opt ".jar")
:jar :file) opt
:command-line-args (next options))
(error (str "File does not exist: " opt) 1)))))))
opts-map))]
opts))))
(def should-load-inits? (def should-load-inits?
"if true, then we should still load preloads and user.clj" "if true, then we should still load preloads and user.clj"
@ -752,7 +739,7 @@ Use -- to separate script command line args from bb command line args.
[& args] [& args]
(handle-pipe!) (handle-pipe!)
(handle-sigint!) (handle-sigint!)
(when-let [bb-edn @bb-edn] (when-let [bb-edn @*bb-edn*]
(deps/add-deps bb-edn)) (deps/add-deps bb-edn))
(if-let [dev-opts (System/getenv "BABASHKA_DEV")] (if-let [dev-opts (System/getenv "BABASHKA_DEV")]
(let [{:keys [:n]} (if (= "true" dev-opts) {:n 1} (let [{:keys [:n]} (if (= "true" dev-opts) {:n 1}

20
test/babashka/test_utils.clj
View file

@ -2,7 +2,7 @@
(:require (:require
[babashka.impl.classpath :as cp] [babashka.impl.classpath :as cp]
[babashka.main :as main] [babashka.main :as main]
[me.raynes.conch :refer [let-programs] :as sh] [babashka.process :as p]
[sci.core :as sci] [sci.core :as sci]
[sci.impl.vars :as vars])) [sci.impl.vars :as vars]))
@ -43,15 +43,15 @@
(vars/bindRoot sci/err *err*))))) (vars/bindRoot sci/err *err*)))))
(defn bb-native [input & args] (defn bb-native [input & args]
(let-programs [bb "./bb"] (let [res (p/process (into ["./bb"] args)
(try (if input {:in input
(apply bb (conj (vec args) :out :string
{:in input})) :err :string})
(apply bb args)) res (deref res)
(catch Exception e exit (:exit res)
(let [d (ex-data e) error? (pos? exit)]
err-msg (or (:stderr (ex-data e)) "")] (if error? (throw (ex-info (or (:err res) "") {}))
(throw (ex-info err-msg d))))))) (:out res))))
(def bb (def bb
(case (System/getenv "BABASHKA_TEST_ENV") (case (System/getenv "BABASHKA_TEST_ENV")