Permalink
Browse files

support for automatic organization of nREPL middlewares given specifi…

…cations of their dependencies, etc.; hopefully fixes NREPL-26
  • Loading branch information...
1 parent 22f6afa commit 93a36fd4a6e45a554e451fb860b29a6e0b5b1b6c @cemerick cemerick committed Aug 20, 2012
View
86 src/main/clojure/clojure/tools/nrepl/middleware.clj
@@ -1,7 +1,9 @@
(ns clojure.tools.nrepl.middleware
(:require clojure.tools.nrepl
[clojure.tools.nrepl.transport :as transport]
- [clojure.tools.nrepl.misc :as misc]))
+ [clojure.tools.nrepl.misc :as misc]
+ [clojure.set :as set])
+ (:refer-clojure :exclude (comparator)))
(defn- var-name
[^clojure.lang.Var v]
@@ -19,9 +21,12 @@
the provided [middleware-var], after assoc'ing in the var's
fully-qualified name as the descriptor's \"implemented-by\" value."
[middleware-var descriptor]
- (let [descriptor (assoc descriptor "implemented-by" (var-name middleware-var))]
+ (let [descriptor (-> descriptor
+ (assoc :implemented-by (-> middleware-var var-name symbol))
+ (update-in [:expects] (fnil conj #{}) "describe"))]
(alter-meta! middleware-var assoc ::descriptor descriptor)
- (alter-var-root middleware-var #(comp (partial wrap-conj-descriptor (:handles descriptor)) %))))
+ (alter-var-root middleware-var #(comp (partial wrap-conj-descriptor
+ (:handles descriptor)) %))))
(defn- safe-version
[m]
@@ -46,4 +51,77 @@
:requires {}
:optional {"verbose?" "Include informational detail for each \"op\"eration in the return message."}
:returns {"ops" "Map of \"op\"erations supported by this nREPL endpoint"
- "versions" "Map containing version maps (like *clojure-version*, e.g. major, minor, incremental, and qualifier keys) for values, component names as keys. Common keys include \"nrepl\" and \"clojure\"."}}}})
+ "versions" "Map containing version maps (like *clojure-version*, e.g. major, minor, incremental, and qualifier keys) for values, component names as keys. Common keys include \"nrepl\" and \"clojure\"."}}}})
+; eliminate implicit expectation of "describe" handler; this is the only
+; special case introduced by the conj'ing of :expects "describe" by set-descriptor!
+(alter-meta! #'wrap-describe update-in [::descriptor :expects] disj "describe")
+
+(defn- dependencies
+ [set start dir]
+ (let [ops (start dir)
+ deps (set/select
+ (comp seq (partial set/intersection ops) :handles)
+ set)]
+ (when (deps start)
+ (throw (IllegalArgumentException.
+ (format "Middleware %s depends upon itself via %s"
+ (:implemented-by start)
+ dir))))
+ (concat ops
+ (mapcat #(dependencies set % dir) deps))))
+
+(defn- comparator
+ [{a-requires :requires a-expects :expects a-handles :handles}
+ {b-requires :requires b-expects :expects b-handles :handles}]
+ (or (->> (into {} [[[a-requires b-handles] -1]
+ [[a-expects b-handles] 1]
+ [[b-requires a-handles] 1]
+ [[b-expects a-handles] -1]])
+ (map (fn [[sets ret]]
+ (and (seq (apply set/intersection sets)) ret)))
+ (some #{-1 1}))
+ 0))
+
+(defn- extend-deps
+ [middlewares]
+ (let [descriptor #(-> % meta ::descriptor)
+ middlewares (concat middlewares
+ (->> (map descriptor middlewares)
+ (mapcat (juxt :expects :requires))
+ (mapcat identity)
+ (filter var?)))]
+ (doseq [m (remove descriptor middlewares)]
+ (binding [*out* *err*]
+ (printf "[WARNING] No nREPL middleware descriptor in metadata of %s, see clojure.tools.middleware/set-descriptor!" m)))
+ (let [middlewares (set (for [m middlewares]
+ (-> (descriptor m)
+ ; only conj'ing m here to support direct reference to
+ ; middleware dependencies in :expects and :requires,
+ ; e.g. interruptable-eval's dep on
+ ; clojure.tools.nrepl.middleware.pr-values/pr-values
+ (update-in [:handles] (comp set #(conj % m) keys))
+ (assoc :implemented-by m))))]
+ (set (for [m middlewares]
+ (reduce
+ #(update-in % [%2] into (dependencies middlewares % %2))
+ m #{:expects :requires}))))))
+
+(defn- conj-sorted
+ [stack comparator x]
+ (let [comparisons (->> stack
+ (map-indexed #(vector % (comparator x %2)))
+ (remove (comp zero? second)))
+ lower (ffirst (filter (comp neg? second) comparisons))
+ upper (ffirst (reverse (filter (comp pos? second) comparisons)))
+ [before after] (split-at (or lower (and upper (inc upper)) (count stack)) stack)]
+ (into [] (concat before [x] after))))
+
+;; TODO throw exception when the stack doesn't satisfy the requirements of the descriptors involved
+(defn linearize-middleware-stack
+ [middlewares]
+ (->> middlewares
+ extend-deps
+ (sort-by (comp count (partial apply concat) (juxt :expects :requires)))
+ (reduce #(conj-sorted % comparator %2) [])
+ (map :implemented-by)))
+
View
5 src/main/clojure/clojure/tools/nrepl/middleware/interruptible_eval.clj
@@ -1,6 +1,7 @@
(ns ^{:author "Chas Emerick"}
clojure.tools.nrepl.middleware.interruptible-eval
(:require [clojure.tools.nrepl.transport :as t]
+ clojure.tools.nrepl.middleware.pr-values
clojure.main)
(:use [clojure.tools.nrepl.misc :only (response-for returning)]
[clojure.tools.nrepl.middleware :only (set-descriptor!)])
@@ -190,7 +191,9 @@
(h msg))))
(set-descriptor! #'interruptible-eval
- {:handles {"eval"
+ {:requires #{"clone" "close" #'clojure.tools.nrepl.middleware.pr-values/pr-values}
+ :expects #{}
+ :handles {"eval"
{:doc "Evaluates code."
:requires {"code" "The code to be evaluated."
"session" "The ID of the session within which to evaluate the code."}
View
4 src/main/clojure/clojure/tools/nrepl/middleware/load_file.clj
@@ -29,7 +29,9 @@
:code (load-file-code file file-path file-name))))))
(set-descriptor! #'wrap-load-file
- {:handles {"load-file"
+ {:requires #{}
+ :expects #{"eval"}
+ :handles {"load-file"
{:doc "Loads a body of code, using supplied path and filename info to set source file and line number metadata. Delegates to underlying \"eval\" middleware/handler."
:requires {"file" "Full contents of a file of code."}
:optional {"file-path" "Source-path-relative path of the source file, e.g. clojure/java/io.clj"
View
8 src/main/clojure/clojure/tools/nrepl/middleware/pr_values.clj
@@ -2,6 +2,7 @@
(ns ^{:author "Chas Emerick"}
clojure.tools.nrepl.middleware.pr-values
(:require [clojure.tools.nrepl.transport :as t])
+ (:use [clojure.tools.nrepl.middleware :only (set-descriptor!)])
(:import clojure.tools.nrepl.transport.Transport))
(defn pr-values
@@ -20,4 +21,9 @@
(.send transport
(if-let [[_ v] (find resp :value)]
(assoc resp :value (with-out-str (pr v)))
- resp))))))))
+ resp))))))))
+
+(set-descriptor! #'pr-values
+ {:requires #{}
+ :expects #{}
+ :handles {}})
View
8 src/main/clojure/clojure/tools/nrepl/middleware/session.clj
@@ -165,7 +165,9 @@
(h msg)))))))
(set-descriptor! #'session
- {:handles {"close"
+ {:requires #{}
+ :expects #{}
+ :handles {"close"
{:doc "Closes the specified session."
:requires {"session" "The ID of the session to be closed."}
:optional {}
@@ -203,7 +205,9 @@
(h msg))))
(set-descriptor! #'add-stdin
- {:handles {"stdin"
+ {:requires #{"session"}
+ :expects #{"eval"}
+ :handles {"stdin"
{:doc "Add content from the value of \"stdin\" to *in* in the current session."
:requires {"stdin" "Content to add to *in*."}
:optional {}
View
31 src/main/clojure/clojure/tools/nrepl/server.clj
@@ -3,7 +3,8 @@
clojure.tools.nrepl.server
(:require [clojure.tools.nrepl :as repl]
(clojure.tools.nrepl [ack :as ack]
- [transport :as t])
+ [transport :as t]
+ [middleware :as middleware])
(clojure.tools.nrepl.middleware interruptible-eval
pr-values
session
@@ -46,18 +47,24 @@
[{:keys [op transport] :as msg}]
(t/send transport (response-for msg :status #{:error :unknown-op :done} :op op)))
+(def default-middlewares
+ [#'clojure.tools.nrepl.middleware/wrap-describe
+ #'clojure.tools.nrepl.middleware.interruptible-eval/interruptible-eval
+ #'clojure.tools.nrepl.middleware.load-file/wrap-load-file
+ #'clojure.tools.nrepl.middleware.session/add-stdin
+ #'clojure.tools.nrepl.middleware.session/session])
+
(defn default-handler
"A default handler supporting interruptible evaluation, stdin, sessions, and
- readable representations of evaluated expressions via `pr`."
- []
- (-> unknown-op
- clojure.tools.nrepl.middleware/wrap-describe
- clojure.tools.nrepl.middleware.interruptible-eval/interruptible-eval
- clojure.tools.nrepl.middleware.load-file/wrap-load-file
- clojure.tools.nrepl.middleware.pr-values/pr-values
- clojure.tools.nrepl.middleware.session/add-stdin
- ; output-subscriptions TODO
- clojure.tools.nrepl.middleware.session/session))
+ readable representations of evaluated expressions via `pr`.
+
+ Additional middlewares to mix into the default stack may be provided; these
+ should all be values (usually vars) that have an nREPL middleware descriptor
+ in their metadata (see clojure.tools.nrepl.middleware/set-descriptor!)."
+ [& additional-middlewares]
+ (let [stack (middleware/linearize-middleware-stack (concat default-middlewares
+ additional-middlewares))]
+ ((apply comp (reverse stack)) unknown-op)))
;; TODO
#_(defn- output-subscriptions
@@ -74,7 +81,7 @@
* :port — defaults to 0, which autoselects an open port on localhost
* :bind — bind address, by default any (0.0.0.0)
* :handler — the nREPL message handler to use for each incoming connection;
- defaults to the result of (default-handler)
+ defaults to the result of `(default-handler)`
* :transport-fn — a function that, given a java.net.Socket corresponding
to an incoming connection, will return an value satisfying the
clojure.tools.nrepl.Transport protocol for that Socket.
View
68 src/test/clojure/clojure/tools/nrepl/middleware_test.clj
@@ -0,0 +1,68 @@
+(ns clojure.tools.nrepl.middleware-test
+ (:require (clojure.tools.nrepl.middleware
+ interruptible-eval
+ load-file
+ pr-values
+ session))
+ (:use [clojure.tools.nrepl.middleware :as middleware]
+ clojure.test))
+
+; wanted to just use resolve to avoid the long var names, but
+; it seems that unqualified resolves *don't work* within the context of a
+; clojure-maven-plugin test execution?!?
+(def ^{:private true} default-middlewares
+ [#'clojure.tools.nrepl.middleware.session/add-stdin
+ #'clojure.tools.nrepl.middleware.load-file/wrap-load-file
+ #'clojure.tools.nrepl.middleware/wrap-describe
+ #'clojure.tools.nrepl.middleware.session/session
+ #'clojure.tools.nrepl.middleware.interruptible-eval/interruptible-eval])
+
+(defn- wonky-resolve [s] (if (symbol? s) (resolve s) s))
+
+(defn- indexed-stack
+ [x]
+ (->> x
+ (map wonky-resolve)
+ shuffle
+ linearize-middleware-stack
+ (map-indexed #(vector (if (var? %2)
+ (-> (#'middleware/var-name %2) symbol name symbol)
+ %2)
+ %))
+ (into {})))
+
+(deftest sanity
+ (let [stack (indexed-stack default-middlewares)]
+ (is (stack 'pr-values))
+ (are [before after] (< (stack before) (stack after))
+ 'interruptible-eval 'wrap-load-file
+ 'interruptible-eval 'session
+ 'wrap-describe 'pr-values
+ 'interruptible-eval 'pr-values))
+
+ (let [n ^{::middleware/descriptor
+ {:expects #{"clone"} :requires #{}}} {:dummy :middleware2}
+ m ^{::middleware/descriptor
+ {:expects #{"eval"} :requires #{n #'clojure.tools.nrepl.middleware.pr-values/pr-values}}}
+ {:dummy :middleware}
+ q ^{::middleware/descriptor
+ {:expects #{} :requires #{"describe"}}} {:dummy :middleware3}
+ stack (indexed-stack (concat default-middlewares [m q n]))]
+ (are [before after] (< (stack before) (stack after))
+ 'interruptible-eval m
+ m 'pr-values
+ 'session n
+ q 'wrap-describe
+ m n
+
+ 'interruptible-eval 'wrap-load-file
+ 'interruptible-eval 'session
+ 'wrap-describe 'pr-values
+ 'interruptible-eval 'pr-values)))
+
+(deftest no-descriptor-warning
+ (is (.contains
+ (with-out-str
+ (binding [*err* *out*]
+ (indexed-stack (conj default-middlewares {:dummy :middleware}))))
+ "No nREPL middleware descriptor in metadata of {:dummy :middleware}")))

0 comments on commit 93a36fd

Please sign in to comment.