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

[#584, #1037] Uberscript in bb (#1115)

Browse source
This commit is contained in:
Michiel Borkent 2021-12-23 21:23:11 +01:00 committed by GitHub
parent 3a30a11c1f
commit 93fb4379ff
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
6 changed files with 358 additions and 220 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
sci

@ -1 +1 @@
Subproject commit 6ad100c7376bfac0f58ac12576caa805e2026d33
Subproject commit f29089b68e2e7d41e9491be0c1d7c48e1b9691e7

105
src/babashka/impl/uberscript.clj Normal file
View file

@ -0,0 +1,105 @@
(ns babashka.impl.uberscript
(:require [sci.core :as sci]))
(defn decompose-clause [clause]
(if (symbol? clause)
{:ns clause}
(when (seqable? clause)
(let [clause (if (= 'quote (first clause))
(second clause)
clause)
[ns & tail] clause]
(loop [parsed {:ns ns}
tail (seq tail)]
(if tail
(let [ftail (first tail)]
(case ftail
:as (recur (assoc parsed :as (second tail))
(nnext tail))
:refer
(let [refer (second tail)]
(if (seqable? refer)
(recur (assoc parsed :refer (second tail))
(nnext tail))
(recur parsed (nnext tail))))
;; default
(recur parsed
(nnext tail))))
parsed))))))
(defn recompose-clause [{:keys [:ns :as]}]
[ns :as as])
(defn process-ns
[_ctx ns]
(keep (fn [x]
(if (seqable? x)
(let [fx (first x)]
(when (identical? :require fx)
(let [decomposed (keep decompose-clause (rest x))
recomposed (map recompose-clause decomposed)]
(list* :require recomposed))))
x))
ns))
(defn keep-quoted [clauses]
(keep (fn [clause]
(when (and (seq? clause) (= 'quote (first clause)))
(second clause)))
clauses))
(defn process-require [_ctx req]
(let [quoted (keep-quoted (rest req))
decomposed (map decompose-clause quoted)]
(list* 'require (map (fn [clause]
(list 'quote (recompose-clause clause)))
decomposed))))
(defn process-in-ns [_ctx req]
(let [quoted (keep-quoted (rest req))
quoted (map (fn [ns]
(list 'quote ns))
quoted)]
(when (clojure.core/seq quoted)
(list* 'in-ns quoted))))
(defn loc [rdr]
(str (when-let [f @sci/file]
(str f ":"))
(sci/get-line-number rdr)
":"
(sci/get-column-number rdr)))
(defn uberscript [{:keys [ctx expressions]}]
(let [ctx (assoc ctx :reload-all true)]
(sci/binding [sci/file @sci/file]
(doseq [expr expressions]
(let [rdr (sci/reader expr)]
(loop []
(let [next-val
(try (sci/parse-next ctx rdr)
;; swallow reader error
(catch Exception _e
(binding [*out* *err*]
(println "[babashka]" "Ignoring read error while assembling uberscript near"
(loc rdr)))))]
;; (.println System/err (pr-str next-val))
(when-not (= ::sci/eof next-val)
(if (seq? next-val)
(let [fst (first next-val)
expr (cond (= 'ns fst)
(process-ns ctx next-val)
(= 'require fst)
(process-require ctx next-val)
(= 'in-ns fst)
(process-in-ns ctx next-val))]
(when expr
(try
(sci/eval-form ctx expr)
;; swallow exception and continue
(catch Exception _e
(binding [*out* *err*]
(println "[babashka]" "Ignoring expression while assembling uberscript:"
expr "near" (loc rdr))))))
(recur))
(recur))))))))))

17
src/babashka/main.clj
View file

@ -41,6 +41,7 @@
[babashka.impl.tasks :as tasks :refer [tasks-namespace]]
[babashka.impl.test :as t]
[babashka.impl.tools.cli :refer [tools-cli-namespace]]
[babashka.impl.uberscript :as uberscript]
[babashka.nrepl.server :as nrepl-server]
[babashka.wait :refer [wait-namespace]]
[clojure.edn :as edn]
@ -727,9 +728,13 @@ Use bb run --help to show this help output.
(or (contains? namespaces namespace)
(contains? sci-namespaces/namespaces namespace)))
""
(let [res (cp/source-for-namespace loader namespace nil)]
(when uberscript (swap! uberscript-sources conj (:source res)))
res)))
(when-let [res (cp/source-for-namespace loader namespace nil)]
(if uberscript
(do (swap! uberscript-sources conj (:source res))
(uberscript/uberscript {:ctx @common/ctx
:expressions [(:source res)]})
{})
res))))
(case namespace
clojure.spec.alpha
(binding [*out* *err*]
@ -833,7 +838,12 @@ Use bb run --help to show this help output.
uberjar [nil 0]
list-tasks [(tasks/list-tasks sci-ctx) 0]
print-deps [(print-deps/print-deps (:print-deps-format cli-opts)) 0]
uberscript
[nil (do (uberscript/uberscript {:ctx sci-ctx
:expressions expressions})
0)]
expressions
;; execute code
(sci/binding [sci/file abs-path]
(try
; when evaluating expression(s), add in repl-requires so things like
@ -871,7 +881,6 @@ Use bb run --help to show this help output.
clojure [nil (if-let [proc (bdeps/clojure command-line-args)]
(-> @proc :exit)
0)]
uberscript [nil 0]
:else [(repl/start-repl! sci-ctx) 0]))
1)]
(flush)

15
test-resources/babashka/uberscript/src/my/impl1.clj
View file

@ -1,5 +1,18 @@
(ns my.impl1
(:require [clojure.string]))
(:require [babashka.pods :as pods]
[clojure.string :as str]))
;; uberscript parser can parse and skip this
(prn ::str/foo)
str/join
(alias 'a 'clojure.string)
::a/foo ;; no error either
(pods/load-pod 'clj-kondo/clj-kondo "2021.10.19")
(require '[pod.borkdude.clj-kondo :as clj-kondo])
(prn (some? clj-kondo/run!))
(defn impl-fn
"identity"

4
test/babashka/test_utils.clj
View file

@ -75,7 +75,9 @@
(with-in-str input-or-opts (apply main/main args))
(apply main/main args)))]
(if (zero? res)
(normalize (str os))
(do
(println (str es)) ;; flush stderr
(normalize (str os)))
(do
(println (str os))
(throw (ex-info (str es)

21
test/babashka/uberscript_test.clj
View file

@ -1,16 +1,25 @@
(ns babashka.uberscript-test
(:require
[babashka.test-utils :as tu]
[clojure.test :as t :refer [deftest is testing]]))
[clojure.test :as t :refer [deftest is]]))
(deftest uberscript-test
(deftest basic-test
(let [tmp-file (java.io.File/createTempFile "uberscript" ".clj")]
(.deleteOnExit tmp-file)
(is (empty? (tu/bb nil "--classpath" "test-resources/babashka/src_for_classpath_test" "uberscript" (.getPath tmp-file) "-m" "my.main")))
(is (= "(\"1\" \"2\" \"3\" \"4\")\n"
(tu/bb nil "--file" (.getPath tmp-file) "1" "2" "3" "4")))
(testing "order of namespaces is correct"
(tu/bb nil "--classpath" "test-resources/babashka/uberscript/src" "uberscript" (.getPath tmp-file) "-m" "my.main")
(is (= "(\"1\" \"2\" \"3\" \"4\")\n"
(tu/bb nil "--file" (.getPath tmp-file) "1" "2" "3" "4")))))
(when-not (= "aarch64" (System/getenv "BABASHKA_ARCH"))
(deftest advanced-test
(let [tmp-file (java.io.File/createTempFile "uberscript" ".clj")]
(.deleteOnExit tmp-file)
;; we test:
;; order of namespaces
;; reader error for ::a/foo is swallowed
;; pod namespaces can be loaded without a problem
;; resulting program can be executed
(is (empty? (tu/bb nil "--classpath" "test-resources/babashka/uberscript/src" "uberscript" (.getPath tmp-file) "-m" "my.main")))
(is (= ":clojure.string/foo\ntrue\n(\"1\" \"2\" \"3\" \"4\")\n"
(tu/bb nil "--file" (.getPath tmp-file) "1" "2" "3" "4"))))))