diff --git a/.gitmodules b/.gitmodules index 1e094c0f..c8bd4d60 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,3 +8,6 @@ [submodule "babashka.pods"] path = babashka.pods url = https://github.com/babashka/babashka.pods +[submodule "babashka.nrepl"] + path = babashka.nrepl + url = https://github.com/babashka/babashka.nrepl diff --git a/babashka.nrepl b/babashka.nrepl new file mode 160000 index 00000000..516a5828 --- /dev/null +++ b/babashka.nrepl @@ -0,0 +1 @@ +Subproject commit 516a5828dff4fa10c89ab7b3dedaf10fb2978736 diff --git a/deps.edn b/deps.edn index e3ffc69b..49125a71 100644 --- a/deps.edn +++ b/deps.edn @@ -2,6 +2,7 @@ "feature-yaml" "feature-csv" "feature-transit" "feature-java-time" "feature-java-nio" "sci/src" "babashka.curl/src" "babashka.pods/src" + "babashka.nrepl/src" "resources" "sci/resources"], :deps {org.clojure/clojure {:mvn/version "1.10.2-alpha1"}, org.clojure/tools.reader {:mvn/version "1.3.2"}, diff --git a/project.clj b/project.clj index 649ade7e..45fa5684 100644 --- a/project.clj +++ b/project.clj @@ -7,7 +7,8 @@ :url "https://github.com/borkdude/babashka"} :license {:name "Eclipse Public License 1.0" :url "http://opensource.org/licenses/eclipse-1.0.php"} - :source-paths ["src" "sci/src" "babashka.curl/src" "babashka.pods/src"] + :source-paths ["src" "sci/src" "babashka.curl/src" "babashka.pods/src" + "babashka.nrepl/src"] ;; for debugging Reflector.java code: ;; :java-source-paths ["sci/reflector/src-java"] :java-source-paths ["src-java"] diff --git a/src/babashka/impl/nrepl_server.clj b/src/babashka/impl/nrepl_server.clj deleted file mode 100644 index 19d50420..00000000 --- a/src/babashka/impl/nrepl_server.clj +++ /dev/null @@ -1,198 +0,0 @@ -(ns babashka.impl.nrepl-server - {:no-doc true} - (:refer-clojure :exclude [send future binding]) - (:require [babashka.impl.nrepl-server.utils :refer [dev? response-for send send-exception - replying-print-writer]] - [bencode.core :refer [read-bencode]] - [clojure.string :as str] - [clojure.tools.reader.reader-types :as r] - [sci.core :as sci] - [sci.impl.interpreter :refer [eval-string* eval-form]] - [sci.impl.parser :as p] - [sci.impl.utils :as sci-utils] - [sci.impl.vars :as vars]) - (:import [java.io InputStream PushbackInputStream EOFException BufferedOutputStream] - [java.net ServerSocket])) - -(set! *warn-on-reflection* true) - -(defn eval-msg [ctx o msg] - (try - (let [code-str (get msg :code) - reader (r/indexing-push-back-reader (r/string-push-back-reader code-str)) - ns-str (get msg :ns) - sci-ns (when ns-str (sci-utils/namespace-object (:env ctx) (symbol ns-str) true nil))] - (when @dev? (println "current ns" (vars/current-ns-name))) - (sci/with-bindings (cond-> {} - sci-ns (assoc vars/current-ns sci-ns)) - (loop [] - (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 pw} - (eval-form ctx form))) - env (:env ctx)] - (swap! env update-in [:namespaces 'clojure.core] - (fn [core] - (assoc core - '*1 value - '*2 (get core '*1) - '*3 (get core '*2)))) - (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)) - (recur))))) - (send o (response-for msg {"status" #{"done"}}))) - (catch Exception ex - (swap! (:env ctx) update-in [:namespaces 'clojure.core] - assoc '*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 (get ns->alias (symbol sym-ns)) "/" sym-name)) - [sym-ns (str (get ns->alias (symbol sym-ns)) "/" sym-name)]) - (when (re-find pat (str sym-ns "/" sym-name)) - [sym-ns (str sym-ns "/" sym-name)])))))) - -(defn complete [ctx o msg] - (try - (let [ns-str (get msg :ns) - sci-ns (when ns-str - (sci-utils/namespace-object (:env ctx) (symbol ns-str) nil false))] - (sci/binding [vars/current-ns (or sci-ns @vars/current-ns)] - (let [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"}}))))) - -(defn close-session [ctx msg _is os] - (let [session (:session msg)] - (swap! (:sessions ctx) disj session)) - (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? %) - (String. (bytes %)) - %) (vals msg))) - (update :op keyword))) - -(defn session-loop [ctx ^InputStream is os id] - (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))] - (swap! (:sessions ctx) (fnil conj #{}) id) - (send os (response-for msg {"new-session" id "status" #{"done"}})) - (recur ctx is os id))) - :close (do (close-session ctx msg is os) - (recur ctx is os id)) - :eval (do - (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) - (recur ctx is os id)) - :complete (do - (complete ctx os msg) - (recur ctx is os id)) - :describe - (do (send os (response-for msg {"status" #{"done"} - "ops" (zipmap #{"clone" "close" "eval" "load-file" - "complete" "describe" "ls-sessions"} - (repeat {}))})) - (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)) - (send os (response-for msg {"status" #{"error" "unknown-op" "done"}})) - (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) - out (BufferedOutputStream. out)] - (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"))) - (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 [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)) - (Integer. ^String (second parts))]) - host+port (if-not address (str "localhost:" port) - host+port) - socket-server (new ServerSocket port 0 address)] - (println "Started nREPL server at" host+port) - (println "For more info visit https://github.com/borkdude/babashka/blob/master/doc/repl.md#nrepl.") - (reset! server socket-server) - (listen ctx socket-server))) diff --git a/src/babashka/impl/nrepl_server/utils.clj b/src/babashka/impl/nrepl_server/utils.clj deleted file mode 100644 index b96cddfd..00000000 --- a/src/babashka/impl/nrepl_server/utils.clj +++ /dev/null @@ -1,63 +0,0 @@ -(ns babashka.impl.nrepl-server.utils - {:no-doc true} - (:refer-clojure :exclude [send]) - (:require [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))) diff --git a/src/babashka/main.clj b/src/babashka/main.clj index 781035be..c5c3572e 100644 --- a/src/babashka/main.clj +++ b/src/babashka/main.clj @@ -14,12 +14,12 @@ [babashka.impl.common :as common] [babashka.impl.curl :refer [curl-namespace]] [babashka.impl.features :as features] - [babashka.impl.nrepl-server :as nrepl-server] [babashka.impl.pods :as pods] [babashka.impl.repl :as repl] [babashka.impl.socket-repl :as socket-repl] [babashka.impl.test :as t] [babashka.impl.tools.cli :refer [tools-cli-namespace]] + [babashka.nrepl.server :as nrepl-server] [babashka.wait :as wait] [clojure.edn :as edn] [clojure.java.io :as io] @@ -298,9 +298,14 @@ If neither -e, -f, or --socket-repl are specified, then the first argument that @(promise)) (defn start-nrepl! [address ctx] - (nrepl-server/start-server! ctx address) + (let [dev? (= "true" (System/getenv "BABASHKA_DEV")) + nrepl-opts (nrepl-server/parse-opt address) + nrepl-opts (assoc nrepl-opts :debug dev?)] + (nrepl-server/start-server! ctx nrepl-opts) + (binding [*out* *err*] + (println "For more info visit https://github.com/borkdude/babashka/blob/master/doc/repl.md#nrepl."))) ;; hang until SIGINT - #_@(promise)) + @(promise)) (defn exit [n] (throw (ex-info "" {:bb/exit-code n}))) diff --git a/test/babashka/impl/nrepl_server_test.clj b/test/babashka/impl/nrepl_server_test.clj index 5fd1e9c9..a2737e7e 100644 --- a/test/babashka/impl/nrepl_server_test.clj +++ b/test/babashka/impl/nrepl_server_test.clj @@ -1,7 +1,7 @@ (ns babashka.impl.nrepl-server-test (:require - [babashka.impl.nrepl-server :refer [start-server! stop-server!]] [babashka.main :as main] + [babashka.nrepl.server :refer [start-server! stop-server! parse-opt]] [babashka.test-utils :as tu] [babashka.wait :as wait] [bencode.core :as bencode] @@ -44,7 +44,7 @@ (recur)))))) (defn nrepl-test [] - (with-open [socket (java.net.Socket. "127.0.0.1" 1667) + (with-open [socket (java.net.Socket. "127.0.0.1" 1668) in (.getInputStream socket) in (java.io.PushbackInputStream. in) os (.getOutputStream socket)] @@ -175,25 +175,27 @@ (is (= "Hello\n" (:out reply))))))))) (deftest nrepl-server-test - (let [proc-state (atom nil)] + (let [proc-state (atom nil) + server-state (atom nil)] (try (if tu/jvm? - (future - (start-server! - (init {:namespaces main/namespaces - :features #{:bb}}) "0.0.0.0:1667")) - (let [pb (ProcessBuilder. ["./bb" "--nrepl-server" "0.0.0.0:1667"]) + (let [server (start-server! + (init {:namespaces main/namespaces + :features #{:bb}}) + (parse-opt "0.0.0.0:1668"))] + (reset! server-state server)) + (let [pb (ProcessBuilder. ["./bb" "--nrepl-server" "0.0.0.0:1668"]) _ (.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) + (babashka.wait/wait-for-port "localhost" 1668) (nrepl-test) (finally (if tu/jvm? - (stop-server!) + (stop-server! @server-state) (when-let [proc @proc-state] (.destroy ^Process proc)))))))