Merge pull request #257 from clojure-emacs/out

New middleware: out.clj

README.md

@@ -44,6 +44,7 @@ middleware to `:nrepl-middleware` under `:repl-options`.
                   cider.nrepl.middleware.stacktrace/wrap-stacktrace
                   cider.nrepl.middleware.test/wrap-test
                   cider.nrepl.middleware.trace/wrap-trace
+                  cider.nrepl.middleware.out/wrap-out
                   cider.nrepl.middleware.undef/wrap-undef]}
 
 ```
@@ -111,6 +112,7 @@ Middleware        | Op(s)      | Description
 `wrap-stacktrace` | `stacktrace` | Cause and stacktrace analysis for exceptions.
 `wrap-test`       | `test/retest/test-stacktrace` | Test execution, reporting, and inspection.
 `wrap-trace`      | `toggle-trace-var`/`toggle-trace-ns` | Toggle tracing of a given var or ns.
+`wrap-out`        | | Echo the server's output stream to client sessions.
 `wrap-undef`      | `undef`    | Undefine a var.
 
 ## Release policy

project.clj

@@ -29,6 +29,7 @@
                                                      cider.nrepl.middleware.inspect/wrap-inspect
                                                      cider.nrepl.middleware.macroexpand/wrap-macroexpand
                                                      cider.nrepl.middleware.ns/wrap-ns
+                                                     cider.nrepl.middleware.out/wrap-out
                                                      cider.nrepl.middleware.pprint/wrap-pprint
                                                      cider.nrepl.middleware.refresh/wrap-refresh
                                                      cider.nrepl.middleware.resource/wrap-resource

src/cider/nrepl.clj

@@ -9,6 +9,7 @@
             [cider.nrepl.middleware.inspect]
             [cider.nrepl.middleware.macroexpand]
             [cider.nrepl.middleware.ns]
+            [cider.nrepl.middleware.out]
             [cider.nrepl.middleware.pprint]
             [cider.nrepl.middleware.refresh]
             [cider.nrepl.middleware.resource]
@@ -29,6 +30,7 @@
     cider.nrepl.middleware.inspect/wrap-inspect
     cider.nrepl.middleware.macroexpand/wrap-macroexpand
     cider.nrepl.middleware.ns/wrap-ns
+    cider.nrepl.middleware.out/wrap-out
     cider.nrepl.middleware.pprint/wrap-pprint
     cider.nrepl.middleware.refresh/wrap-refresh
     cider.nrepl.middleware.resource/wrap-resource

src/cider/nrepl/middleware/out.clj

@@ -0,0 +1,95 @@
+(ns cider.nrepl.middleware.out
+  "Change *out* to print on sessions in addition to process out.
+
+  Automatically changes the root binding of *out* to print to any
+  active sessions. An active session is one that has sent at least one
+  \"eval\" op.
+
+  We use an eval message, instead of the clone op, because there's no
+  guarantee that the channel that sent the clone message will properly
+  handle output replies."
+  (:require [cider.nrepl.middleware.util.cljs :as cljs]
+            [clojure.tools.nrepl.middleware :refer [set-descriptor!]]
+            [clojure.tools.nrepl.middleware.interruptible-eval :as ie]
+            [clojure.tools.nrepl.middleware.session :as session])
+  (:import [java.io PrintWriter Writer]))
+
+;;; OutStream
+(defonce original-out *out*)
+
+(declare tracked-sessions-map)
+
+(defmacro with-out-binding
+  "Run body with v bound to the output stream of each msg in msg-seq.
+  Also run body with v bound to `original-out`."
+  [[v msg-seq] & body]
+  `(do (let [~(with-meta v {:tag Writer}) original-out]
+         ~@body)
+       (doseq [{:keys [~'session] :as ~'msg} ~msg-seq]
+         (let [~(with-meta v {:tag Writer}) (get @~'session #'*out*)]
+           (try (binding [ie/*msg* ~'msg]
+                  ~@body)
+                ;; If a channel is faulty, dissoc it.
+                (catch Exception ~'e
+                  (swap! tracked-sessions-map dissoc
+                         (:id (meta ~'session)))))))))
+
+(defn fork-out
+  "Returns a PrintWriter suitable for binding as *out* or *err*. All
+  operations are forwarded to all output bindings in the sessions of
+  messages in addition to the server's usual PrintWriter (saved in
+  `original-out`)."
+  [messages]
+  (PrintWriter. (proxy [Writer] []
+                  (close [] (.flush ^Writer this))
+                  (write
+                    ([x]
+                     (with-out-binding [out messages]
+                       (.write out x)))
+                    ([x ^Integer off ^Integer len]
+                     (with-out-binding [out messages]
+                       (.write out x off len))))
+                  (flush []
+                    (with-out-binding [out messages]
+                      (.flush out))))
+                true))
+
+;;; Known eval sessions
+(def tracked-sessions-map
+  "Map from session ids to eval `*msg*`s.
+  Only the most recent message from each session is stored."
+  (atom {}))
+
+(defn tracked-sessions-map-watch [_ _ _ new-state]
+  (let [o (fork-out (vals new-state))]
+    ;; FIXME: This won't apply to Java loggers unless we also
+    ;; `setOut`, but for that we need to convert a `PrintWriter` to a
+    ;; `PrintStream` (or maybe just not use a `PrintWriter` above).
+    ;; (System/setOut (PrintStream. o))
+    (alter-var-root #'*out* (constantly o))))
+
+(add-watch tracked-sessions-map :update-out tracked-sessions-map-watch)
+
+(defn maybe-register-session
+  "Add msg to `tracked-sessions-map` if it is an eval op."
+  [{:keys [op session] :as msg}]
+  (try
+    (when (= op "eval")
+      (when-let [session (:id (meta session))]
+        (swap! tracked-sessions-map assoc session
+               (select-keys msg [:transport :session :id]))))
+    (catch Exception e nil)))
+
+(defn wrap-out [handler]
+  (fn [msg]
+    (maybe-register-session msg)
+    (handler msg)))
+
+(set-descriptor!
+ #'wrap-out
+ (cljs/expects-piggieback
+  {:requires #{#'session/session}
+   :expects #{"eval"}
+   :handles
+   {"out-middleware"
+    {:doc "Change #'*out* so that it also prints to active sessions, even outside an eval scope."}}}))

test/clj/cider/nrepl/middleware/out_test.clj

@@ -0,0 +1,31 @@
+(ns cider.nrepl.middleware.out-test
+  (:require [cider.nrepl.middleware.out :as o]
+            [clojure.test :refer :all]))
+
+(defn random-str []
+  (->> #(format "%x" (rand-int 15))
+       (repeatedly 10)
+       (apply str)))
+
+(def the-meta {:id (random-str)})
+
+(defn test []
+  {:id (random-str)})
+
+(def msg {:op "eval" :id (random-str)
+          :transport 90
+          :some-other-key 10
+          :session (atom {} :meta the-meta)})
+
+(remove-watch o/tracked-sessions-map :update-out)
+
+(deftest maybe-register-session
+  (with-redefs [o/tracked-sessions-map (atom {})]
+    (o/maybe-register-session (assoc msg :op "clone"))
+    (is (= @o/tracked-sessions-map {}))
+    (o/maybe-register-session msg)
+    (let [{:keys [transport session id some-other-key]} (@o/tracked-sessions-map (:id the-meta))]
+      (is (= transport (:transport msg)))
+      (is (= session (:session msg)))
+      (is (= id (:id msg)))
+      (is (not some-other-key)))))