Support clj-reload workflow

Fix clojure-emacs#849

doc/modules/ROOT/pages/nrepl-api/ops.adoc

@@ -1092,6 +1092,53 @@ Returns::
 {blank}
 
 
+
+=== `reload`
+
+Reloads all changed files in dependency order, using clj-reload.
+
+Required parameters::
+{blank}
+
+Optional parameters::
+* `:nrepl.middleware.print/buffer-size` The size of the buffer to use when streaming results. Defaults to 1024.
+* `:nrepl.middleware.print/keys` A seq of the keys in the response whose values should be printed.
+* `:nrepl.middleware.print/options` A map of options to pass to the printing function. Defaults to ``nil``.
+* `:nrepl.middleware.print/print` A fully-qualified symbol naming a var whose function to use for printing. Must point to a function with signature [value writer options].
+* `:nrepl.middleware.print/quota` A hard limit on the number of bytes printed for each value.
+* `:nrepl.middleware.print/stream?` If logical true, the result of printing each value will be streamed to the client over one or more messages.
+
+
+Returns::
+* `:error` A sequence of all causes of the thrown exception when ``status`` is ``:error``.
+* `:progress` Description of current namespace being unloaded/loaded.
+* `:status` ``:ok`` if reloading was successful; otherwise ``:error``.
+
+
+
+=== `reload-all`
+
+Reloads all files in dependency order, using clj-reload.
+
+Required parameters::
+{blank}
+
+Optional parameters::
+* `:nrepl.middleware.print/buffer-size` The size of the buffer to use when streaming results. Defaults to 1024.
+* `:nrepl.middleware.print/keys` A seq of the keys in the response whose values should be printed.
+* `:nrepl.middleware.print/options` A map of options to pass to the printing function. Defaults to ``nil``.
+* `:nrepl.middleware.print/print` A fully-qualified symbol naming a var whose function to use for printing. Must point to a function with signature [value writer options].
+* `:nrepl.middleware.print/quota` A hard limit on the number of bytes printed for each value.
+* `:nrepl.middleware.print/stream?` If logical true, the result of printing each value will be streamed to the client over one or more messages.
+
+
+Returns::
+* `:error` A sequence of all causes of the thrown exception when ``status`` is ``:error``.
+* `:progress` Description of current namespace being unloaded/loaded.
+* `:status` ``:ok`` if reloading was successful; otherwise ``:error``.
+
+
+
 === `resource`
 
 Obtain the path to a resource.

project.clj

@@ -119,7 +119,8 @@
                                                                          commons-codec
                                                                          com.google.code.findbugs/jsr305]]
                                    [cider/piggieback "0.5.3"]
-                                   [nubank/matcher-combinators "3.8.8"]]}
+                                   [nubank/matcher-combinators "3.8.8"]
+                                   [io.github.tonsky/clj-reload "0.2.0"]]}
 
              ;; Running the tests with enrich-classpath doing its thing isn't compatible with `lein test`
              ;; (because there's no such thing as "run `lein test` using this specific classpath"),

src/cider/nrepl.clj

@@ -632,6 +632,20 @@ if applicable, and re-render the updated value."
              "refresh-clear"
              {:doc "Clears the state of the refresh middleware. This can help recover from a failed load or a circular dependency error."}}})
 
+(def-wrapper wrap-refresh cider.nrepl.middleware.reload/handle-reload
+  {:doc "Reload middleware."
+   :requires #{"clone" #'wrap-print}
+   :handles {"reload"
+             {:doc "Reloads all changed files in dependency order."
+              :returns {"progress" "Description of current namespace being unloaded/loaded."
+                        "status" "`:ok` if reloading was successful; otherwise `:error`."
+                        "error" "A sequence of all causes of the thrown exception when `status` is `:error`."}}
+             "reload-all"
+             {:doc "Reloads all files in dependency order."
+              :returns {"reloading" "Description of current namespace being unloaded/loaded."
+                        "status" "`:ok` if reloading was successful; otherwise `:error`."
+                        "error" "A sequence of all causes of the thrown exception when `status` is `:error`."}}}})
+
 (def-wrapper wrap-resource cider.nrepl.middleware.resource/handle-resource
   {:doc "Middleware that provides the path to resource."
    :handles {"resource"

src/cider/nrepl/middleware/reload.clj

@@ -0,0 +1,49 @@
+(ns cider.nrepl.middleware.reload
+  (:require
+   [clojure.main :refer [repl-caught]]
+   [clojure.string :as str]
+   [haystack.analyzer :as stacktrace.analyzer]
+   [nrepl.middleware.interruptible-eval :refer [*msg*]]
+   [nrepl.middleware.print :as print]
+   [nrepl.misc :refer [response-for]]
+   [nrepl.transport :as transport]
+   [orchard.misc :as misc]))
+
+(defn- user-reload
+  "clj-reload.core/reload from the user project.
+  Must be configured via clj-reload.core/init before being called."
+  []
+  (some-> (symbol "clj-reload.core" "reload")
+          resolve))
+
+(defn respond
+  [{:keys [transport] :as msg} response]
+  (transport/send transport (response-for msg response)))
+
+(defn- refresh-reply
+  [{:keys [::print/print-fn transport session id] :as msg}]
+  (let [{:keys [exec]} (meta session)]
+    (exec id
+          #(try
+             (let [reload (user-reload)]
+               (when-not reload
+                 (throw (ex-info "clj-reload.core/reload not found" {})))
+               (reload (cond-> {:log-fn (fn [& args]
+                                          (respond msg {:progress (str/join " " args)}))}
+                               (:all msg) (assoc :only :all)))
+               (respond msg {:status :ok}))
+             (catch Throwable error
+               (respond msg {:status :error
+                             :error  (stacktrace.analyzer/analyze error print-fn)})
+               (binding [*msg* msg
+                         *err* (print/replying-PrintWriter :err msg {})]
+                 (repl-caught error))))
+
+          #(respond msg {:status :done}))))
+
+(defn handle-reload [handler msg]
+  (case (:op msg)
+    "reload" (refresh-reply msg)
+    "reload-all" (refresh-reply (assoc msg :all true))
+    (handler msg)))
+

test/clj/cider/nrepl/middleware/reload_test.clj

@@ -0,0 +1,43 @@
+(ns cider.nrepl.middleware.reload-test
+  (:require
+   [cider.nrepl.middleware.reload :as rl]
+   [cider.nrepl.test-session :as session]
+   [clj-reload.core :as reload]
+   [clojure.test :refer :all]))
+
+(use-fixtures :each session/session-fixture)
+
+(def ^:private dirs-to-reload
+  ;; Limit the scope of what we reload, because (for example) reloading the
+  ;; cider.nrepl.middleware.test-session ns causes *session* in that ns to be
+  ;; unloaded, which breaks session-fixture, and hence all of the below tests.
+  ["test/clj/cider/nrepl/middleware/util"])
+
+(reload/init {:dirs dirs-to-reload})
+
+(deftest user-reload
+  (testing "returns nil if clojure.tools.namespace isn't loaded"
+    (with-redefs [resolve (constantly nil)]
+      (is (nil? (#'rl/user-reload))))))
+
+(deftest reload-op-no-user-reload-test
+  (testing "reload op fails if clj-reload.core/reload is not found"
+    (with-redefs [resolve (constantly nil)]
+      (let [response (session/message {:op "reload"})]
+        (is (= "clj-reload.core/reload not found" (-> response :error first :message)))
+        (is (= #{"done" "error"} (:status response)))))))
+
+(deftest reload-op-test
+  (testing "reload op works"
+    (let [response (session/message {:op "reload"})]
+      ;; There is nothing to reload since the files did not change,
+      ;; but the message does come from clj-reload.core/reload.
+      (is (= "Nothing to reload" (:progress response)))
+      (is (= #{"done" "ok"} (:status response))))))
+
+(deftest reload-all-op-test
+  (testing "reload-all op works"
+    (let [response (session/message {:op "reload-all"})]
+      (is (seq (:progress response)))
+      (is (= #{"done" "ok"} (:status response))))))
+