[#349] nrepl: write to output while evaluating

src/babashka/impl/nrepl_server.clj

@@ -1,7 +1,9 @@
 (ns babashka.impl.nrepl-server
   {:no-doc true}
   (:refer-clojure :exclude [send future binding])
-  (:require [babashka.impl.bencode.core :refer [write-bencode read-bencode]]
+  (:require [babashka.impl.bencode.core :refer [read-bencode]]
+            [babashka.impl.nrepl-server.utils :refer [dev? response-for send send-exception
+                                                      replying-print-writer]]
             [clojure.string :as str]
             [clojure.tools.reader.reader-types :as r]
             [sci.core :as sci]
@@ -9,35 +11,11 @@
             [sci.impl.parser :as p]
             [sci.impl.utils :as sci-utils]
             [sci.impl.vars :as vars])
-  (:import [java.io StringWriter OutputStream InputStream PushbackInputStream EOFException BufferedOutputStream]
+  (:import [java.io InputStream PushbackInputStream EOFException BufferedOutputStream]
            [java.net ServerSocket]))
 
 (set! *warn-on-reflection* true)
 
-(def port 1667)
-(def dev? (volatile! nil))
-
-(defn response-for [old-msg msg]
-  (let [session (get old-msg :session "none")
-        id (get old-msg :id "unknown")]
-    (assoc msg "session" session "id" id)))
-
-(defn send [^OutputStream os msg]
-  ;;(when @dev? (prn "Sending" msg))
-  (write-bencode os msg)
-  (.flush os))
-
-(defn send-exception [os msg ^Throwable ex]
-  (let [ex-map (Throwable->map ex)
-        ex-name (-> ex-map :via first :type)
-        cause (:cause ex-map)]
-    (when @dev? (prn "sending exception" ex-map))
-    (send os (response-for msg {"err" (str ex-name ": " cause "\n")}))
-    (send os (response-for msg {"ex" (str "class " ex-name)
-                                "root-ex" (str "class " ex-name)
-                                "status" #{"eval-error"}}))
-    (send os (response-for msg {"status" #{"done"}}))))
-
 (defn eval-msg [ctx o msg]
   (try
     (let [code-str (get msg :code)
@@ -48,12 +26,11 @@
       (sci/with-bindings (cond-> {}
                            sci-ns (assoc vars/current-ns sci-ns))
         (loop []
-          (let [sw (StringWriter.)
+          (let [pw (replying-print-writer o msg)
                 form (p/parse-next ctx reader)
                 value (if (identical? :edamame.impl.parser/eof form) ::nil
-                          (sci/with-bindings {sci/out sw}
+                          (sci/with-bindings {sci/out pw}
                             (eval-form ctx form)))
-                out-str (not-empty (str sw))
                 env (:env ctx)]
             (swap! env update-in [:namespaces 'clojure.core]
                    (fn [core]
@@ -61,9 +38,6 @@
                             '*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)))))
             (when (not (identical? ::nil value))

src/babashka/impl/nrepl_server/utils.clj

@@ -0,0 +1,63 @@
+(ns babashka.impl.nrepl-server.utils
+  {:no-doc true}
+  (:refer-clojure :exclude [send])
+  (:require [babashka.impl.bencode.core :refer [write-bencode]])
+  (:import [java.io Writer PrintWriter StringWriter OutputStream BufferedWriter]))
+
+(set! *warn-on-reflection* true)
+
+(def dev? (volatile! nil))
+
+(defn response-for [old-msg msg]
+  (let [session (get old-msg :session "none")
+        id (get old-msg :id "unknown")]
+    (assoc msg "session" session "id" id)))
+
+(defn send [^OutputStream os msg]
+  ;;(when @dev? (prn "Sending" msg))
+  (write-bencode os msg)
+  (.flush os))
+
+(defn send-exception [os msg ^Throwable ex]
+  (let [ex-map (Throwable->map ex)
+        ex-name (-> ex-map :via first :type)
+        cause (:cause ex-map)]
+    (when @dev? (prn "sending exception" ex-map))
+    (send os (response-for msg {"err" (str ex-name ": " cause "\n")}))
+    (send os (response-for msg {"ex" (str "class " ex-name)
+                                "root-ex" (str "class " ex-name)
+                                "status" #{"eval-error"}}))
+    (send os (response-for msg {"status" #{"done"}}))))
+
+;; from https://github.com/nrepl/nrepl/blob/1cc9baae631703c184894559a2232275dc50dff6/src/clojure/nrepl/middleware/print.clj#L63
+(defn- to-char-array
+  ^chars
+  [x]
+  (cond
+    (string? x) (.toCharArray ^String x)
+    (integer? x) (char-array [(char x)])
+    :else x))
+
+;; from https://github.com/nrepl/nrepl/blob/1cc9baae631703c184894559a2232275dc50dff6/src/clojure/nrepl/middleware/print.clj#L99
+(defn replying-print-writer
+  "Returns a `java.io.PrintWriter` suitable for binding as `*out*` or `*err*`. All
+  of the content written to that `PrintWriter` will be sent as messages on the
+  transport of `msg`, keyed by `key`."
+  ^java.io.PrintWriter
+  [o msg]
+  (-> (proxy [Writer] []
+        (write
+          ([x]
+           (let [cbuf (to-char-array x)]
+             (.write ^Writer this cbuf (int 0) (count cbuf))))
+          ([x off len]
+           (let [cbuf (to-char-array x)
+                 text (str (doto (StringWriter.)
+                             (.write cbuf ^int off ^int len)))]
+             (when (pos? (count text))
+               (when @dev? (println "out str:" text))
+               (send o (response-for msg {"out" text}))))))
+        (flush [])
+        (close []))
+      (BufferedWriter. 1024)
+      (PrintWriter. true)))

test/babashka/impl/nrepl_server_test.clj

@@ -158,7 +158,13 @@
               (let [reply (read-reply in session @id)
                     sessions (set (:sessions reply))]
                 (is (contains? sessions session))
-                (is (not (contains? sessions new-session)))))))))))
+                (is (not (contains? sessions new-session))))))))
+      (testing "output"
+        (bencode/write-bencode os {"op" "eval" "code" "(dotimes [i 3] (println \"Hello\"))"
+                                   "session" session "id" (new-id!)})
+        (dotimes [_ 3]
+          (let [reply (read-reply in session @id)]
+            (is (= "Hello\n" (:out reply)))))))))
 
 (deftest nrepl-server-test
   (let [proc-state (atom nil)]