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

sci

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

src/babashka/impl/uberscript.clj

@@ -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))))))))))

src/babashka/main.clj

@@ -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-let [res (cp/source-for-namespace loader namespace nil)]
-                                (when uberscript (swap! uberscript-sources conj (:source res)))
+                                (if uberscript
-                                res)))
+                                  (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)
@@ -893,16 +902,16 @@ Use bb run --help to show this help output.
     exit-code))))
 
 (defn satisfies-min-version? [min-version]
-  (let [[major-current minor-current patch-current] version-data
+(let [[major-current minor-current patch-current] version-data
       [major-min minor-min patch-min] (parse-version min-version)]
-    (or (> major-current major-min)
+(or (> major-current major-min)
     (and (= major-current major-min)
          (or (> minor-current minor-min)
              (and (= minor-current minor-min)
                   (>= patch-current patch-min)))))))
 
 (defn main [& args]
-  (let [bb-edn-file (or (System/getenv "BABASHKA_EDN")
+(let [bb-edn-file (or (System/getenv "BABASHKA_EDN")
                       "bb.edn")
       bb-edn (or (when (fs/exists? bb-edn-file)
                    (let [raw-string (slurp bb-edn-file)
@@ -912,40 +921,40 @@ Use bb run --help to show this help output.
                  ;; tests may have modified bb-edn
                  @common/bb-edn)
       min-bb-version (:min-bb-version bb-edn)]
-    (when min-bb-version
+(when min-bb-version
   (when-not (satisfies-min-version? min-bb-version)
     (binding [*out* *err*]
       (println (str "WARNING: this project requires babashka "
                     min-bb-version " or newer, but you have: " version))))))
-  (let [opts (parse-opts args)]
+(let [opts (parse-opts args)]
-    (exec opts)))
+(exec opts)))
 
 (def musl?
-  "Captured at compile time, to know if we are running inside a
+"Captured at compile time, to know if we are running inside a
   statically compiled executable with musl."
-  (and (= "true" (System/getenv "BABASHKA_STATIC"))
+(and (= "true" (System/getenv "BABASHKA_STATIC"))
-       (= "true" (System/getenv "BABASHKA_MUSL"))))
+(= "true" (System/getenv "BABASHKA_MUSL"))))
 
 (defmacro run [args]
-  (if musl?
+(if musl?
-    ;; When running in musl-compiled static executable we lift execution of bb
+;; When running in musl-compiled static executable we lift execution of bb
-    ;; inside a thread, so we have a larger than default stack size, set by an
+;; inside a thread, so we have a larger than default stack size, set by an
-    ;; argument to the linker. See https://github.com/oracle/graal/issues/3398
+;; argument to the linker. See https://github.com/oracle/graal/issues/3398
-    `(let [v# (volatile! nil)
+`(let [v# (volatile! nil)
        f# (fn []
             (vreset! v# (apply main ~args)))]
    (doto (Thread. nil f# "main")
      (.start)
      (.join))
    @v#)
-    `(apply main ~args)))
+`(apply main ~args)))
 
 (defn -main
-  [& args]
+[& args]
-  (handle-pipe!)
+(handle-pipe!)
-  (handle-sigint!)
+(handle-sigint!)
-  (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}
                        (edn/read-string dev-opts))
       last-iteration (dec n)]
   (dotimes [i n]
@@ -954,7 +963,7 @@ Use bb run --help to show this help output.
       (do (run args)
           (binding [*out* *err*]
             (println "ran" n "times"))))))
-    (let [exit-code (run args)]
+(let [exit-code (run args)]
   (System/exit exit-code))))
 
 ;;;; Scratch

test-resources/babashka/uberscript/src/my/impl1.clj

@@ -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"

test/babashka/test_utils.clj

@@ -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)

test/babashka/uberscript_test.clj

@@ -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 (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"))))))