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

nREPL server cleanup

Browse source
This commit is contained in:
Michiel Borkent 2020-04-10 14:29:10 +02:00
parent dc68b5fa4f
commit 7e30c40dd9
2 changed files with 35 additions and 68 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

101
src/babashka/impl/nrepl_server.clj
View file

@ -17,10 +17,8 @@
(defn response-for [old-msg msg] (defn response-for [old-msg msg]
(let [session (get old-msg :session "none") (let [session (get old-msg :session "none")
m (assoc msg "session" session) id (get old-msg :id "unknown")]
id (get old-msg :id "unknown") (assoc msg "session" session "id" id)))
m (assoc m "id" id)]
m))
(defn send [^OutputStream os msg] (defn send [^OutputStream os msg]
;;(when @dev? (prn "Sending" msg)) ;;(when @dev? (prn "Sending" msg))
@ -38,7 +36,7 @@
"status" #{"eval-error"}})) "status" #{"eval-error"}}))
(send os (response-for msg {"status" #{"done"}})))) (send os (response-for msg {"status" #{"done"}}))))
(defn eval-msg [ctx o msg #_threads] (defn eval-msg [ctx o msg]
(try (try
(let [ns-str (get msg :ns) (let [ns-str (get msg :ns)
sci-ns (when ns-str (sci-utils/namespace-object (:env ctx) (symbol ns-str) true nil)) sci-ns (when ns-str (sci-utils/namespace-object (:env ctx) (symbol ns-str) true nil))
@ -46,32 +44,27 @@
(sci/with-bindings (cond-> {sci/out sw} (sci/with-bindings (cond-> {sci/out sw}
sci-ns (assoc vars/current-ns sci-ns)) sci-ns (assoc vars/current-ns sci-ns))
(when @dev? (println "current ns" (vars/current-ns-name))) (when @dev? (println "current ns" (vars/current-ns-name)))
(let [session (get msg :session "none") (let [code-str (get msg :code)
id (get msg :id "unknown")] value (if (str/blank? code-str)
(when @dev? (println "Registering thread for" (str session "-" id))) ::nil
;; (swap! threads assoc [session id] (Thread/currentThread)) (eval-string* ctx code-str))
(let [code-str (get msg :code) out-str (not-empty (str sw))
value (if (str/blank? code-str) env (:env ctx)]
::nil (swap! env update-in [:namespaces 'clojure.core]
(eval-string* ctx code-str)) (fn [core]
out-str (not-empty (str sw)) (assoc core
env (:env ctx)] '*1 value
(swap! env update-in [:namespaces 'clojure.core] '*2 (get core '*1)
(fn [core] '*3 (get core '*2))))
(assoc core (when @dev? (println "out str:" out-str))
'*1 value (when out-str
'*2 (get core '*1) (send o (response-for msg {"out" out-str})))
'*3 (get core '*2)))) (send o (response-for msg (cond-> {"ns" (vars/current-ns-name)}
(when @dev? (println "out str:" out-str)) (not (identical? value ::nil)) (assoc "value" (pr-str value)))))
(when out-str (send o (response-for msg {"status" #{"done"}})))))
(send o (response-for msg {"out" out-str})))
(send o (response-for msg (cond-> {"ns" (vars/current-ns-name)}
(not (identical? value ::nil)) (assoc "value" (pr-str value)))))
(send o (response-for msg {"status" #{"done"}}))))))
(catch Exception ex (catch Exception ex
(swap! (:env ctx) update-in [:namespaces 'clojure.core] (swap! (:env ctx) update-in [:namespaces 'clojure.core]
(fn [core] assoc '*e ex)
(assoc core '*e ex)))
(send-exception o msg ex)))) (send-exception o msg ex))))
(defn fully-qualified-syms [ctx ns-sym] (defn fully-qualified-syms [ctx ns-sym]
@ -127,17 +120,6 @@
(send o (response-for msg {"completions" [] (send o (response-for msg {"completions" []
"status" #{"done"}}))))) "status" #{"done"}})))))
;; GraalVM doesn't support the .stop method on Threads, so for now we will have to live without interrupt
#_(defn interrupt [_ctx os msg threads]
(let [session (get msg :session "none")
id (get msg :interrupt-id)]
(when-let [t (get @threads [session id])]
(when @dev? (println "Killing thread" (str session "-" id)))
(try (.stop ^java.lang.Thread t)
(catch Throwable e
(println e))))
(send os (response-for msg {"status" #{"done"}}))))
(defn read-msg [msg] (defn read-msg [msg]
(-> (zipmap (map keyword (keys msg)) (-> (zipmap (map keyword (keys msg))
(map #(if (bytes? %) (map #(if (bytes? %)
@ -145,7 +127,7 @@
%) (vals msg))) %) (vals msg)))
(update :op keyword))) (update :op keyword)))
(defn session-loop [ctx ^InputStream is os id #_threads] (defn session-loop [ctx ^InputStream is os id]
(when @dev? (println "Reading!" id (.available is))) (when @dev? (println "Reading!" id (.available is)))
(when-let [msg (try (read-bencode is) (when-let [msg (try (read-bencode is)
(catch EOFException _ (catch EOFException _
@ -157,57 +139,43 @@
(when @dev? (println "Cloning!")) (when @dev? (println "Cloning!"))
(let [id (str (java.util.UUID/randomUUID))] (let [id (str (java.util.UUID/randomUUID))]
(send os (response-for msg {"new-session" id "status" #{"done"}})) (send os (response-for msg {"new-session" id "status" #{"done"}}))
(recur ctx is os id #_threads))) (recur ctx is os id)))
:eval (do :eval (do
(eval-msg ctx os msg #_threads) (eval-msg ctx os msg)
(recur ctx is os id #_threads)) (recur ctx is os id))
:load-file (let [file (:file msg) :load-file (let [file (:file msg)
msg (assoc msg :code file)] msg (assoc msg :code file)]
(eval-msg ctx os msg #_threads) (eval-msg ctx os msg)
(recur ctx is os id #_threads)) (recur ctx is os id))
:complete (do :complete (do
(complete ctx os msg) (complete ctx os msg)
(recur ctx is os id #_threads)) (recur ctx is os id))
;; :interrupt (do
;; (interrupt ctx os msg threads)
;; (recur ctx is os id threads))
:describe :describe
(do (send os (response-for msg {"status" #{"done"} (do (send os (response-for msg {"status" #{"done"}
"aux" {}
"ops" (zipmap #{"clone" "eval" "load-file" "complete" "describe"} "ops" (zipmap #{"clone" "eval" "load-file" "complete" "describe"}
(repeat {})) (repeat {}))}))
"versions" {} #_{"nrepl" {"major" "0" (recur ctx is os id))
"minor" "4"
"incremental" "0"
"qualifier" ""}
"clojure"
{"*clojure-version*"
(zipmap (map name (keys *clojure-version*))
(vals *clojure-version*))}}}))
(recur ctx is os id #_threads))
;; fallback ;; fallback
(do (when @dev? (do (when @dev?
(println "Unhandled message" msg)) (println "Unhandled message" msg))
(send os (response-for msg {"status" #{"error" "unknown-op" "done"}})) (send os (response-for msg {"status" #{"error" "unknown-op" "done"}}))
(recur ctx is os id #_threads)))))) (recur ctx is os id))))))
(defn listen [ctx ^ServerSocket listener] (defn listen [ctx ^ServerSocket listener]
(when @dev? (println "Listening")) (when @dev? (println "Listening"))
(let [client-socket (.accept listener) (let [client-socket (.accept listener)
in (.getInputStream client-socket) in (.getInputStream client-socket)
in (PushbackInputStream. in) in (PushbackInputStream. in)
out (.getOutputStream client-socket) out (.getOutputStream client-socket)]
#_threads #_(atom {})]
(when @dev? (println "Connected.")) (when @dev? (println "Connected."))
(sci/future (sci/future
(sci/binding (sci/binding
;; allow *ns* to be set! inside future ;; allow *ns* to be set! inside future
[vars/current-ns (vars/->SciNamespace 'user nil) [vars/current-ns (vars/->SciNamespace 'user nil)
sci/print-length @sci/print-length] sci/print-length @sci/print-length]
(session-loop ctx in out "pre-init" #_threads))) (session-loop ctx in out "pre-init")))
(recur ctx listener))) (recur ctx listener)))
(def server (atom nil)) (def server (atom nil))
(defn stop-server! [] (defn stop-server! []
@ -224,7 +192,6 @@
(Integer. ^String (second parts))]) (Integer. ^String (second parts))])
host+port (if-not address (str "localhost:" port) host+port (if-not address (str "localhost:" port)
host+port)] host+port)]
#_(complete ctx nil {:symbol "json"})
(println "Starting nREPL server at" host+port) (println "Starting nREPL server at" host+port)
(let [socket-server (new ServerSocket port 0 address)] (let [socket-server (new ServerSocket port 0 address)]
(reset! server socket-server) (reset! server socket-server)

2
test/babashka/shutdown_hook_test.clj
View file

@ -12,7 +12,7 @@
(io/copy in bout :encoding enc) (io/copy in bout :encoding enc)
(.toString bout)))) (.toString bout))))
(deftest interrupt-handler-test (deftest shutdown-hook-test
(let [script "(-> (Runtime/getRuntime) (.addShutdownHook (Thread. #(println \"bye\"))))" (let [script "(-> (Runtime/getRuntime) (.addShutdownHook (Thread. #(println \"bye\"))))"
pb (ProcessBuilder. (if tu/jvm? pb (ProcessBuilder. (if tu/jvm?
["lein" "bb" "-e" script] ["lein" "bb" "-e" script]