[#346] nrepl: implement close and ls-sessions

src/babashka/impl/nrepl_server.clj

@@ -127,6 +127,15 @@
          (send o (response-for msg {"completions" []
                                     "status" #{"done"}})))))
 
+(defn close-session [ctx msg _is os id]
+  (swap! (:sessions ctx) disj id)
+  (send os (response-for msg {"status" #{"done" "session-closed"}})))
+
+(defn ls-sessions [ctx msg os]
+  (let [sessions @(:sessions ctx)]
+    (send os (response-for msg {"sessions" sessions
+                                "status" #{"done"}}))))
+
 (defn read-msg [msg]
   (-> (zipmap (map keyword (keys msg))
               (map #(if (bytes? %)
@@ -145,6 +154,7 @@
         :clone (do
                  (when @dev? (println "Cloning!"))
                  (let [id (str (java.util.UUID/randomUUID))]
+                   (swap! (:sessions ctx) (fnil conj #{}) id)
                    (send os (response-for msg {"new-session" id "status" #{"done"}}))
                    (recur ctx is os id)))
         :eval (do
@@ -162,6 +172,10 @@
                                         "ops" (zipmap #{"clone" "eval" "load-file" "complete" "describe"}
                                                       (repeat {}))}))
             (recur ctx is os id))
+        :close (do (close-session ctx msg is os id)
+                   (recur ctx is os id))
+        :ls-sessions (do (ls-sessions ctx msg os)
+                         (recur ctx is os id))
         ;; fallback
         (do (when @dev?
               (println "Unhandled message" msg))
@@ -193,7 +207,8 @@
 
 (defn start-server! [ctx host+port]
   (vreset! dev? (= "true" (System/getenv "BABASHKA_DEV")))
-  (let [parts (str/split host+port #":")
+  (let [ctx (assoc ctx :sessions (atom #{}))
+        parts (str/split host+port #":")
         [address port] (if (= 1 (count parts))
                          [nil (Integer. ^String (first parts))]
                          [(java.net.InetAddress/getByName (first parts))

test/babashka/impl/nrepl_server_test.clj

@@ -5,11 +5,12 @@
    [babashka.main :as main]
    [babashka.test-utils :as tu]
    [babashka.wait :as wait]
-   [cheshire.core :as cheshire]
    [clojure.test :as t :refer [deftest is testing]]
    [sci.impl.opts :refer [init]])
   (:import [java.lang ProcessBuilder$Redirect]))
 
+(def debug? false)
+
 (set! *warn-on-reflection* true)
 
 (defn bytes->str [x]
@@ -24,6 +25,9 @@
                          (vals msg)))
         res (if-let [status (:status res)]
               (assoc res :status (mapv bytes->str status))
+              res)
+        res (if-let [status (:sessions res)]
+              (assoc res :sessions (mapv bytes->str status))
               res)]
     res))
 
@@ -32,8 +36,12 @@
     (let [msg (read-msg (bencode/read-bencode in))]
       (if (and (= (:session msg) session)
                (= (:id msg) id))
-        msg
+        (do
-        (recur)))))
+          (when debug? (prn "received" msg))
+          msg)
+        (do
+          (when debug? (prn "skipping over msg" msg))
+          (recur))))))
 
 (defn nrepl-test []
   (with-open [socket (java.net.Socket. "127.0.0.1" 1667)
@@ -129,11 +137,28 @@
                 completions (mapv read-msg completions)
                 completions (into #{} (map (juxt :ns :candidate)) completions)]
             (is (contains? completions ["clojure.test" "test/deftest"])))))
-      #_(testing "interrupt" ;; .stop doesn't work on Thread in GraalVM, this is why we can't have this yet
+      (testing "ls-sessions"
-          (bencode/write-bencode os {"op" "eval" "code" "(range)" "session" session "id" 9})
+        (bencode/write-bencode os {"op" "ls-sessions" "session" session "id" (new-id!)})
-          (Thread/sleep 1000)
+        (let [reply (read-reply in session @id)
-          (bencode/write-bencode os {"op" "interrupt" "session" session "interrupt-id" 9 "id" 10})
+              sessions (set (:sessions reply))]
-          (is (contains? (set (:status (read-reply in session 10))) "done"))))))
+          (is (contains? sessions session))
+          (bencode/write-bencode os {"op" "clone" "session" session "id" (new-id!)})
+          (let [new-session (:new-session (read-reply in session @id))]
+            (bencode/write-bencode os {"op" "ls-sessions" "session" session "id" (new-id!)})
+            (let [reply (read-reply in session @id)
+                  sessions (set (:sessions reply))]
+              (is (contains? sessions session))
+              (is (contains? sessions new-session)))
+            (testing "close"
+              (bencode/write-bencode os {"op" "close" "session" new-session "id" (new-id!)})
+              (let [reply (read-reply in new-session @id)]
+                (is (contains? (set (:status reply)) "session-closed"))))
+            (testing "session not listen in ls-sessions after close"
+              (bencode/write-bencode os {"op" "ls-sessions" "session" session "id" (new-id!)})
+              (let [reply (read-reply in session @id)
+                    sessions (set (:sessions reply))]
+                (is (contains? sessions session))
+                (is (not (contains? sessions new-session)))))))))))
 
 (deftest nrepl-server-test
   (let [proc-state (atom nil)]