Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 148 lines (135 sloc) 6.663 kB
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored
1 (ns ^{:author "Chas Emerick"}
2 clojure.tools.nrepl.middleware.interruptible-eval
3 (:require [clojure.tools.nrepl.transport :as t]
4 clojure.main)
5 (:use [clojure.tools.nrepl.misc :only (response-for returning)])
6 (:import clojure.lang.LineNumberingPushbackReader
7 (java.io StringReader Writer)
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored
8 java.util.concurrent.atomic.AtomicLong
9 (java.util.concurrent ArrayBlockingQueue LinkedBlockingQueue
10 TimeUnit ThreadPoolExecutor
11 ThreadFactory)))
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored
12
13 (def ^{:dynamic true
14 :doc "The message currently being evaluated."}
15 *msg* nil)
16
17 (defn evaluate
18 "Evaluates some code within the dynamic context defined by a map of `bindings`,
19 as per `clojure.core/get-thread-bindings`.
20
21 Uses `clojure.main/repl` to drive the evaluation of :code in a second
22 map argument (either a string or a seq of forms to be evaluated), which may
23 also optionally specify a :ns (resolved via `find-ns`). The map MUST
24 contain a Transport implementation in :transport; expression results and errors
25 will be sent via that Transport.
26
27 Returns the dynamic scope that remains after evaluating all expressions
28 in :code.
29
30 It is assumed that `bindings` already contains useful/appropriate entries
31 for all vars indicated by `clojure.main/with-bindings`."
32 [bindings {:keys [code ns transport] :as msg}]
33 (let [bindings (atom (merge bindings (when ns {#'*ns* (-> ns symbol find-ns)})))]
34 (try
35 (clojure.main/repl
36 :init (fn [] (push-thread-bindings @bindings))
37 :read (if (string? code)
38 (let [reader (LineNumberingPushbackReader. (StringReader. code))]
39 #(read reader false %2))
40 (let [q (java.util.concurrent.ArrayBlockingQueue. (count code) false code)]
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored
41 #(or (.poll q 0 TimeUnit/MILLISECONDS) %2)))
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored
42 :prompt (fn [])
43 :need-prompt (constantly false)
44 ; TODO pretty-print?
45 :print (fn [v]
46 (reset! bindings (assoc (get-thread-bindings)
47 #'*3 *2
48 #'*2 *1
49 #'*1 v))
50 (t/send transport (response-for msg
51 {:value v
52 :ns (-> *ns* ns-name str)})))
53 ; TODO customizable exception prints
54 :caught (fn [e]
55 (let [root-ex (#'clojure.main/root-cause e)]
56 (when-not (instance? ThreadDeath root-ex)
57 (reset! bindings (assoc (get-thread-bindings) #'*e e))
58 (t/send transport (response-for msg {:status :eval-error
59 :ex (-> e class str)
60 :root-ex (-> root-ex class str)}))
61 (clojure.main/repl-caught e)))))
62 @bindings
63 (finally
64 (pop-thread-bindings)
65 (.flush ^Writer (@bindings #'*out*))
66 (.flush ^Writer (@bindings #'*err*))))))
67
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored
68 (defn- configure-thread-factory
69 "Returns a new ThreadFactory for the given session. This implementation
70 generates daemon threads, with names that include the session id."
71 [session]
72 (let [session-thread-counter (AtomicLong. 0)
73 session-id (-> session meta :id)]
74 (reify ThreadFactory
75 (newThread [_ runnable]
76 (doto (Thread. runnable
77 (format "nREPL-session-%s-worker-%s"
78 session-id (.getAndIncrement session-thread-counter)))
79 (.setDaemon true))))))
80
81 (defn- session-executor
82 "Returns a single-threaded Executor for the given session, configured to
83 use an unbounded queue and allow unused threads to expire after 30s."
84 [session & {:keys [keep-alive queue thread-factory]
85 :or {keep-alive 30000
86 queue (LinkedBlockingQueue.)}}]
87 (ThreadPoolExecutor. 0 1 (long 30000) TimeUnit/MILLISECONDS queue
88 (or thread-factory (configure-thread-factory session))))
89
90 (defn- prep-session
91 [session]
92 (locking session
93 (returning session
94 (when-not (-> session meta :executor)
95 (alter-meta! session assoc :executor (session-executor session))))))
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored
96
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored
97 (defn- queue-eval
98 "Evaluates the function on the given session's queue/executor.
99 The session's value will be reset to the return value of the function."
100 [session f]
101 (.submit (-> session prep-session meta :executor)
102 (comp (partial reset! session) f)))
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored
103
104 (defn interruptible-eval
105 "Evaluation middleware that supports interrupts. Returns a handler that supports
106 \"eval\" and \"interrupt\" :op-erations that delegates to the given handler
107 otherwise."
108 [h]
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored
109 (fn [{:keys [op session interrupt-id id transport] :as msg}]
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored
110 (case op
111 "eval"
112 (if-not (:code msg)
113 (t/send transport (response-for msg :status #{:error :no-code}))
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored
114 (queue-eval session
115 (comp
116 (partial reset! session)
117 (fn []
118 (alter-meta! session assoc
119 :thread (Thread/currentThread)
120 :eval-msg msg)
121 (binding [*msg* msg]
a8bc0c0 @cemerick #'*agent* no longer implicated in REPL goings-on
cemerick authored
122 (returning (dissoc (evaluate @session msg) #'*msg*)
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored
123 (t/send transport (response-for msg :status :done))
124 (alter-meta! session dissoc :thread :eval-msg)))))))
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored
125
126 "interrupt"
127 ; interrupts are inherently racy; we'll check the agent's :eval-msg's :id and
128 ; bail if it's different than the one provided, but it's possible for
129 ; that message's eval to finish and another to start before we send
130 ; the interrupt / .stop.
131 (let [{:keys [id eval-msg ^Thread thread]} (meta session)]
132 (if (or (not interrupt-id)
133 (= interrupt-id (:id eval-msg)))
134 (if-not thread
135 (t/send transport (response-for msg :status #{:done :session-idle}))
136 (do
f955b8c @cemerick eliminate :interrupted status race condition
cemerick authored
137 ; notify of the interrupted status before we .stop the thread so
138 ; it is received before the standard :done status (thereby ensuring
139 ; that is stays within the scope of a clojure.tools.nrepl/message seq
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored
140 (t/send transport {:status #{:interrupted}
141 :id (:id eval-msg)
142 :session id})
f955b8c @cemerick eliminate :interrupted status race condition
cemerick authored
143 (.stop thread)
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored
144 (t/send transport (response-for msg :status #{:done}))))
145 (t/send transport (response-for msg :status #{:error :interrupt-id-mismatch :done}))))
146
147 (h msg))))
Something went wrong with that request. Please try again.