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

[#432] use babashka.nrepl library

Browse source
This commit is contained in:
Michiel Borkent 2020-05-13 14:13:57 +02:00 committed by GitHub
parent 1b58560127
commit 73a01f89b5
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
8 changed files with 27 additions and 275 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
.gitmodules vendored
View file

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

1
babashka.nrepl Submodule

@ -0,0 +1 @@
Subproject commit 516a5828dff4fa10c89ab7b3dedaf10fb2978736

1
deps.edn
View file

@ -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"},

3
project.clj
View file

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

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

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

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

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

11
src/babashka/main.clj
View file

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

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

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