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

2
test/babashka/shutdown_hook_test.clj
View file

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