This commit is contained in:
Michiel Borkent 2020-10-26 23:05:25 +01:00
parent effa8e488c
commit 4641454958

View file

@ -1,8 +1,5 @@
(ns babashka.impl.uberscript (ns babashka.impl.uberscript
(:require [clojure.java.io :as io] (:require [sci.core :as sci]))
[clojure.pprint :as pprint]
[clojure.string :as str]
[sci.core :as sci]))
(defn rewrite-ns (defn rewrite-ns
"Rewrites ns form :require clauses into symbols + :reload only." "Rewrites ns form :require clauses into symbols + :reload only."
@ -15,52 +12,54 @@
(cond (seqable? x) (first x) (cond (seqable? x) (first x)
(symbol? x) x)) (symbol? x) x))
(rest x))] (rest x))]
(cons :require (interpose :reload nss)))) ;; force reload (cons :require (interleave nss (repeat :reload))))) ;; force reload
x)) x))
ns)) ns))
(defn ns->files [dir ns]
(let [extensions ["clj" "cljs" "cljc"]
path (-> ns munge (str/replace "." java.io.File/separator))
files (map #(io/file dir (str path "." %)) extensions)]
(filter #(.exists ^java.io.File %) files)))
(def ^:dynamic *ctx* nil) (def ^:dynamic *ctx* nil)
(def ^:dynamic *ns-path* nil)
(def debug true) (def debug true)
(defn process-source [file] (defn process-source [expr]
(let [file-reader (io/reader (io/file file)) (let [source-reader (sci/reader expr)]
source-reader (sci/reader file-reader)]
(loop [] (loop []
(let [next-form (sci/parse-next *ctx* source-reader)] (let [next-form (sci/parse-next *ctx* source-reader)]
(when-not (= ::sci/eof next-form) (when-not (= ::sci/eof next-form)
(if (and (seq? next-form) (if (and (seq? next-form)
(= 'ns (first next-form))) (= 'ns (first next-form)))
(let [ns (rewrite-ns next-form)] (let [ns (rewrite-ns next-form)]
(prn :ns ns)
(sci/eval-form *ctx* ns)) (sci/eval-form *ctx* ns))
;; look for more ns forms ;; look for more ns forms
(recur))))))) (recur)))))))
(defn uberscript [init-code namespace skip-namespaces resource-fn] (defn uberscript [init-expr skip-namespaces resource-fn]
(let [uberscript-sources (atom ()) (let [uberscript-sources (atom ())
load-fn (fn [{:keys [:namespace :reload]}] load-fn (fn [{:keys [:namespace]}]
(when resource-fn (when resource-fn
(if ;; ignore built-in namespaces when uberscripting, unless with :reload (if (contains? skip-namespaces namespace)
(and uberscript
(not reload)
(not (contains? skip-namespaces namespace)))
"" ""
(let [res (resource-fn namespace)] (let [res (resource-fn namespace)]
(when uberscript (swap! uberscript-sources conj (:source res))) (swap! uberscript-sources conj res)
res)))) res))))
namespace (symbol namespace)
results (atom {namespace nil})
ctx (sci/init {:load-fn load-fn ctx (sci/init {:load-fn load-fn
:features #{:bb :clj}})] :features #{:bb :clj}})]
;; establish a thread-local bindings to allow set! ;; establish a thread-local bindings to allow set!
(sci/with-bindings {sci/ns @sci/ns} (sci/with-bindings {sci/ns @sci/ns}
(binding [*ctx* ctx (binding [*ctx* ctx]
*ns-path* [namespace]] (process-source init-expr))
(process-source init-code))))) (prn (count @uberscript-sources)))))
;;;; Scratch
(comment #_do
(require '[clojure.java.io :as io])
(require '[clojure.string :as str])
(defn test-uberscript []
(uberscript "(ns foo (:require [clojure.string] :reload))"
#{}
(fn [ns] (some-> (str (str/replace ns "." "/") ".clj" )
(io/resource)
slurp))))
(test-uberscript))