[#301] Add nREPL server (#326)

README.md

@@ -172,7 +172,7 @@ Check out the image on [Docker hub](https://hub.docker.com/r/borkdude/babashka/)
 Usage: bb [ -i | -I ] [ -o | -O ] [ --stream ] [--verbose]
           [ ( --classpath | -cp ) <cp> ] [ --uberscript <file> ]
           [ ( --main | -m ) <main-namespace> | -e <expression> | -f <file> |
-            --repl | --socket-repl [<host>:]<port> ]
+            --repl | --socket-repl [<host>:]<port> | --nrepl-server [<host>:]<port> ]
           [ arg* ]
 
 Options:
@@ -194,6 +194,7 @@ Options:
   -m, --main <ns>     Call the -main function from namespace with args.
   --repl              Start REPL. Use rlwrap for history.
   --socket-repl       Start socket REPL. Specify port (e.g. 1666) or host and port separated by colon (e.g. 127.0.0.1:1666).
+  --nrepl-server      Start nREPL server. Specify port (e.g. 1667) or host and port separated by colon (e.g. 127.0.0.1:1667).
   --time              Print execution time before exiting.
   --                  Stop parsing args and pass everything after -- to *command-line-args*
 

deps.edn

@@ -9,7 +9,9 @@
         org.clojure/data.csv {:mvn/version "1.0.0"},
         cheshire {:mvn/version "5.10.0"}
         fipp {:mvn/version "0.6.22"}
-        com.cognitect/transit-clj {:mvn/version "1.0.324"}}
+        com.cognitect/transit-clj {:mvn/version "1.0.324"}
+        ;; nrepl/bencode {:mvn/version "1.0.0"}
+        }
  :aliases {:main
            {:main-opts ["-m" "babashka.main"]}
            :profile

project.clj

@@ -19,7 +19,8 @@
                  [org.clojure/data.csv "1.0.0"]
                  [cheshire "5.10.0"]
                  [fipp "0.6.22"]
-                 [com.cognitect/transit-clj "1.0.324"]]
+                 [com.cognitect/transit-clj "1.0.324"]
+                 #_[nrepl/bencode "1.0.0"]]
   :profiles {:test {:dependencies [[clj-commons/conch "0.9.2"]
                                    [com.clojure-goes-fast/clj-async-profiler "0.4.0"]]}
              :uberjar {:global-vars {*assert* false}

src/babashka/impl/bencode.clj

@@ -0,0 +1,11 @@
+(ns babashka.impl.bencode
+  {:no-doc true}
+  (:require [babashka.impl.bencode.core :as bencode]
+            [sci.impl.namespaces :refer [copy-var]]
+            [sci.impl.vars :as vars]))
+
+(def tns (vars/->SciNamespace 'bencode.core nil))
+
+(def bencode-namespace
+  {'read-bencode (copy-var bencode/read-bencode tns)
+   'write-bencode (copy-var bencode/write-bencode tns)})

src/babashka/impl/bencode/core.clj

@@ -0,0 +1,420 @@
+(ns babashka.impl.bencode.core
+  "A netstring and bencode implementation for Clojure."
+  {:author "Meikel Brandmeyer"
+   :no-doc true}
+  (:require [clojure.java.io :as io])
+  (:import [java.io ByteArrayOutputStream
+            EOFException
+            InputStream
+            IOException
+            OutputStream
+            PushbackInputStream]))
+
+;; Copyright (c) Meikel Brandmeyer. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
+;; # Motivation
+;;
+;; In each and every application, which contacts peer processes via some
+;; communication channel, the handling of the communication channel is
+;; obviously a central part of the application. Unfortunately introduces
+;; handling of buffers of varying sizes often bugs in form of buffer
+;; overflows and similar.
+;;
+;; A strong factor in this situation is of course the protocol which goes
+;; over the wire. Depending on its design it might be difficult to estimate
+;; the size of the input up front. This introduces more handling of message
+;; buffers to accomodate for inputs of varying sizes. This is particularly
+;; difficult in languages like C, where there is no bounds checking of array
+;; accesses and where errors might go unnoticed for considerable amount of
+;; time.
+;;
+;; To address these issues D. Bernstein developed the so called
+;; [netstrings][net]. They are especially designed to allow easy construction
+;; of the message buffers, easy and robust parsing.
+;;
+;; BitTorrent extended this to the [bencode][bc] protocol which also
+;; includes ways to encode numbers and collections like lists or maps.
+;;
+;; *wire* is based on these ideas.
+;;
+;; [net]: http://cr.yp.to/proto/netstrings.txt
+;; [bc]:  http://wiki.theory.org/BitTorrentSpecification#Bencoding
+;;
+;; # Netstrings
+;;
+;; Now let's start with the basic netstrings. They consist of a byte count,
+;; followed a colon and the binary data and a trailing comma. Examples:
+;;
+;;     13:Hello, World!,
+;;     10:Guten Tag!,
+;;     0:,
+;;
+;; The initial byte count allows to efficiently allocate a sufficiently
+;; sized message buffer. The trailing comma serves as a hint to detect
+;; incorrect netstrings.
+;;
+;; ## Low-level reading
+;;
+;; We will need some low-level reading helpers to read the bytes from
+;; the input stream. These are `read-byte` as well as `read-bytes`. They
+;; are split out, because doing such a simple task as reading a byte is
+;; mild catastrophe in Java. So it would add some clutter to the algorithm
+;; `read-netstring`.
+;;
+;; On the other hand they might be also useful elsewhere.
+;;
+;; To remove some magic numbers from the code below.
+
+(set! *warn-on-reflection* true)
+
+(def #^{:const true} i     105)
+(def #^{:const true} l     108)
+(def #^{:const true} d     100)
+(def #^{:const true} comma 44)
+(def #^{:const true} minus 45)
+
+;; These two are only used boxed. So we keep them extra here.
+
+(def e     101)
+(def colon 58)
+
+(defn #^{:private true} read-byte
+  #^long [#^InputStream input]
+  (let [c (.read input)]
+    (when (neg? c)
+      (throw (EOFException. "Invalid netstring. Unexpected end of input.")))
+    ;; Here we have a quirk for example. `.read` returns -1 on end of
+    ;; input. However the Java `Byte` has only a range from -128 to 127.
+    ;; How does the fit together?
+    ;;
+    ;; The whole thing is shifted. `.read` actually returns an int
+    ;; between zero and 255. Everything below the value 128 stands
+    ;; for itself. But larger values are actually negative byte values.
+    ;;
+    ;; So we have to do some translation here. `Byte/byteValue` would
+    ;; do that for us, but we want to avoid boxing here.
+    (if (< 127 c) (- c 256) c)))
+
+(defn #^{:private true :tag "[B"} read-bytes
+  #^Object [#^InputStream input n]
+  (let [content (byte-array n)]
+    (loop [offset (int 0)
+           len    (int n)]
+      (let [result (.read input content offset len)]
+        (when (neg? result)
+          (throw
+           (EOFException.
+            "Invalid netstring. Less data available than expected.")))
+        (when (not= result len)
+          (recur (+ offset result) (- len result)))))
+    content))
+
+;; `read-long` is used for reading integers from the stream as well
+;; as the byte count prefixes of byte strings. The delimiter is \:
+;; for byte count prefixes and \e for integers.
+
+(defn #^{:private true} read-long
+  #^long [#^InputStream input delim]
+  (loop [n (long 0)]
+    ;; We read repeatedly a byte from the input…
+    (let [b (read-byte input)]
+      ;; …and stop at the delimiter.
+      (cond
+        (= b minus) (- (read-long input delim))
+        (= b delim) n
+        :else       (recur (+ (* n (long 10)) (- (long b) (long  48))))))))
+
+;; ## Reading a netstring
+;;
+;; Let's dive straight into reading a netstring from an `InputStream`.
+;;
+;; For convenience we split the function into two subfunctions. The
+;; public `read-netstring` is the normal entry point, which also checks
+;; for the trailing comma after reading the payload data with the
+;; private `read-netstring*`.
+;;
+;; The reason we need the less strict `read-netstring*` is that with
+;; bencode we don't have a trailing comma. So a check would not be
+;; beneficial here.
+;;
+;; However the consumer doesn't have to care. `read-netstring` as
+;; well as `read-bencode` provide the public entry points, which do
+;; the right thing. Although they both may reference the `read-netstring*`
+;; underneath.
+;;
+;; With this in mind we define the inner helper function first.
+
+(declare #^"[B" string>payload
+         #^String string<payload)
+
+(defn #^{:private true} read-netstring*
+  [input]
+  (read-bytes input (read-long input colon)))
+
+;; And the public facing API: `read-netstring`.
+
+(defn #^"[B" read-netstring
+  "Reads a classic netstring from input—an InputStream. Returns the
+  contained binary data as byte array."
+  [input]
+  (let [content (read-netstring* input)]
+    (when (not= (read-byte input) comma)
+      (throw (IOException. "Invalid netstring. ',' expected.")))
+    content))
+
+;; Similarly the `string>payload` and `string<payload` functions
+;; are defined as follows to simplify the conversion between strings
+;; and byte arrays in various parts of the code.
+
+(defn #^{:private true :tag "[B"} string>payload
+  [#^String s]
+  (.getBytes s "UTF-8"))
+
+(defn #^{:private true :tag String} string<payload
+  [#^"[B" b]
+  (String. b "UTF-8"))
+
+;; ## Writing a netstring
+;;
+;; This opposite operation – writing a netstring – is just as important.
+;;
+;; *Note:* We take here a byte array, just as we returned a byte
+;; array in `read-netstring`. The netstring should not be concerned
+;; about the actual contents. It just sees binary data.
+;;
+;; Similar to `read-netstring` we also split `write-netstring` into
+;; the entry point itself and a helper function.
+
+(defn #^{:private true} write-netstring*
+  [#^OutputStream output #^"[B" content]
+  (doto output
+    (.write (string>payload (str (alength content))))
+    (.write (int colon))
+    (.write content)))
+
+(defn write-netstring
+  "Write the given binary data to the output stream in form of a classic
+  netstring."
+  [#^OutputStream output content]
+  (doto output
+    (write-netstring* content)
+    (.write (int comma))))
+
+;; # Bencode
+;;
+;; However most of the time we don't want to send simple blobs of data
+;; back and forth. The data sent between the communication peers usually
+;; have some structure, which has to be carried along the way to the
+;; other side. Here [bencode][bc] come into play.
+;;
+;; Bencode defines additionally to netstrings easily parseable structures
+;; for lists, maps and numbers. It allows to communicate information
+;; about the data structure to the peer on the other side.
+;;
+;; ## Tokens
+;;
+;; The data is encoded in tokens in bencode. There are several types of
+;; tokens:
+;;
+;;  * A netstring without trailing comma for string data.
+;;  * A tag specifiyng the type of the following tokens.
+;;    The tag may be one of these:
+;;     * `\i` to encode integers.
+;;     * `\l` to encode lists of items.
+;;     * `\d` to encode maps of item pairs.
+;;  * `\e` to end the a previously started tag.
+;;
+;; ## Reading bencode
+;;
+;; Reading bencode encoded data is basically parsing a stream of tokens
+;; from the input. Hence we need a read-token helper which allows to
+;; retrieve the next token.
+
+(defn #^{:private true} read-token
+  [#^PushbackInputStream input]
+  (let [ch (read-byte input)]
+    (cond
+      (= (long e) ch) nil
+      (= i ch) :integer
+      (= l ch) :list
+      (= d ch) :map
+      :else    (do
+                 (.unread input (int ch))
+                 (read-netstring* input)))))
+
+;; To read the bencode encoded data we walk a long the sequence of tokens
+;; and act according to the found tags.
+
+(declare read-integer read-list read-map)
+
+(defn read-bencode
+  "Read bencode token from the input stream."
+  [input]
+  (let [token (read-token input)]
+    (case token
+      :integer (read-integer input)
+      :list    (read-list input)
+      :map     (read-map input)
+      token)))
+
+;; Of course integers and the collection types are have to treated specially.
+;;
+;; Integers for example consist of a sequence of decimal digits.
+
+(defn #^{:private true} read-integer
+  [input]
+  (read-long input e))
+
+;; *Note:* integers are an ugly special case, which cannot be
+;; handled with `read-token` or `read-netstring*`.
+;;
+;; Lists are just a sequence of other tokens.
+
+(declare token-seq)
+
+(defn #^{:private true} read-list
+  [input]
+  (vec (token-seq input)))
+
+;; Maps are sequences of key/value pairs. The keys are always
+;; decoded into strings. The values are kept as is.
+
+(defn #^{:private true} read-map
+  [input]
+  (->> (token-seq input)
+       (into {} (comp (partition-all 2)
+                      (map (fn [[k v]]
+                             [(string<payload k) v]))))))
+
+;; The final missing piece is `token-seq`. This a just a simple
+;; sequence which reads tokens until the next `\e`.
+
+(defn #^{:private true} token-seq
+  [input]
+  (->> #(read-bencode input)
+       repeatedly
+       (take-while identity)))
+
+;; ## Writing bencode
+;;
+;; Writing bencode is similar easy as reading it. The main entry point
+;; takes a string, map, sequence or integer and writes it according to
+;; the rules to the given OutputStream.
+
+(defmulti write-bencode
+  "Write the given thing to the output stream. “Thing” means here a
+  string, map, sequence or integer. Alternatively an ByteArray may
+  be provided whose contents are written as a bytestring. Similar
+  the contents of a given InputStream are written as a byte string.
+  Named things (symbols or keywords) are written in the form
+  'namespace/name'."
+  (fn [_output thing]
+    (cond
+      (bytes? thing) :bytes
+      (instance? InputStream thing) :input-stream
+      (integer? thing) :integer
+      (string? thing)  :string
+      (symbol? thing)  :named
+      (keyword? thing) :named
+      (map? thing)     :map
+      (or (nil? thing) (coll? thing) (.isArray (class thing))) :list
+      :else (type thing))))
+
+(defmethod write-bencode :default
+  [output x]
+  (throw (IllegalArgumentException. (str "Cannot write value of type " (class x)))))
+
+;; The following methods should be pretty straight-forward.
+;;
+;; The easiest case is of course when we already have a byte array.
+;; We can simply pass it on to the underlying machinery.
+
+(defmethod write-bencode :bytes
+  [output bytes]
+  (write-netstring* output bytes))
+
+;; For strings we simply write the string as a netstring without
+;; trailing comma after encoding the string as UTF-8 bytes.
+
+(defmethod write-bencode :string
+  [output string]
+  (write-netstring* output (string>payload string)))
+
+;; Streaming does not really work, since we need to know the
+;; number of bytes to write upfront. So we read in everything
+;; for InputStreams and pass on the byte array.
+
+(defmethod write-bencode :input-stream
+  [output stream]
+  (let [bytes (ByteArrayOutputStream.)]
+    (io/copy stream bytes)
+    (write-netstring* output (.toByteArray bytes))))
+
+;; Integers are again the ugly special case.
+
+(defmethod write-bencode :integer
+  [#^OutputStream output n]
+  (doto output
+    (.write (int i))
+    (.write (string>payload (str n)))
+    (.write (int e))))
+
+;; Symbols and keywords are converted to a string of the
+;; form 'namespace/name' or just 'name' in case its not
+;; qualified. We do not add colons for keywords since the
+;; other side might not have the notion of keywords.
+
+(defmethod write-bencode :named
+  [output thing]
+  (let [nspace (namespace thing)
+        name   (name thing)]
+    (->> (str (when nspace (str nspace "/")) name)
+         string>payload
+         (write-netstring* output))))
+
+;; Lists as well as maps work recursively to print their elements.
+
+(defmethod write-bencode :list
+  [#^OutputStream output lst]
+  (.write output (int l))
+  (doseq [elt lst]
+    (write-bencode output elt))
+  (.write output (int e)))
+
+;; However, maps are a bit special because their keys are sorted
+;; lexicographically based on their byte string represantation.
+
+(declare lexicographically)
+
+(defmethod write-bencode :map
+  [#^OutputStream output m]
+  (let [translation (into {} (map (juxt string>payload identity) (keys m)))
+        key-strings (sort lexicographically (keys translation))
+        >value      (comp m translation)]
+    (.write output (int d))
+    (doseq [k key-strings]
+      (write-netstring* output k)
+      (write-bencode output (>value k)))
+    (.write output (int e))))
+
+;; However, since byte arrays are not `Comparable` we need a custom
+;; comparator which we can feed to `sort`.
+
+(defn #^{:private true} lexicographically
+  [#^"[B" a #^"[B" b]
+  (let [alen (alength a)
+        blen (alength b)
+        len  (min alen blen)]
+    (loop [i 0]
+      (if (== i len)
+        (- alen blen)
+        (let [x (- (int (aget a i)) (int (aget b i)))]
+          (if (zero? x)
+            (recur (inc i))
+            x))))))

src/babashka/impl/classes.clj

@@ -204,6 +204,8 @@
                    java.security.MessageDigest
                    (instance? java.io.InputStream v)
                    java.io.InputStream
+                   (instance? java.io.OutputStream v)
+                   java.io.OutputStream
                    (instance? java.nio.file.FileSystem v)
                    java.nio.file.FileSystem)))))
 

src/babashka/impl/clojure/main.clj

@@ -48,6 +48,11 @@
              *e nil]
      ~@body))
 
+(def ^{:doc "A sequence of lib specs that are applied to `require`
+by default when a new command-line REPL is started."} repl-requires
+  '[[clojure.repl :refer (dir doc)]
+    [clojure.pprint :refer (pprint)]])
+
 (defn repl
   "Generic, reusable, read-eval-print loop. By default, reads from *in*,
   writes to *out*, and prints exception summaries to *err*. If you use the

src/babashka/impl/clojure/stacktrace.clj

@@ -1,10 +1,16 @@
 (ns babashka.impl.clojure.stacktrace
   {:no-doc true}
-  (:require [clojure.stacktrace :as stacktrace]))
+  (:require [clojure.stacktrace :as stacktrace]
+            [sci.core :as sci]))
+
+(defmacro wrap-out [f]
+  `(fn [& ~'args]
+     (binding [*out* @sci/out]
+       (apply ~f ~'args))))
 
 (def stacktrace-namespace
   {'root-cause stacktrace/root-cause
-   'print-trace-element stacktrace/print-trace-element
+   'print-trace-element (wrap-out stacktrace/print-trace-element)
-   'print-throwable stacktrace/print-throwable
+   'print-throwable (wrap-out stacktrace/print-throwable)
-   'print-stack-trace stacktrace/print-stack-trace
+   'print-stack-trace (wrap-out stacktrace/print-stack-trace)
-   'print-cause-trace stacktrace/print-cause-trace})
+   'print-cause-trace (wrap-out stacktrace/print-cause-trace)})

src/babashka/impl/nrepl_server.clj

@@ -0,0 +1,236 @@
+(ns babashka.impl.nrepl-server
+  {:no-doc true}
+  (:refer-clojure :exclude [send future binding])
+  (:require [babashka.impl.bencode.core :refer [write-bencode read-bencode]]
+            [clojure.string :as str]
+            [sci.core :as sci]
+            [sci.impl.interpreter :refer [eval-string*]]
+            [sci.impl.utils :as sci-utils]
+            [sci.impl.vars :as vars])
+  (:import [java.io StringWriter OutputStream InputStream PushbackInputStream EOFException]
+           [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")
+        m (assoc msg "session" session)
+        id (get old-msg :id "unknown")
+        m (assoc m "id" id)]
+    m))
+
+(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 #_threads]
+  (try
+    (let [ns-str (get msg :ns)
+          sci-ns (if ns-str
+                   (sci-utils/namespace-object (:env ctx) (symbol ns-str) nil false)
+                   (sci-utils/namespace-object (:env ctx) 'user nil false))]
+      (sci/binding [vars/current-ns sci-ns
+                    sci/print-length @sci/print-length]
+        (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)
+                sw (StringWriter.)
+                value (if (str/blank? code-str)
+                        ::nil
+                        (sci/binding [sci/out sw
+                                      vars/current-ns @vars/current-ns] (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)))
+      (send-exception o msg ex))))
+
+(defn fully-qualified-syms [ctx ns-sym]
+  (let [syms (eval-string* ctx (format "(keys (ns-map '%s))" ns-sym))
+        sym-strs (map #(str "`" %) syms)
+        sym-expr (str "[" (str/join " " sym-strs) "]")
+        syms (eval-string* ctx sym-expr)]
+    syms))
+
+(defn match [_alias->ns ns->alias query [sym-ns sym-name qualifier]]
+  (let [pat (re-pattern query)]
+    (or (when (and (identical? :unqualified qualifier) (re-find pat sym-name))
+          [sym-ns sym-name])
+        (when sym-ns
+          (or (when (re-find pat (str sym-ns "/" sym-name))
+                [sym-ns (str sym-ns "/" sym-name)])
+              (when (re-find pat (str (get ns->alias (symbol sym-ns)) "/" sym-name))
+                [sym-ns (str (get ns->alias (symbol sym-ns)) "/" sym-name)]))))))
+
+(defn complete [ctx o msg]
+  (try
+    (let [ns-str (get msg :ns)
+          sci-ns (if ns-str
+                   (sci-utils/namespace-object (:env ctx) (symbol ns-str) nil false)
+                   (sci-utils/namespace-object (:env ctx) 'user nil false))]
+      (sci/binding [vars/current-ns sci-ns]
+        (let [
+              ;;ns-sym (symbol ns)
+              query (:symbol msg)
+              from-current-ns (fully-qualified-syms ctx (eval-string* ctx "(ns-name *ns*)"))
+              from-current-ns (map (fn [sym]
+                                     [(namespace sym) (name sym) :unqualified])
+                                   from-current-ns)
+              alias->ns (eval-string* ctx "(let [m (ns-aliases *ns*)] (zipmap (keys m) (map ns-name (vals m))))")
+              ns->alias (zipmap (vals alias->ns) (keys alias->ns))
+              from-aliased-nss (doall (mapcat
+                                       (fn [alias]
+                                         (let [ns (get alias->ns alias)
+                                               syms (eval-string* ctx (format "(keys (ns-publics '%s))" ns))]
+                                           (map (fn [sym]
+                                                  [(str ns) (str sym) :qualified])
+                                                syms)))
+                                       (keys alias->ns)))
+              svs (concat from-current-ns from-aliased-nss)
+              completions (keep (fn [entry]
+                                  (match alias->ns ns->alias query entry))
+                                svs)
+              completions (mapv (fn [[namespace name]]
+                                  {"candidate" (str name) "ns" (str namespace) #_"type" #_"function"})
+                                completions)]
+          (when @dev? (prn "completions" completions))
+          (send o (response-for msg {"completions" completions
+                                     "status" #{"done"}})))))
+       (catch Throwable e
+         (println e)
+         (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? %)
+                      (String. (bytes %))
+                      %) (vals msg)))
+      (update :op keyword)))
+
+(defn session-loop [ctx ^InputStream is os id #_threads]
+  (when @dev? (println "Reading!" id (.available is)))
+  (when-let [msg (try (read-bencode is)
+                      (catch EOFException _
+                        (println "Client closed connection.")))]
+    (let [msg (read-msg msg)]
+      (when @dev? (prn "Received" msg))
+      (case (get msg :op)
+        :clone (do
+                 (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)))
+        :eval (do
+                (eval-msg ctx os msg #_threads)
+                (recur ctx is os id #_threads))
+        :load-file (let [file (:file msg)
+                         msg (assoc msg :code file)]
+                     (eval-msg ctx os msg #_threads)
+                     (recur ctx is os id #_threads))
+        :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))
+        :describe
+        (do (send os (response-for msg {"status" #{"done"}
+                                        "aux" {}
+                                        "ops" (zipmap #{"clone", "describe", "eval"}
+                                                      (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))
+        ;; fallback
+        (do (when @dev?
+              (println "Unhandled message" msg))
+            (send os (response-for msg {"status" #{"error" "unknown-op" "done"}}))
+            (recur ctx is os id #_threads))))))
+
+(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 {})]
+    (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)))
+    (recur ctx listener)))
+
+
+(def server (atom nil))
+
+(defn stop-server! []
+  (when-let [s @server]
+    (.close ^ServerSocket s)
+    (reset! server nil)))
+
+(defn start-server! [ctx host+port]
+  (vreset! dev? (= "true" (System/getenv "BABASHKA_DEV")))
+  (let [parts (str/split host+port #":")
+        [address port] (if (= 1 (count parts))
+                         [nil (Integer. ^String (first parts))]
+                         [(java.net.InetAddress/getByName (first parts))
+                          (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)
+      (listen ctx socket-server))))

src/babashka/impl/transit.clj

@@ -3,6 +3,7 @@
             [sci.impl.namespaces :refer [copy-var]]
             [sci.impl.vars :as vars]))
 
+
 (def tns (vars/->SciNamespace 'cognitect.transit nil))
 
 (def transit-namespace

src/babashka/main.clj

@@ -2,18 +2,20 @@
   {:no-doc true}
   (:require
    [babashka.impl.async :refer [async-namespace async-protocols-namespace]]
+   [babashka.impl.bencode :refer [bencode-namespace]]
    [babashka.impl.cheshire :refer [cheshire-core-namespace]]
    [babashka.impl.classes :as classes]
    [babashka.impl.classpath :as cp]
    [babashka.impl.clojure.core :refer [core-extras]]
    [babashka.impl.clojure.java.io :refer [io-namespace]]
    [babashka.impl.clojure.java.shell :refer [shell-namespace]]
-   [babashka.impl.clojure.main :refer [demunge]]
+   [babashka.impl.clojure.main :as clojure-main :refer [demunge]]
    [babashka.impl.clojure.pprint :refer [pprint-namespace]]
    [babashka.impl.clojure.stacktrace :refer [stacktrace-namespace]]
    [babashka.impl.common :as common]
    [babashka.impl.csv :as csv]
    [babashka.impl.curl :refer [curl-namespace]]
+   [babashka.impl.nrepl-server :as nrepl-server]
    [babashka.impl.pipe-signal-handler :refer [handle-pipe! pipe-signal-received?]]
    [babashka.impl.repl :as repl]
    [babashka.impl.socket-repl :as socket-repl]
@@ -115,6 +117,12 @@
                               (assoc opts-map
                                      :socket-repl (or (first options)
                                                       "1666"))))
+                     ("--nrepl-server")
+                     (let [options (next options)]
+                       (recur (next options)
+                              (assoc opts-map
+                                     :nrepl (or (first options)
+                                                      "1667"))))
                      ("--eval", "-e")
                      (let [options (next options)]
                        (recur (next options)
@@ -158,7 +166,7 @@
 (def usage-string "Usage: bb [ -i | -I ] [ -o | -O ] [ --stream ] [--verbose]
           [ ( --classpath | -cp ) <cp> ] [ --uberscript <file> ]
           [ ( --main | -m ) <main-namespace> | -e <expression> | -f <file> |
-            --repl | --socket-repl [<host>:]<port> ]
+            --repl | --socket-repl [<host>:]<port> | --nrepl-server [<host>:]<port> ]
           [ arg* ]")
 (defn print-usage []
   (println usage-string))
@@ -188,6 +196,7 @@
   -m, --main <ns>     Call the -main function from namespace with args.
   --repl              Start REPL. Use rlwrap for history.
   --socket-repl       Start socket REPL. Specify port (e.g. 1666) or host and port separated by colon (e.g. 127.0.0.1:1666).
+  --nrepl-server      Start nREPL server. Specify port (e.g. 1667) or host and port separated by colon (e.g. 127.0.0.1:1667).
   --time              Print execution time before exiting.
   --                  Stop parsing args and pass everything after -- to *command-line-args*
 
@@ -218,6 +227,11 @@ Everything after that is bound to *command-line-args*."))
   ;; hang until SIGINT
   @(promise))
 
+(defn start-nrepl! [address ctx]
+  (nrepl-server/start-server! ctx address)
+  ;; hang until SIGINT
+  #_@(promise))
+
 (defn exit [n]
   (throw (ex-info "" {:bb/exit-code n})))
 
@@ -232,7 +246,8 @@ Everything after that is bound to *command-line-args*."))
     csv clojure.data.csv
     json cheshire.core
     curl babashka.curl
-    transit cognitect.transit})
+    transit cognitect.transit
+    bencode bencode.core})
 
 (def cp-state (atom nil))
 
@@ -258,13 +273,15 @@ Everything after that is bound to *command-line-args*."))
    'clojure.data.csv csv/csv-namespace
    'cheshire.core cheshire-core-namespace
    'clojure.stacktrace stacktrace-namespace
-   'clojure.main {'demunge demunge}
+   'clojure.main {'demunge demunge
+                  'repl-requires clojure-main/repl-requires}
    'clojure.repl {'demunge demunge}
    'clojure.test t/clojure-test-namespace
    'babashka.classpath {'add-classpath add-classpath*}
    'clojure.pprint pprint-namespace
    'babashka.curl curl-namespace
-   'cognitect.transit transit-namespace})
+   'cognitect.transit transit-namespace
+   'bencode.core bencode-namespace})
 
 (def bindings
   {'java.lang.System/exit exit ;; override exit, so we have more control
@@ -295,7 +312,7 @@ Everything after that is bound to *command-line-args*."))
             {:keys [:version :shell-in :edn-in :shell-out :edn-out
                     :help? :file :command-line-args
                     :expressions :stream? :time?
-                    :repl :socket-repl
+                    :repl :socket-repl :nrepl
                     :verbose? :classpath
                     :main :uberscript] :as _opts}
             (parse-opts args)
@@ -403,6 +420,7 @@ Everything after that is bound to *command-line-args*."))
                        [(print-help) 0]
                        repl [(repl/start-repl! sci-ctx) 0]
                        socket-repl [(start-socket-repl! socket-repl sci-ctx) 0]
+                       nrepl [(start-nrepl! nrepl sci-ctx) 0]
                        (not (str/blank? expression))
                        (try
                          (loop []
@@ -446,7 +464,8 @@ Everything after that is bound to *command-line-args*."))
 (defn -main
   [& args]
   (if-let [dev-opts (System/getenv "BABASHKA_DEV")]
-    (let [{:keys [:n]} (edn/read-string dev-opts)
+    (let [{:keys [:n]} (if (= "true" dev-opts) {:n 1}
+                           (edn/read-string dev-opts))
           last-iteration (dec n)]
       (dotimes [i n]
         (if (< i last-iteration)

src/babashka/wait.clj

@@ -17,8 +17,8 @@
                      opts)
          t0 (System/currentTimeMillis)]
      (loop []
-       (let [v (try (with-open [_ (Socket. host port)]
+       (let [v (try (.close (Socket. host port))
-                      (- (System/currentTimeMillis) t0))
+                    (- (System/currentTimeMillis) t0)
                     (catch ConnectException _e
                       (let [took (- (System/currentTimeMillis) t0)]
                         (if (and timeout (>= took timeout))

test/babashka/impl/nrepl_server_test.clj

@@ -0,0 +1,120 @@
+(ns babashka.impl.nrepl-server-test
+  (:require
+   [babashka.impl.bencode.core :as bencode]
+   [babashka.impl.nrepl-server :refer [start-server! stop-server!]]
+   [babashka.test-utils :as tu]
+   [babashka.wait :as wait]
+   [cheshire.core :as cheshire]
+   [clojure.java.shell :refer [sh]]
+   [clojure.test :as t :refer [deftest is testing]]
+   [sci.impl.opts :refer [init]])
+  (:import [java.lang ProcessBuilder$Redirect]))
+
+(set! *warn-on-reflection* true)
+
+(defn bytes->str [x]
+  (if (bytes? x) (String. (bytes x))
+      (str x)))
+
+(defn read-msg [msg]
+  (let [res (zipmap (map keyword (keys msg))
+                    (map #(if (bytes? %)
+                            (String. (bytes %))
+                            %)
+                         (vals msg)))
+        res (if-let [status (:status res)]
+              (assoc res :status (mapv bytes->str status))
+              res)]
+    res))
+
+(defn read-reply [in session id]
+  (loop []
+    (let [msg (read-msg (bencode/read-bencode in))]
+      (if (and (= (:session msg) session)
+               (= (:id msg) id))
+        msg
+        (recur)))))
+
+(defn nrepl-test []
+  (with-open [socket (java.net.Socket. "127.0.0.1" 1667)
+              in (.getInputStream socket)
+              in (java.io.PushbackInputStream. in)
+              os (.getOutputStream socket)]
+    (bencode/write-bencode os {"op" "clone"})
+    (let [session (:new-session (read-msg (bencode/read-bencode in)))]
+      (testing "session"
+        (is session))
+      (testing "eval"
+        (bencode/write-bencode os {"op" "eval" "code" "(+ 1 2 3)" "session" session "id" 1})
+        (let [msg (read-reply in session 1)
+              id (:id msg)
+              value (:value msg)]
+          (is (= 1 id))
+          (is (= value "6"))))
+      (testing "load-file"
+        (bencode/write-bencode os {"op" "load-file" "file" "(ns foo) (defn foo [] :foo)" "session" session "id" 2})
+        (read-reply in session 2)
+        (bencode/write-bencode os {"op" "eval" "code" "(foo)" "ns" "foo" "session" session "id" 3})
+        (is (= ":foo" (:value (read-reply in session 3)))))
+      (testing "complete"
+        (testing "completions for fo"
+          (bencode/write-bencode os {"op" "complete"
+                                     "symbol" "fo"
+                                     "session" session
+                                     "id" 4
+                                     "ns" "foo"})
+          (let [reply (read-reply in session 4)
+                completions (:completions reply)
+                completions (mapv read-msg completions)
+                completions (into #{} (map (juxt :ns :candidate)) completions)]
+            (is (contains? completions ["foo" "foo"]))
+            (is (contains? completions ["clojure.core" "format"]))))
+        (testing "completions for quux should be empty"
+          (bencode/write-bencode os {"op" "complete"
+                                     "symbol" "quux"
+                                     "session" session "id" 6
+                                     "ns" "foo"})
+          (let [reply (read-reply in session 6)
+                completions (:completions reply)]
+            (is (empty? completions)))
+          (testing "unless quux is an alias"
+            (bencode/write-bencode os {"op" "eval" "code" "(require '[cheshire.core :as quux])" "session" session "id" 7})
+            (bencode/write-bencode os {"op" "complete" "symbol" "quux" "session" session "id" 8})
+            (let [reply (read-reply in session 8)
+                  completions (:completions reply)
+                  completions (mapv read-msg completions)
+                  completions (into #{} (map (juxt :ns :candidate)) completions)]
+              (is (contains? completions ["cheshire.core" "quux/generate-string"]))))))
+      #_(testing "interrupt" ;; .stop doesn't work on Thread in GraalVM, this is why we can't have this yet
+          (bencode/write-bencode os {"op" "eval" "code" "(range)" "session" session "id" 9})
+          (Thread/sleep 1000)
+          (bencode/write-bencode os {"op" "interrupt" "session" session "interrupt-id" 9 "id" 10})
+          (is (contains? (set (:status (read-reply in session 10))) "done"))))))
+
+(deftest nrepl-server-test
+  (let [proc-state (atom nil)]
+    (try
+      (if tu/jvm?
+        (future
+          (start-server!
+           (init {:namespaces {'cheshire.core {'generate-string cheshire/generate-string}}
+                  :features #{:bb}}) "0.0.0.0:1667"))
+        (let [pb (ProcessBuilder. ["./bb" "--nrepl-server" "0.0.0.0:1667"])
+              _ (.redirectError pb ProcessBuilder$Redirect/INHERIT)
+              ;; _ (.redirectOutput pb ProcessBuilder$Redirect/INHERIT)
+              ;; env (.environment pb)
+              ;; _ (.put env "BABASHKA_DEV" "true")
+              proc (.start pb)]
+          (reset! proc-state proc)))
+      (babashka.wait/wait-for-port "localhost" 1667)
+      (nrepl-test)
+      (finally
+        (if tu/jvm?
+          (stop-server!)
+          (when-let [proc @proc-state]
+            (.destroy ^Process proc)))))))
+
+;;;; Scratch
+
+(comment
+  )

test/babashka/impl/socket_repl_test.clj

@@ -2,10 +2,10 @@
   (:require
    [babashka.impl.socket-repl :refer [start-repl! stop-repl!]]
    [babashka.test-utils :as tu]
+   [clojure.java.io :as io]
    [clojure.java.shell :refer [sh]]
    [clojure.string :as str]
    [clojure.test :as t :refer [deftest is testing]]
-   [clojure.java.io :as io]
    [sci.impl.opts :refer [init]]))
 
 (set! *warn-on-reflection* true)