diff --git a/README.md b/README.md index f0b2d8e..cdb341d 100644 --- a/README.md +++ b/README.md @@ -346,6 +346,49 @@ In the pod client: nil ``` +#### Deferred namespace loading + +When your pod exposes multiple namespaces that can be used independently from +each other, consider implementing the `load-ns` op which allows the pod client +to load the namespace and process the client side code when it is loaded using +`require`. This will speed up the initial setup of the pod in `load-pod`. + +In `describe` the pod will mark the namespaces as deferred: + +``` clojure +{"name" "pod.lispyclouds.deferred-ns" + "defer" "true"} +``` + +When the user requires the namespace with `(require +'[pod.lispyclouds.deferred-ns])` the pod client will then send a message: + +``` clojure +{"op" "load-ns" + "ns" "pod.lispyclouds.deferred-ns" + "id "..."} +``` + +upon which the pod will reply with the namespace data: + +``` clojure +{"name" "pod.lispyclouds.deferred-ns" + "vars" [{"name" "myfunc" "code" "(defn my-func [])"}] + "id" "..."} +``` + +If a deferred namespace depends on another deferred namespace, provide explicit +`require`s in `code` segments: + +``` clojure +{"name" "pod.lispyclouds.another-deferred-ns" + "vars" + [{"name" "myfunc" + "code" "(require '[pod.lispyclouds.deferred-ns :as dns]) + (defn my-func [] (dns/x))"}] + "id" "..."} +``` + #### Async Asynchronous functions can be implemented using callbacks. diff --git a/deps.edn b/deps.edn index 6557c81..18c47fe 100644 --- a/deps.edn +++ b/deps.edn @@ -3,7 +3,7 @@ :aliases {:sci {:extra-deps - {borkdude/sci {:mvn/version "0.0.13-alpha.26"}}} + {borkdude/sci {:mvn/version "0.0.13-alpha.27"}}} :test {:extra-deps {test-runner diff --git a/project.clj b/project.clj index 22e272e..303ea02 100644 --- a/project.clj +++ b/project.clj @@ -12,4 +12,4 @@ :username :env/babashka_nrepl_clojars_user :password :env/babashka_nrepl_clojars_pass :sign-releases false}]] - :profiles {:test {:dependencies [[borkdude/sci "0.0.13-alpha.26"]]}}) + :profiles {:test {:dependencies [[borkdude/sci "0.0.13-alpha.27"]]}}) diff --git a/src/babashka/pods/impl.clj b/src/babashka/pods/impl.clj index 6beee87..e9f978c 100644 --- a/src/babashka/pods/impl.clj +++ b/src/babashka/pods/impl.clj @@ -30,80 +30,6 @@ (some-> (get m k) bytes->string)) -(defn processor [pod] - (let [stdout (:stdout pod) - format (:format pod) - chans (:chans pod) - out-stream (:out pod) - err-stream (:err pod) - readers (:readers pod) - read-fn (case format - :edn #(edn/read-string {:readers readers} %) - :json #(cheshire/parse-string-strict % true))] - (try - (loop [] - (let [reply (try (read stdout) - (catch java.io.EOFException _ - ::EOF))] - (when-not (identical? ::EOF reply) - (let [id (get reply "id") - id (bytes->string id) - value* (find reply "value") - value (some-> value* - second - bytes->string - read-fn) - status (get reply "status") - status (set (map (comp keyword bytes->string) status)) - error? (contains? status :error) - done? (or error? (contains? status :done)) - [ex-message ex-data] - (when error? - [(or (some-> (get reply "ex-message") - bytes->string) - "") - (or (some-> (get reply "ex-data") - bytes->string - read-fn) - {})]) - chan (get @chans id) - promise? (instance? clojure.lang.IPending chan) - exception (when (and promise? error?) - (ex-info ex-message ex-data)) - ;; NOTE: if we need more fine-grained handlers, we will add - ;; a :raw handler that will just get the bencode message's raw - ;; data - {error-handler :error - done-handler :done - success-handler :success} (when (map? chan) - chan) - out (some-> (get reply "out") - bytes->string) - err (some-> (get reply "err") - bytes->string)] - (when (or value* error?) - (cond promise? - (deliver chan (if error? exception value)) - (and (not error?) success-handler) - (success-handler value) - (and error? error-handler) - (error-handler {:ex-message ex-message - :ex-data ex-data}))) - (when (and done? (not error?)) - (when promise? - (deliver chan nil)) - (when done-handler - (done-handler))) - (when out - (binding [*out* out-stream] - (println out))) - (when err (binding [*out* err-stream] - (println err)))) - (recur)))) - (catch Exception e - (binding [*out* *err* #_err-stream] - (prn e)))))) - (defn next-id [] (str (java.util.UUID/randomUUID))) @@ -129,6 +55,103 @@ (throw v) v))))) +(defn bencode->vars [pod ns-name-str vars] + (mapv + (fn [var] + (let [name (get-string var "name") + async? (some-> (get var "async") + bytes->string + #(Boolean/parseBoolean %)) + name-sym (symbol name) + sym (symbol ns-name-str name) + code (get-maybe-string var "code")] + [name-sym + (or code + (fn [& args] + (let [res (invoke pod sym args {:async async?})] + res)))])) + vars)) + +(defn processor [pod] + (let [stdout (:stdout pod) + format (:format pod) + chans (:chans pod) + out-stream (:out pod) + err-stream (:err pod) + readers (:readers pod) + read-fn (case format + :edn #(edn/read-string {:readers readers} %) + :json #(cheshire/parse-string-strict % true))] + (try + (loop [] + (let [reply (try (read stdout) + (catch java.io.EOFException _ + ::EOF))] + (when-not (identical? ::EOF reply) + (let [id (get reply "id") + id (bytes->string id) + value* (find reply "value") + value (some-> value* + second + bytes->string + read-fn) + status (get reply "status") + status (set (map (comp keyword bytes->string) status)) + error? (contains? status :error) + done? (or error? (contains? status :done)) + [ex-message ex-data] + (when error? + [(or (some-> (get reply "ex-message") + bytes->string) + "") + (or (some-> (get reply "ex-data") + bytes->string + read-fn) + {})]) + namespace (when-let [v (get reply "vars")] + (let [name (-> (get reply "name") + bytes->string)] + {:name name :vars (bencode->vars pod name v)})) + chan (get @chans id) + promise? (instance? clojure.lang.IPending chan) + exception (when (and promise? error?) + (ex-info ex-message ex-data)) + ;; NOTE: if we need more fine-grained handlers, we will add + ;; a :raw handler that will just get the bencode message's raw + ;; data + {error-handler :error + done-handler :done + success-handler :success} (when (map? chan) + chan) + out (some-> (get reply "out") + bytes->string) + err (some-> (get reply "err") + bytes->string)] + (when (or value* error? namespace) + (cond promise? + (deliver chan (cond error? exception + value value + namespace namespace)) + (and (not error?) success-handler) + (success-handler value) + (and error? error-handler) + (error-handler {:ex-message ex-message + :ex-data ex-data}))) + (when (and done? (not error?)) + (when promise? + (deliver chan nil)) + (when done-handler + (done-handler))) + (when out + (binding [*out* out-stream] + (println out))) + (when err (binding [*out* err-stream] + (println err)))) + (recur)))) + (catch Exception e + (binding [*out* *err* #_err-stream] + (prn e)))))) + (def pods (atom {})) (defn lookup-pod [pod-id] @@ -161,6 +184,14 @@ dict-vals (map (comp resolve-fn bytes->symbol) (vals dict))] (zipmap dict-keys dict-vals)))) +(defn bencode->namespace [pod namespace] + (let [name-str (-> namespace (get "name") bytes->string) + name-sym (symbol name-str) + vars (get namespace "vars") + vars (bencode->vars pod name-str vars) + defer? (some-> namespace (get-maybe-string "defer") (= "true"))] + [name-sym vars defer?])) + (defn load-pod ([pod-spec] (load-pod pod-spec nil)) ([pod-spec {:keys [:remove-ns :resolve]}] @@ -197,33 +228,23 @@ (get-string ns "name")) (next-id)) pod (assoc pod :pod-id pod-id) - vars-fn (fn [ns-name-str vars] - (mapv - (fn [var] - (let [name (get-string var "name") - async? (some-> (get var "async") - bytes->string - #(Boolean/parseBoolean %)) - name-sym (symbol name) - sym (symbol ns-name-str name) - code (get-maybe-string var "code")] - [name-sym - (or code - (fn [& args] - (let [res (invoke pod sym args {:async async?})] - res)))])) - vars)) - pod-namespaces (mapv (fn [namespace] - (let [name-str (-> namespace (get "name") bytes->string) - name-sym (symbol name-str) - vars (get namespace "vars") - vars (vars-fn name-str vars)] - [name-sym vars])) + pod-namespaces (mapv #(bencode->namespace pod %) pod-namespaces) pod (assoc pod :namespaces pod-namespaces)] (swap! pods assoc pod-id pod) pod))) +(defn load-ns [pod namespace] + (let [prom (promise) + chans (:chans pod) + id (next-id) + _ (swap! chans assoc id prom)] + (write (:stdin pod) + {"op" "load-ns" + "ns" (str namespace) + "id" id}) + @prom)) + (defn invoke-public [pod-id fn-sym args opts] (let [pod (lookup-pod pod-id)] (invoke pod fn-sym args opts))) diff --git a/src/babashka/pods/jvm.clj b/src/babashka/pods/jvm.clj index 404516d..9dfef6b 100644 --- a/src/babashka/pods/jvm.clj +++ b/src/babashka/pods/jvm.clj @@ -1,6 +1,36 @@ (ns babashka.pods.jvm (:require [babashka.pods.impl :as impl])) +(def ^:private namespaces-to-load (atom {})) + +(defn- unroot-resource [^String path] + (symbol (.. path + (substring 1) + (replace \/ \. ) + (replace \_ \-)))) + +(defn- process-namespace [{:keys [:name :vars]}] + (binding [*ns* (load-string (format "(ns %s) *ns*" name))] + (doseq [[var-sym v] vars] + (cond + (ifn? v) + (do + (ns-unmap *ns* var-sym) + (intern name var-sym v)) + (string? v) + (load-string v))))) + +(let [core-load clojure.core/load] + (intern 'clojure.core 'load + (fn [& paths] + (let [nss @namespaces-to-load] + (doseq [path paths] + (let [lib (unroot-resource path)] + (if-let [pod (get nss lib)] + (let [ns (impl/load-ns pod lib)] + (process-namespace ns)) + (core-load path)))))))) + (defn load-pod ([pod-spec] (load-pod pod-spec nil)) ([pod-spec _opts] @@ -13,16 +43,16 @@ (create-ns (symbol (namespace sym))) (symbol (name sym)))))}) namespaces (:namespaces pod)] - (doseq [[ns-sym v] namespaces] - (binding [*ns* (load-string (format "(ns %s) *ns*" ns-sym))] - (doseq [[var-sym v] v] - (cond - (ifn? v) - (do - (ns-unmap *ns* var-sym) - (intern ns-sym var-sym v)) - (string? v) - (load-string v))))) + (swap! namespaces-to-load + merge + (into {} + (keep (fn [[ns-name _ defer?]] + (when defer? + [ns-name pod])) + namespaces))) + (doseq [[ns-sym vars lazy?] namespaces + :when (not lazy?)] + (process-namespace {:name ns-sym :vars vars})) (future (impl/processor pod)) {:pod/id (:pod-id pod)}))) diff --git a/src/babashka/pods/sci.clj b/src/babashka/pods/sci.clj index 5defed5..b9ab964 100644 --- a/src/babashka/pods/sci.clj +++ b/src/babashka/pods/sci.clj @@ -2,6 +2,19 @@ (:require [babashka.pods.impl :as impl] [sci.core :as sci])) +(defn- process-namespace [ctx {:keys [:name :vars]}] + (let [env (:env ctx) + ns-name name + sci-ns (sci/create-ns (symbol ns-name))] + (sci/binding [sci/ns sci-ns] + (doseq [[var-name var-value] vars] + (cond (ifn? var-value) + (swap! env assoc-in [:namespaces ns-name var-name] + (sci/new-var + (symbol (str ns-name) (str var-name)) var-value)) + (string? var-value) + (sci/eval-string* ctx var-value)))))) + (def load-pod (with-meta (fn @@ -26,17 +39,27 @@ (swap! env assoc-in [:namespaces sym-ns sym-name] v) v))))})) - namespaces (:namespaces pod)] - (doseq [[ns-name vars] namespaces - :let [sci-ns (sci/create-ns ns-name)]] - (sci/binding [sci/ns sci-ns] - (doseq [[var-name var-value] vars] - (cond (ifn? var-value) - (swap! env assoc-in [:namespaces ns-name var-name] - (sci/new-var - (symbol (str ns-name) (str var-name)) var-value)) - (string? var-value) - (sci/eval-string* ctx var-value))))) + namespaces (:namespaces pod) + namespaces-to-load (set (keep (fn [[ns-name _ defer?]] + (when defer? + ns-name)) + namespaces))] + (when (seq namespaces-to-load) + (let [load-fn (fn load-fn [{:keys [:namespace]}] + (when (contains? namespaces-to-load namespace) + (let [ns (impl/load-ns pod namespace)] + (process-namespace ctx ns)) + {:file nil + :source ""})) + prev-load-fn (:load-fn @env) + new-load-fn (fn [m] + (or (load-fn m) + (when prev-load-fn + (prev-load-fn m))))] + (swap! env assoc :load-fn new-load-fn))) + (doseq [[ns-name vars lazy?] namespaces + :when (not lazy?)] + (process-namespace ctx {:name ns-name :vars vars})) (sci/future (impl/processor pod)) {:pod/id (:pod-id pod)}))) {:sci.impl/op :needs-ctx})) diff --git a/test-pod/pod/test_pod.clj b/test-pod/pod/test_pod.clj index d4f4caf..fdc72d7 100644 --- a/test-pod/pod/test_pod.clj +++ b/test-pod/pod/test_pod.clj @@ -80,7 +80,11 @@ ;; reads thing with other tag {"name" "read-other-tag" "code" "(defn read-other-tag [x] [x x])"}] - dependents)}] + dependents)} + {"name" "pod.test-pod.loaded" + "defer" "true"} + {"name" "pod.test-pod.loaded2" + "defer" "true"}] "ops" {"shutdown" {}}}) (recur)) :invoke (let [var (-> (get message "var") @@ -156,7 +160,30 @@ "id" id "value" "#my/other-tag[1]"})) (recur)) - :shutdown (System/exit 0)))))) + :shutdown (System/exit 0) + :load-ns (let [ns (-> (get message "ns") + read-string + symbol) + id (-> (get message "id") + read-string)] + (case ns + pod.test-pod.loaded + (write + {"status" ["done"] + "id" id + "name" "pod.test-pod.loaded" + "vars" [{"name" "loaded" + "code" "(defn loaded [x] (inc x))"}]}) + pod.test-pod.loaded2 + (write + {"status" ["done"] + "id" id + "name" "pod.test-pod.loaded2" + "vars" [{"name" "x" + "code" "(require '[pod.test-pod.loaded :as loaded])"} + {"name" "loaded" + "code" "(defn loaded [x] (loaded/loaded x))"}]})) + (recur))))))) (catch Exception e (binding [*out* *err*] (prn e)))))) diff --git a/test-resources/test_program.clj b/test-resources/test_program.clj index 64293c5..d1f785c 100644 --- a/test-resources/test_program.clj +++ b/test-resources/test_program.clj @@ -46,6 +46,9 @@ (def tagged (pod/reader-tag)) (def other-tagged (pod/other-tag)) +(require '[pod.test-pod.loaded2 :as loaded2]) +(def loaded (loaded2/loaded 1)) + (pods/unload-pod pod-id) (def successfully-removed (nil? (find-ns 'pod.test-pod))) @@ -63,4 +66,5 @@ successfully-removed x9 tagged - other-tagged] + other-tagged + loaded] diff --git a/test/babashka/pods/test_common.clj b/test/babashka/pods/test_common.clj index 861bc12..5d47e2a 100644 --- a/test/babashka/pods/test_common.clj +++ b/test/babashka/pods/test_common.clj @@ -20,7 +20,8 @@ true 9 [1 2 3] - [[1] [1]]] + [[1] [1]] + 2] (concat ret (repeat ::nil)))] (if (instance? java.util.regex.Pattern expected) (is (re-find expected actual))