cider.nrepl.middleware.reload: support :before / :after functions (#856)

Author: vemv

CHANGELOG.md

@@ -9,7 +9,8 @@
 
 ## Bugs fixed
 
-* [#854](https://github.com/clojure-emacs/cider-nrepl/pull/854): fix cider.clj-reload/reload-all and improve its test
+* [#854](https://github.com/clojure-emacs/cider-nrepl/pull/854): Fix `cider.nrepl.middleware.reload/reload-all`.
+* `cider.nrepl.middleware.reload`: support `:before` / `:after` functions.
 
 ## 0.46.0 (2024-0305)
 

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

@@ -1796,7 +1796,9 @@ Required parameters::
 {blank}
 
 Optional parameters::
-{blank}
+* `:after` The namespace-qualified name of a zero-arity function to call after reloading.
+* `:before` The namespace-qualified name of a zero-arity function to call before reloading.
+
 
 Returns::
 * `:error` A sequence of all causes of the thrown exception when ``status`` is ``:error``.
@@ -1813,7 +1815,9 @@ Required parameters::
 {blank}
 
 Optional parameters::
-{blank}
+* `:after` The namespace-qualified name of a zero-arity function to call after reloading.
+* `:before` The namespace-qualified name of a zero-arity function to call before reloading.
+
 
 Returns::
 * `:error` A sequence of all causes of the thrown exception when ``status`` is ``:error``.

src/cider/nrepl.clj

@@ -609,15 +609,18 @@ if applicable, and re-render the updated value."
                                     :requires {}
                                     :returns  {"status" "Done"}}}})
 
+(def code-reloading-before-after-opts
+  {"before" "The namespace-qualified name of a zero-arity function to call before reloading."
+   "after" "The namespace-qualified name of a zero-arity function to call after reloading."})
+
 (def-wrapper wrap-refresh cider.nrepl.middleware.refresh/handle-refresh
   {:doc "Refresh middleware."
    :requires #{"clone" #'wrap-print}
    :handles {"refresh"
              {:doc "Reloads all changed files in dependency order."
               :optional (merge wrap-print-optional-arguments
-                               {"dirs" "List of directories to scan. If no directories given, defaults to all directories on the classpath."
-                                "before" "The namespace-qualified name of a zero-arity function to call before reloading."
-                                "after" "The namespace-qualified name of a zero-arity function to call after reloading."})
+                               {"dirs" "List of directories to scan. If no directories given, defaults to all directories on the classpath."}
+                               code-reloading-before-after-opts)
               :returns {"reloading" "List of namespaces that will be reloaded."
                         "status" "`:ok` if reloading was successful; otherwise `:error`."
                         "error" "A sequence of all causes of the thrown exception when `status` is `:error`."
@@ -643,11 +646,13 @@ if applicable, and re-render the updated value."
 using the io.github.tonsky/clj-reload library. It is bundled with cider-nrepl.
 If that dependency is already in present your project and clj-reload.core/init has been invoked beforehand,
 those configured directories will be honored."
+              :optional code-reloading-before-after-opts
               :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`."}}
              "cider.clj-reload/reload-all"
              {:doc "Reloads all files in dependency order."
+              :optional code-reloading-before-after-opts
               :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`."}}

src/cider/nrepl/middleware/refresh.clj

@@ -5,17 +5,14 @@
   ;; when developing cider-nrepl itself, or when cider-nrepl is used as a
   ;; checkout dependency - tools.namespace doesn't reload source in JARs.
   (:require
+   [cider.nrepl.middleware.util.reload :as reload-utils]
    [clojure.main :refer [repl-caught]]
    [clojure.tools.namespace.dir :as dir]
    [clojure.tools.namespace.find :as find]
    [clojure.tools.namespace.reload :as reload]
    [clojure.tools.namespace.track :as track]
-   [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]))
+   [nrepl.transport :as transport]))
 
 (defonce ^:private refresh-tracker (volatile! (track/tracker)))
 
@@ -56,101 +53,28 @@
       (update-in [::track/load] #(remove load-disabled? %))
       (update-in [::track/unload] #(remove unload-disabled? %))))
 
-(defn- zero-arity-callable? [func]
-  (and (fn? (if (var? func) @func func))
-       (->> (:arglists (meta func))
-            (some #(or (= [] %) (= '& (first %)))))))
-
-(defn- resolve-and-invoke
-  "Takes a string and tries to coerce a function from it. If that
-  function is a function of possible zero arity (ie, truly a thunk or
-  has optional parameters and can be called with zero args, it is
-  called. Returns whether the function was resolved."
-  [sym {:keys [_session] :as msg}]
-  (let [the-var (some-> sym misc/as-sym resolve)]
-
-    (when (and (var? the-var)
-               (not (zero-arity-callable? the-var)))
-      (throw (IllegalArgumentException.
-              (format "%s is not a function of no arguments" sym))))
-
-    (binding [*msg* msg
-              *out* (print/replying-PrintWriter :out msg {})
-              *err* (print/replying-PrintWriter :err msg {})]
-      (when (var? the-var)
-        (@the-var))
-      (var? the-var))))
-
 (defn- reloading-reply
   [{reloading ::track/load}
    {:keys [transport] :as msg}]
   (transport/send
    transport
    (response-for msg {:reloading reloading})))
 
-(defn- error-reply
-  [{:keys [error error-ns]}
-   {:keys [::print/print-fn transport] :as msg}]
-
-  (transport/send
-   transport
-   (response-for msg (cond-> {:status :error}
-                       error (assoc :error (stacktrace.analyzer/analyze error print-fn))
-                       error-ns (assoc :error-ns error-ns))))
-
-  (binding [*msg* msg
-            *err* (print/replying-PrintWriter :err msg {})]
-    (repl-caught error)))
-
 (defn- result-reply
   [{error ::reload/error
     error-ns ::reload/error-ns}
    {:keys [transport] :as msg}]
 
   (if error
-    (error-reply {:error error :error-ns error-ns} msg)
+    (reload-utils/error-reply {:error error :error-ns error-ns} msg)
     (transport/send
      transport
      (response-for msg {:status :ok}))))
 
-(defn- before-reply
-  [{:keys [before transport] :as msg}]
-  (when before
-    (transport/send
-     transport
-     (response-for msg {:status :invoking-before
-                        :before before}))
-
-    (let [resolved? (resolve-and-invoke before msg)]
-      (transport/send
-       transport
-       (response-for msg
-                     {:status (if resolved?
-                                :invoked-before
-                                :invoked-not-resolved)
-                      :before before})))))
-
-(defn- after-reply
+(defn after-reply
   [{error ::reload/error}
-   {:keys [after transport] :as msg}]
-
-  (when (and (not error) after)
-    (try
-      (transport/send
-       transport
-       (response-for msg {:status :invoking-after
-                          :after after}))
-
-      (let [resolved? (resolve-and-invoke after msg)]
-        (transport/send
-         transport
-         (response-for msg {:status (if resolved?
-                                      :invoked-after
-                                      :invoked-not-resolved)
-                            :after after})))
-
-      (catch Exception e
-        (error-reply {:error e} msg)))))
+   msg]
+  (reload-utils/after-reply error msg))
 
 (defn- refresh-reply
   [{:keys [dirs transport session id] :as msg}]
@@ -161,7 +85,7 @@
               (vswap! refresh-tracker
                       (fn [tracker]
                         (try
-                          (before-reply msg)
+                          (reload-utils/before-reply msg)
 
                           (-> tracker
                               (dir/scan-dirs (or (seq dirs) (user-refresh-dirs))
@@ -173,7 +97,7 @@
                               (doto (after-reply msg)))
 
                           (catch Throwable e
-                            (error-reply {:error e} msg)
+                            (reload-utils/error-reply {:error e} msg)
                             tracker))))))
           (fn []
             (transport/send transport (response-for msg {:status :done}))))))

src/cider/nrepl/middleware/reload.clj

@@ -3,15 +3,15 @@
   Alternative to cider.nrepl.middleware.refresh, using clj-reload instead
   of tools.namespace."
   (:require
+   [cider.nrepl.middleware.util.reload :as reload-utils]
    [clj-reload.core :as reload]
    [clojure.main :refer [repl-caught]]
    [clojure.string :as str]
    [haystack.analyzer :as 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]))
+   [nrepl.transport :as transport]))
 
 (defn- user-reload
   "Resolve clj-reload.core/<sym> from the user project or return fallback."
@@ -33,7 +33,8 @@
 (defn operation
   [msg]
   (let [opts   {:log-fn (fn [& args]
-                          (respond msg {:progress (str/join " " args)}))}
+                          (respond msg {:progress (str/join " " args)}))
+                :throw false} ;; mimic the tools.namespace behavior so that we can use `reload-utils/after-reply` uniformly
         reload (user-reload 'reload reload/reload)
         unload (user-reload 'unload reload/unload)]
     (cond
@@ -47,11 +48,14 @@
     (exec id
           (fn []
             (try
-              (operation msg)
-              (respond msg {:status :ok})
+              (reload-utils/before-reply msg)
+              (let [{:keys [exception]} (operation msg)]
+                (reload-utils/after-reply exception msg)
+                (when exception
+                  (throw exception))
+                (respond msg {:status :ok}))
               (catch Throwable error
                 (respond msg {:status :error
-                              ;; TODO assoc :file, :line info if available
                               :error  (analyzer/analyze error print-fn)})
                 (binding [*msg* msg
                           *err* (print/replying-PrintWriter :err msg {})]

src/cider/nrepl/middleware/util/reload.clj

@@ -0,0 +1,86 @@
+(ns cider.nrepl.middleware.util.reload
+  "Common parts for the code-reloading middleware namespaces."
+  {:added "0.47.0"}
+  (:require
+   [clojure.main :refer [repl-caught]]
+   [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 error-reply
+  [{:keys [error error-ns]}
+   {:keys [::print/print-fn transport] :as msg}]
+
+  (transport/send
+   transport
+   (response-for msg (cond-> {:status :error}
+                       error (assoc :error (stacktrace.analyzer/analyze error print-fn))
+                       error-ns (assoc :error-ns error-ns))))
+
+  (binding [*msg* msg
+            *err* (print/replying-PrintWriter :err msg {})]
+    (repl-caught error)))
+
+(defn- zero-arity-callable? [func]
+  (and (fn? (if (var? func) @func func))
+       (->> (:arglists (meta func))
+            (some #(or (= [] %) (= '& (first %)))))))
+
+(defn- resolve-and-invoke
+  "Takes a string and tries to coerce a function from it. If that
+  function is a function of possible zero arity (ie, truly a thunk or
+  has optional parameters and can be called with zero args, it is
+  called. Returns whether the function was resolved."
+  [sym {:keys [_session] :as msg}]
+  (let [the-var (some-> sym misc/as-sym resolve)]
+
+    (when (and (var? the-var)
+               (not (zero-arity-callable? the-var)))
+      (throw (IllegalArgumentException.
+              (format "%s is not a function of no arguments" sym))))
+
+    (binding [*msg* msg
+              *out* (print/replying-PrintWriter :out msg {})
+              *err* (print/replying-PrintWriter :err msg {})]
+      (when (var? the-var)
+        (@the-var))
+      (var? the-var))))
+
+(defn before-reply [{:keys [before transport] :as msg}]
+  (when before
+    (transport/send
+     transport
+     (response-for msg {:status :invoking-before
+                        :before before}))
+
+    (let [resolved? (resolve-and-invoke before msg)]
+      (transport/send
+       transport
+       (response-for msg
+                     {:status (if resolved?
+                                :invoked-before
+                                :invoked-not-resolved)
+                      :before before})))))
+
+(defn after-reply [error
+                   {:keys [after transport] :as msg}]
+  (when (and (not error) after)
+    (try
+      (transport/send
+       transport
+       (response-for msg {:status :invoking-after
+                          :after after}))
+
+      (let [resolved? (resolve-and-invoke after msg)]
+        (transport/send
+         transport
+         (response-for msg {:status (if resolved?
+                                      :invoked-after
+                                      :invoked-not-resolved)
+                            :after after})))
+
+      (catch Exception e
+        (error-reply {:error e} msg)))))

test/clj/cider/nrepl/middleware/refresh_test.clj

@@ -1,6 +1,7 @@
 (ns cider.nrepl.middleware.refresh-test
   (:require
    [cider.nrepl.middleware.refresh :as r]
+   [cider.nrepl.middleware.util.reload :as reload-utils]
    [cider.nrepl.test-session :as session]
    [clojure.test :refer :all]))
 
@@ -24,7 +25,7 @@
 
 (deftest invoking-function-tests
   (testing "invoking named function works"
-    (is (#'r/zero-arity-callable?
+    (is (#'reload-utils/zero-arity-callable?
          (resolve (symbol "cider.nrepl.middleware.refresh-test" "before-fn"))))))
 
 (deftest refresh-op-test