Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 148 lines (135 sloc) 6.663 kb
4e3317c Chas Emerick 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 Chas Emerick 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 Chas Emerick 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 Chas Emerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored
41 #(or (.poll q 0 TimeUnit/MILLISECONDS) %2)))
4e3317c Chas Emerick 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 Chas Emerick 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 Chas Emerick split handlers namespace into separate topical middleware namespaces
cemerick authored
96
afcba72 Chas Emerick 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 Chas Emerick 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 Chas Emerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored
109 (fn [{:keys [op session interrupt-id id transport] :as msg}]
4e3317c Chas Emerick 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 Chas Emerick 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 Chas Emerick #'*agent* no longer implicated in REPL goings-on
cemerick authored
122 (returning (dissoc (evaluate @session msg) #'*msg*)
afcba72 Chas Emerick 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 Chas Emerick 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 Chas Emerick 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 Chas Emerick 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 Chas Emerick eliminate :interrupted status race condition
cemerick authored
143 (.stop thread)
4e3317c Chas Emerick 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.