/
interruptible_eval.clj
163 lines (153 loc) · 8.65 KB
/
interruptible_eval.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
(ns nrepl.middleware.interruptible-eval
{:author "Chas Emerick"}
(:require
clojure.main
clojure.test
[nrepl.middleware :refer [set-descriptor!]]
[nrepl.middleware.caught :as caught]
[nrepl.middleware.print :as print]
[nrepl.misc :refer [response-for]]
[nrepl.transport :as t])
(:import
(clojure.lang Compiler$CompilerException LineNumberingPushbackReader)
(java.io FilterReader LineNumberReader StringReader Writer)
(java.lang.reflect Field)))
(def ^:dynamic *msg*
"The message currently being evaluated."
nil)
(defn- capture-thread-bindings
"Capture thread bindings, excluding nrepl implementation vars."
[]
(dissoc (get-thread-bindings) #'*msg*))
(defn- set-line!
[^LineNumberingPushbackReader reader line]
(-> reader (.setLineNumber line)))
(defn- set-column!
[^LineNumberingPushbackReader reader column]
(when-let [field (->> LineNumberingPushbackReader
(.getDeclaredFields)
(filter #(= "_columnNumber" (.getName ^Field %)))
first)]
(-> ^Field field
(doto (.setAccessible true))
(.set reader column))))
(defn- source-logging-pushback-reader
[code line column]
(let [reader (LineNumberingPushbackReader. (StringReader. code))]
(when line (set-line! reader (int line)))
(when column (set-column! reader (int column)))
reader))
;; TODO: use `nrepl.middleware.session/interrupted?` – currently introduces a
;; circular dependency
(defn- interrupted?
"Returns true if the given throwable was ultimately caused by an interrupt."
[^Throwable e]
(or (instance? ThreadDeath (clojure.main/root-cause e))
(and (instance? Compiler$CompilerException e)
(instance? ThreadDeath (.getCause e)))))
(defn evaluate
"Evaluates a msg's code within the dynamic context of its session.
Uses `clojure.main/repl` to drive the evaluation of :code (either a string
or a seq of forms to be evaluated), which may also optionally specify a :ns
(resolved via `find-ns`). The map MUST contain a Transport implementation
in :transport; expression results and errors will be sent via that Transport."
[{:keys [transport session eval ns code file line column out-limit]
:as msg}]
(let [explicit-ns (and ns (-> ns symbol find-ns))
original-ns (@session #'*ns*)
maybe-restore-original-ns (if explicit-ns
#(assoc % #'*ns* original-ns)
identity)]
(if (and ns (not explicit-ns))
(t/send transport (response-for msg {:status #{:error :namespace-not-found :done}
:ns ns}))
(let [ctxcl (.getContextClassLoader (Thread/currentThread))
;; TODO: out-limit -> out-buffer-size | err-buffer-size
;; TODO: new options: out-quota | err-quota
opts {::print/buffer-size (or out-limit (get (meta session) :out-limit))}
out (print/replying-PrintWriter :out msg opts)
err (print/replying-PrintWriter :err msg opts)]
(try
(clojure.main/repl
:eval (if eval (find-var (symbol eval)) clojure.core/eval)
:init #(let [bindings
(-> (get-thread-bindings)
(into caught/default-bindings)
(into print/default-bindings)
(into @session)
(into {#'*out* out
#'*err* err
;; clojure.test captures *out* at load-time, so we need to make sure
;; runtime output of test status/results is redirected properly
;; TODO: is this something we need to consider in general, or is this
;; specific hack reasonable?
#'clojure.test/*test-out* out})
(cond-> explicit-ns (assoc #'*ns* explicit-ns)
file (assoc #'*file* file)))]
(pop-thread-bindings)
(push-thread-bindings bindings))
:read (if (string? code)
(let [reader (source-logging-pushback-reader code line column)]
#(try (read {:read-cond :allow :eof %2} reader)
(catch RuntimeException e
;; If error happens during reading the string, we
;; don't want eval to start reading and executing the
;; rest of it. So we skip over the remaining text.
(.skip ^LineNumberingPushbackReader reader Long/MAX_VALUE)
(throw e))))
(let [code (.iterator ^Iterable code)]
#(or (and (.hasNext code) (.next code)) %2)))
:prompt #(reset! session (maybe-restore-original-ns (capture-thread-bindings)))
:need-prompt (constantly true)
:print (fn [value]
;; *out* has :tag metadata; *err* does not
(.flush ^Writer *err*)
(.flush *out*)
(t/send transport (response-for msg {:ns (str (ns-name *ns*))
:value value
::print/keys #{:value}})))
:caught (fn [^Throwable e]
(when-not (interrupted? e)
(let [resp {::caught/throwable e
:status :eval-error
:ex (str (class e))
:root-ex (str (class (clojure.main/root-cause e)))}]
(t/send transport (response-for msg resp))))))
(finally
(.setContextClassLoader (Thread/currentThread) ctxcl)
(.flush err)
(.flush out)))))))
(defn interruptible-eval
"Evaluation middleware that supports interrupts. Returns a handler that supports
\"eval\" and \"interrupt\" :op-erations that delegates to the given handler
otherwise."
[h & configuration]
(fn [{:keys [op session interrupt-id id transport] :as msg}]
(let [{:keys [interrupt exec] session-id :id} (meta session)]
(case op
"eval"
(if-not (:code msg)
(t/send transport (response-for msg :status #{:error :no-code :done}))
(exec id
#(binding [*msg* msg]
(evaluate msg))
#(t/send transport (response-for msg :status :done))))
(h msg)))))
(set-descriptor! #'interruptible-eval
{:requires #{"clone" "close" #'caught/wrap-caught #'print/wrap-print}
:expects #{}
:handles {"eval"
{:doc "Evaluates code. Note that unlike regular stream-based Clojure REPLs, nREPL's `\"eval\"` short-circuits on first read error and will not try to read and execute the remaining code in the message."
:requires {"code" "The code to be evaluated."
"session" "The ID of the session within which to evaluate the code."}
:optional (merge caught/wrap-caught-optional-arguments
print/wrap-print-optional-arguments
{"id" "An opaque message ID that will be included in responses related to the evaluation, and which may be used to restrict the scope of a later \"interrupt\" operation."
"eval" "A fully-qualified symbol naming a var whose function value will be used to evaluate [code], instead of `clojure.core/eval` (the default)."
"file" "The path to the file containing [code]. `clojure.core/*file*` will be bound to this."
"line" "The line number in [file] at which [code] starts."
"column" "The column number in [file] at which [code] starts."})
:returns {"ns" "*ns*, after successful evaluation of `code`."
"values" "The result of evaluating `code`, often `read`able. This printing is provided by the `print` middleware. Superseded by `ex` and `root-ex` if an exception occurs during evaluation."
"ex" "The type of exception thrown, if any. If present, then `values` will be absent."
"root-ex" "The type of the root exception thrown, if any. If present, then `values` will be absent."}}}})