[#15] load-ns op

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.

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

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"]]}})

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]
+         pod-namespaces (mapv #(bencode->namespace pod %)
-                   (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)
          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)))

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]
+     (swap! namespaces-to-load
-       (binding [*ns* (load-string (format "(ns %s) *ns*" ns-sym))]
+            merge
-         (doseq [[var-sym v] v]
+            (into {}
-           (cond
+                  (keep (fn [[ns-name _ defer?]]
-             (ifn? v)
+                          (when defer?
-             (do
+                            [ns-name pod]))
-               (ns-unmap *ns* var-sym)
+                        namespaces)))
-               (intern ns-sym var-sym v))
+     (doseq [[ns-sym vars lazy?] namespaces
-             (string? v)
+             :when (not lazy?)]
-             (load-string v)))))
+       (process-namespace {:name ns-sym :vars vars}))
      (future (impl/processor pod))
      {:pod/id (:pod-id pod)})))
 

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)]
+             namespaces (:namespaces pod)
-         (doseq [[ns-name vars] namespaces
+             namespaces-to-load (set (keep (fn [[ns-name _ defer?]]
-                 :let [sci-ns (sci/create-ns ns-name)]]
+                                             (when defer?
-           (sci/binding [sci/ns sci-ns]
+                                               ns-name))
-             (doseq [[var-name var-value] vars]
+                                           namespaces))]
-               (cond (ifn? var-value)
+         (when (seq namespaces-to-load)
-                     (swap! env assoc-in [:namespaces ns-name var-name]
+           (let [load-fn (fn load-fn [{:keys [:namespace]}]
-                            (sci/new-var
+                           (when (contains? namespaces-to-load namespace)
-                             (symbol (str ns-name) (str var-name)) var-value))
+                             (let [ns (impl/load-ns pod namespace)]
-                     (string? var-value)
+                               (process-namespace ctx ns))
-                     (sci/eval-string* ctx var-value)))))
+                             {: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}))

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

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]

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