|
| 1 | +(ns cider.nrepl.middleware.reload |
| 2 | + "Reload changed namespaces. |
| 3 | + Alternative to cider.nrepl.middleware.refresh, using clj-reload instead |
| 4 | + of tools.namespace." |
| 5 | + (:require |
| 6 | + [clj-reload.core :as reload] |
| 7 | + [clojure.main :refer [repl-caught]] |
| 8 | + [clojure.string :as str] |
| 9 | + [haystack.analyzer :as analyzer] |
| 10 | + [nrepl.middleware.interruptible-eval :refer [*msg*]] |
| 11 | + [nrepl.middleware.print :as print] |
| 12 | + [nrepl.misc :refer [response-for]] |
| 13 | + [nrepl.transport :as transport] |
| 14 | + [orchard.misc :as misc])) |
| 15 | + |
| 16 | +(defn- user-reload |
| 17 | + "Resolve clj-reload.core/<sym> from the user project or return fallback." |
| 18 | + [sym fallback] |
| 19 | + (or (some-> (symbol "clj-reload.core" (str sym)) ;; Don't use mrandorsenized version |
| 20 | + resolve) |
| 21 | + fallback)) |
| 22 | + |
| 23 | +(defn- init |
| 24 | + "Initialize clj-reload with dirs. |
| 25 | + Only used for test, but necessary because of mranderson." |
| 26 | + [dirs] |
| 27 | + (reload/init {:dirs dirs})) |
| 28 | + |
| 29 | +(defn respond |
| 30 | + [{:keys [transport] :as msg} response] |
| 31 | + (transport/send transport (response-for msg response))) |
| 32 | + |
| 33 | +(defn operation |
| 34 | + [msg] |
| 35 | + (let [opts {:log-fn (fn [& args] |
| 36 | + (respond msg {:progress (str/join " " args)}))} |
| 37 | + reload (user-reload 'reload reload/reload) |
| 38 | + unload (user-reload 'unload reload/unload)] |
| 39 | + (cond |
| 40 | + (:all msg) (reload (assoc opts :all true)) |
| 41 | + (:clear msg) (unload opts) |
| 42 | + :else (reload opts)))) |
| 43 | + |
| 44 | +(defn- reload-reply |
| 45 | + [{:keys [::print/print-fn transport session id] :as msg}] |
| 46 | + (let [{:keys [exec]} (meta session)] |
| 47 | + (exec id |
| 48 | + (fn [] |
| 49 | + (try |
| 50 | + (operation msg) |
| 51 | + (respond msg {:status :ok}) |
| 52 | + (catch Throwable error |
| 53 | + (respond msg {:status :error |
| 54 | + ;; TODO assoc :file, :line info if available |
| 55 | + :error (analyzer/analyze error print-fn)}) |
| 56 | + (binding [*msg* msg |
| 57 | + *err* (print/replying-PrintWriter :err msg {})] |
| 58 | + (repl-caught error))))) |
| 59 | + |
| 60 | + (fn [] (respond msg {:status :done}))))) |
| 61 | + |
| 62 | +(defn handle-reload [handler msg] |
| 63 | + (case (:op msg) |
| 64 | + "cider.clj-reload/reload" (reload-reply msg) |
| 65 | + "cider.clj-reload/reload-all" (reload-reply (assoc msg :all true)) |
| 66 | + "cider.clj-reload/reload-clear" (reload-reply (assoc msg :clear true)) |
| 67 | + (handler msg))) |
0 commit comments