From 9a70ecfd9d1aa8d3bc9392ed159fd7d0cb981c7d Mon Sep 17 00:00:00 2001 From: Michiel Borkent Date: Mon, 25 May 2020 14:21:16 +0200 Subject: [PATCH] wip --- src/babashka/pods/impl.clj | 170 +++++++++++++++++++++---------------- src/babashka/pods/sci.clj | 5 +- 2 files changed, 98 insertions(+), 77 deletions(-) diff --git a/src/babashka/pods/impl.clj b/src/babashka/pods/impl.clj index 6beee87..7c6317a 100644 --- a/src/babashka/pods/impl.clj +++ b/src/babashka/pods/impl.clj @@ -30,6 +30,9 @@ (some-> (get m k) bytes->string)) +(def callbacks + (atom {})) + (defn processor [pod] (let [stdout (:stdout pod) format (:format pod) @@ -46,59 +49,62 @@ (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)))) + (let [id (get reply "id") + id (bytes->string id)] + (if-let [cb (get @callbacks id)] + (do (swap! callbacks dissoc id) + (cb reply)) + (let [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] @@ -161,6 +167,30 @@ dict-vals (map (comp resolve-fn bytes->symbol) (vals dict))] (zipmap dict-keys dict-vals)))) +(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 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)] + [name-sym vars])) + (defn load-pod ([pod-spec] (load-pod pod-spec nil)) ([pod-spec {:keys [:remove-ns :resolve]}] @@ -197,33 +227,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 callback] + (let [id (next-id) + callback (fn [reply] + (let [namespace (bencode->namespace pod reply)] + (callback namespace)))] + (swap! callbacks assoc id callback) + (write (:stdin pod) + {"op" "load" + "path" (str namespace) + "id" id}))) + (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/sci.clj b/src/babashka/pods/sci.clj index 5efe7b5..cd5ef35 100644 --- a/src/babashka/pods/sci.clj +++ b/src/babashka/pods/sci.clj @@ -47,8 +47,9 @@ (when (seq namespaces-to-load) (let [load-fn (fn load-fn [{:keys [:namespace]}] (when (contains? namespaces-to-load namespace) - #_(impl/load pod namespace (fn [namespace] - (process-namespace ctx namespace))) + (impl/load-ns + pod namespace (fn [namespace] + (process-namespace ctx namespace))) "")) prev-load-fn (:load-fn @env) new-load-fn (fn [m]