This commit is contained in:
Michiel Borkent 2020-05-25 14:21:16 +02:00
parent 0eee62b809
commit 9a70ecfd9d
2 changed files with 98 additions and 77 deletions

View file

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

View file

@ -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]