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

Get rid of :needs-ctx

Browse source
This commit is contained in:
Michiel Borkent 2020-11-18 17:44:01 +01:00
parent a0418d6622
commit e71ae00d03
2 changed files with 56 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

97
src/babashka/pods/sci.clj
View file

@ -19,56 +19,53 @@
(string? var-value) (string? var-value)
(sci/eval-string* ctx var-value)))))) (sci/eval-string* ctx var-value))))))
(def load-pod (defn load-pod
(with-meta ([ctx pod-spec] (load-pod ctx pod-spec nil))
(fn ([ctx pod-spec opts]
([ctx pod-spec] (load-pod ctx pod-spec nil)) (let [env (:env ctx)
([ctx pod-spec opts] pod (binding [*out* @sci/out
(let [env (:env ctx) *err* @sci/err]
pod (binding [*out* @sci/out (impl/load-pod
*err* @sci/err] pod-spec
(impl/load-pod (merge
pod-spec {:remove-ns
(merge (fn [sym]
{:remove-ns (swap! env update :namespaces dissoc sym))
(fn [sym] :resolve
(swap! env update :namespaces dissoc sym)) (fn [sym]
:resolve (let [sym-ns (or (some-> (namespace sym)
(fn [sym] symbol)
(let [sym-ns (or (some-> (namespace sym) 'clojure.core)
symbol) sym-name (symbol (name sym))]
'clojure.core) (or (get-in @env [:namespaces sym-ns sym-name])
sym-name (symbol (name sym))] (let [v (sci/new-var sym {:predefined true})]
(or (get-in @env [:namespaces sym-ns sym-name]) (swap! env assoc-in [:namespaces sym-ns sym-name]
(let [v (sci/new-var sym {:predefined true})] v)
(swap! env assoc-in [:namespaces sym-ns sym-name] v))))}
v) opts)))
v))))} namespaces (:namespaces pod)
opts))) namespaces-to-load (set (keep (fn [[ns-name _ defer?]]
namespaces (:namespaces pod) (when defer?
namespaces-to-load (set (keep (fn [[ns-name _ defer?]] ns-name))
(when defer? namespaces))]
ns-name)) (when (seq namespaces-to-load)
namespaces))] (let [load-fn (fn load-fn [{:keys [:namespace]}]
(when (seq namespaces-to-load) (when (contains? namespaces-to-load namespace)
(let [load-fn (fn load-fn [{:keys [:namespace]}] (let [ns (impl/load-ns pod namespace)]
(when (contains? namespaces-to-load namespace) (process-namespace ctx ns))
(let [ns (impl/load-ns pod namespace)] {:file nil
(process-namespace ctx ns)) :source ""}))
{:file nil prev-load-fn (:load-fn @env)
:source ""})) new-load-fn (fn [m]
prev-load-fn (:load-fn @env) (or (load-fn m)
new-load-fn (fn [m] (when prev-load-fn
(or (load-fn m) (prev-load-fn m))))]
(when prev-load-fn (swap! env assoc :load-fn new-load-fn)))
(prev-load-fn m))))] (doseq [[ns-name vars lazy?] namespaces
(swap! env assoc :load-fn new-load-fn))) :when (not lazy?)]
(doseq [[ns-name vars lazy?] namespaces (process-namespace ctx {:name ns-name :vars vars}))
:when (not lazy?)] (sci/future (impl/processor pod))
(process-namespace ctx {:name ns-name :vars vars})) {:pod/id (:pod-id pod)})))
(sci/future (impl/processor pod))
{:pod/id (:pod-id pod)})))
{:sci.impl/op :needs-ctx}))
(defn unload-pod (defn unload-pod
([pod-id] (unload-pod pod-id {})) ([pod-id] (unload-pod pod-id {}))

16
test/babashka/pods/sci_test.clj
View file

@ -7,13 +7,15 @@
(deftest sci-test (deftest sci-test
(let [out (java.io.StringWriter.) (let [out (java.io.StringWriter.)
err (java.io.StringWriter.) err (java.io.StringWriter.)
ctx-ref (volatile! nil)
ctx (sci/init {:namespaces {'babashka.pods
{'load-pod (fn [& args]
(apply pods/load-pod @ctx-ref args))
'invoke pods/invoke
'unload-pod pods/unload-pod}}
:classes {'System System}})
_ (vreset! ctx-ref ctx)
ret (sci/binding [sci/out out ret (sci/binding [sci/out out
sci/err err] sci/err err]
(sci/eval-string (sci/eval-string* ctx test-program))]
test-program
{:namespaces {'babashka.pods
{'load-pod pods/load-pod
'invoke pods/invoke
'unload-pod pods/unload-pod}}
:classes {'System System}}))]
(assertions out err ret))) (assertions out err ret)))