This commit is contained in:
Michiel Borkent 2021-03-16 17:51:44 +01:00
parent 4d77ee6446
commit 55f38db119

View file

@ -522,189 +522,190 @@ Use -- to separate script command line args from bb command line args.
sci/ns @sci/ns] sci/ns @sci/ns]
(if-let [f (:exec opts)] (if-let [f (:exec opts)]
(f) (f)
(let [{version-opt :version (if (:clojure opts)
:keys [:shell-in :edn-in :shell-out :edn-out (if-let [proc (deps/clojure (:opts opts))]
:help? :file :command-line-args (-> @proc :exit)
:expressions :stream? 0)
:repl :socket-repl :nrepl (let [{version-opt :version
:verbose? :classpath :keys [:shell-in :edn-in :shell-out :edn-out
:main :uberscript :describe? :help? :file :command-line-args
:jar :uberjar :clojure] :as opts} :expressions :stream?
opts :repl :socket-repl :nrepl
_ (when clojure :verbose? :classpath
(if-let [proc (deps/clojure (:opts opts))] :main :uberscript :describe?
(-> @proc :exit (System/exit)) :jar :uberjar]}
(System/exit 0))) opts
_ (when verbose? (vreset! common/verbose? true)) _ (when verbose? (vreset! common/verbose? true))
_ (do ;; set properties _ (do ;; set properties
(when main (System/setProperty "babashka.main" main)) (when main (System/setProperty "babashka.main" main))
(System/setProperty "babashka.version" version)) (System/setProperty "babashka.version" version))
read-next (fn [*in*] read-next (fn [*in*]
(if (pipe-signal-received?) (if (pipe-signal-received?)
::EOF ::EOF
(if stream? (if stream?
(if shell-in (or (read-line) ::EOF) (if shell-in (or (read-line) ::EOF)
(edn/read {:readers edn-readers (edn/read {:readers edn-readers
:eof ::EOF} *in*)) :eof ::EOF} *in*))
(delay (cond shell-in (delay (cond shell-in
(shell-seq *in*) (shell-seq *in*)
edn-in edn-in
(edn-seq *in*) (edn-seq *in*)
:else :else
(edn/read {:readers edn-readers} *in*)))))) (edn/read {:readers edn-readers} *in*))))))
uberscript-sources (atom ()) uberscript-sources (atom ())
env (atom {}) env (atom {})
classpath (or classpath classpath (or classpath
(System/getenv "BABASHKA_CLASSPATH")) (System/getenv "BABASHKA_CLASSPATH"))
_ (when classpath _ (when classpath
(cp/add-classpath classpath)) (cp/add-classpath classpath))
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)
(System/setProperty "babashka.file" abs-path) (System/setProperty "babashka.file" abs-path)
abs-path)) abs-path))
_ (when jar _ (when jar
(cp/add-classpath jar)) (cp/add-classpath jar))
load-fn (fn [{:keys [:namespace :reload]}] load-fn (fn [{:keys [:namespace :reload]}]
(when-let [{:keys [:loader]} (when-let [{:keys [:loader]}
@cp/cp-state] @cp/cp-state]
(if ;; ignore built-in namespaces when uberscripting, unless with :reload (if ;; ignore built-in namespaces when uberscripting, unless with :reload
(and uberscript (and uberscript
(not reload) (not reload)
(or (contains? namespaces namespace) (or (contains? namespaces namespace)
(contains? sci-namespaces/namespaces namespace))) (contains? sci-namespaces/namespaces namespace)))
"" ""
(let [res (cp/source-for-namespace loader namespace nil)] (let [res (cp/source-for-namespace loader namespace nil)]
(when uberscript (swap! uberscript-sources conj (:source res))) (when uberscript (swap! uberscript-sources conj (:source res)))
res)))) res))))
main (if (and jar (not main)) main (if (and jar (not main))
(when-let [res (cp/getResource (when-let [res (cp/getResource
(cp/loader jar) (cp/loader jar)
["META-INF/MANIFEST.MF"] {:url? true})] ["META-INF/MANIFEST.MF"] {:url? true})]
(cp/main-ns res)) (cp/main-ns res))
main) main)
;; TODO: pull more of these values to compile time ;; TODO: pull more of these values to compile time
opts {:aliases aliases opts {:aliases aliases
:namespaces (-> namespaces :namespaces (-> namespaces
(assoc 'clojure.core (assoc 'clojure.core
(assoc core-extras (assoc core-extras
'*command-line-args* '*command-line-args*
(sci/new-dynamic-var '*command-line-args* command-line-args) (sci/new-dynamic-var '*command-line-args* command-line-args)
'*warn-on-reflection* reflection-var '*warn-on-reflection* reflection-var
'load-file load-file*)) 'load-file load-file*))
(assoc-in ['clojure.java.io 'resource] (assoc-in ['clojure.java.io 'resource]
(fn [path] (fn [path]
(when-let [{:keys [:loader]} @cp/cp-state] (when-let [{:keys [:loader]} @cp/cp-state]
(if (str/starts-with? path "/") nil ;; non-relative paths always return nil (if (str/starts-with? path "/") nil ;; non-relative paths always return nil
(cp/getResource loader [path] {:url? true}))))) (cp/getResource loader [path] {:url? true})))))
(assoc-in ['user (with-meta '*input* (assoc-in ['user (with-meta '*input*
(when-not stream? (when-not stream?
{:sci.impl/deref! true}))] input-var)) {:sci.impl/deref! true}))] input-var))
:env env :env env
:features #{:bb :clj} :features #{:bb :clj}
:classes classes/class-map :classes classes/class-map
:imports imports :imports imports
:load-fn load-fn :load-fn load-fn
:uberscript uberscript :uberscript uberscript
:readers core/data-readers :readers core/data-readers
:reify-fn reify-fn :reify-fn reify-fn
:proxy-fn proxy-fn} :proxy-fn proxy-fn}
opts (addons/future opts) opts (addons/future opts)
sci-ctx (sci/init opts) sci-ctx (sci/init opts)
_ (vreset! common/ctx sci-ctx) _ (vreset! common/ctx sci-ctx)
preloads (some-> (System/getenv "BABASHKA_PRELOADS") (str/trim)) preloads (some-> (System/getenv "BABASHKA_PRELOADS") (str/trim))
[expressions exit-code] [expressions exit-code]
(cond expressions [expressions nil] (cond expressions [expressions nil]
main [[(format "(ns user (:require [%1$s])) (apply %1$s/-main *command-line-args*)" main [[(format "(ns user (:require [%1$s])) (apply %1$s/-main *command-line-args*)"
main)] nil] main)] nil]
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
:verbose? verbose?
:preloads preloads
:loader (:loader @cp/cp-state)}))))
expression (str/join " " expressions) ;; this might mess with the locations...
exit-code
;; handle preloads
(if exit-code exit-code
(do (when preloads
(sci/binding [sci/file "<preloads>"]
(try
(sci/eval-string* sci-ctx preloads)
(catch Throwable e
(error-handler e {:expression expression
:verbose? verbose? :verbose? verbose?
:preloads preloads :preloads preloads
:loader (:loader @cp/cp-state)})))) :loader (:loader @cp/cp-state)})))))
expression (str/join " " expressions) ;; this might mess with the locations... nil))
exit-code ;; socket REPL is start asynchronously. when no other args are
;; handle preloads ;; provided, a normal REPL will be started as well, which causes the
(if exit-code exit-code ;; process to wait until SIGINT
(do (when preloads _ (when socket-repl (start-socket-repl! socket-repl sci-ctx))
(sci/binding [sci/file "<preloads>"] exit-code
(try (or exit-code
(sci/eval-string* sci-ctx preloads) (second
(catch Throwable e (cond version-opt
(error-handler e {:expression expression [(print-version) 0]
:verbose? verbose? help?
:preloads preloads [(print-help) 0]
:loader (:loader @cp/cp-state)}))))) describe?
nil)) [(print-describe) 0]
;; socket REPL is start asynchronously. when no other args are repl [(repl/start-repl! sci-ctx) 0]
;; provided, a normal REPL will be started as well, which causes the nrepl [(start-nrepl! nrepl sci-ctx) 0]
;; process to wait until SIGINT uberjar [nil 0]
_ (when socket-repl (start-socket-repl! socket-repl sci-ctx)) expressions
exit-code (sci/binding [sci/file abs-path]
(or exit-code (try
(second (loop []
(cond version-opt (let [in (read-next *in*)]
[(print-version) 0] (if (identical? ::EOF in)
help? [nil 0] ;; done streaming
[(print-help) 0] (let [res [(let [res
describe? (sci/binding [sci/file (or @sci/file "<expr>")
[(print-describe) 0] input-var in]
repl [(repl/start-repl! sci-ctx) 0] (sci/eval-string* sci-ctx expression))]
nrepl [(start-nrepl! nrepl sci-ctx) 0] (when (some? res)
uberjar [nil 0] (if-let [pr-f (cond shell-out println
expressions edn-out prn)]
(sci/binding [sci/file abs-path] (if (coll? res)
(try (doseq [l res
(loop [] :while (not (pipe-signal-received?))]
(let [in (read-next *in*)] (pr-f l))
(if (identical? ::EOF in) (pr-f res))
[nil 0] ;; done streaming (prn res)))) 0]]
(let [res [(let [res (if stream?
(sci/binding [sci/file (or @sci/file "<expr>") (recur)
input-var in] res)))))
(sci/eval-string* sci-ctx expression))] (catch Throwable e
(when (some? res) (error-handler e {:expression expression
(if-let [pr-f (cond shell-out println :verbose? verbose?
edn-out prn)] :preloads preloads
(if (coll? res) :loader (:loader @cp/cp-state)}))))
(doseq [l res uberscript [nil 0]
:while (not (pipe-signal-received?))] :else [(repl/start-repl! sci-ctx) 0]))
(pr-f l)) 1)]
(pr-f res)) (flush)
(prn res)))) 0]] (when uberscript
(if stream? (let [uberscript-out uberscript]
(recur) (spit uberscript-out "") ;; reset file
res))))) (doseq [s (distinct @uberscript-sources)]
(catch Throwable e (spit uberscript-out s :append true))
(error-handler e {:expression expression (spit uberscript-out preloads :append true)
:verbose? verbose? (spit uberscript-out expression :append true)))
:preloads preloads (when uberjar
:loader (:loader @cp/cp-state)})))) (uberjar/run {:dest uberjar
uberscript [nil 0] :jar :uber
:else [(repl/start-repl! sci-ctx) 0])) :classpath classpath
1)] :main-class main
(flush) :verbose verbose?}))
(when uberscript exit-code))))))
(let [uberscript-out uberscript]
(spit uberscript-out "") ;; reset file
(doseq [s (distinct @uberscript-sources)]
(spit uberscript-out s :append true))
(spit uberscript-out preloads :append true)
(spit uberscript-out expression :append true)))
(when uberjar
(uberjar/run {:dest uberjar
:jar :uber
:classpath classpath
:main-class main
:verbose verbose?}))
exit-code)))))
(defn main [& args] (defn main [& args]
(let [opts (parse-opts args)] (let [opts (parse-opts args)]
(if-let [do-opts (:do opts)] (if-let [do-opts (:do opts)]
(reduce (fn [_ opts] (reduce (fn [_ opts]
;; (prn :opts opts)
(let [ret (exec opts)] (let [ret (exec opts)]
(if (pos? ret) (if (pos? ret)
(reduced ret) (reduced ret)