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

[#349] nrepl: write to output while evaluating

Browse source
This commit is contained in:
Michiel Borkent 2020-04-12 13:50:49 +02:00
parent b0a3549bab
commit f1c1a3db8e
3 changed files with 76 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

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

63
src/babashka/impl/nrepl_server/utils.clj Normal file
View file

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

8
test/babashka/impl/nrepl_server_test.clj
View file

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