Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
198 lines (169 sloc) 6.76 KB
(ns ^{:clojure.tools.namespace.repl/load false
:clojure.tools.namespace.repl/unload false} cider.nrepl.middleware.refresh
;; The above metadata prevents reloading of this namespace - otherwise,
;; `refresh-tracker` is reset with every refresh. This only has any effect
;; 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.stacktrace :refer [analyze-causes]]
[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]
[nrepl.middleware.interruptible-eval :refer [*msg*]]
[nrepl.middleware.print :as print]
[nrepl.misc :refer [response-for]]
[nrepl.transport :as transport]
[orchard.misc :as u]))
(defonce ^:private refresh-tracker (volatile! (track/tracker)))
(defn- user-refresh-dirs
"Directories to watch and reload, as configured by the user.
See `clojure.tools.namespace.repl/set-refresh-dirs`.
The var is resolved at runtime to get the \"real\" clojure.tools.namespace,
not the mranderson-ized version bundled with CIDER. Returns `nil` if c.t.n.r
isn't loaded. Returns `[]` if c.t.n.r is loaded but no custom dirs have been
set."
[]
(some-> (symbol "clojure.tools.namespace.repl" "refresh-dirs")
resolve
deref))
;; We construct the keyword at runtime here because namespaced keyword literals
;; in clojure.tools.namespace.repl itself might be rewritten by mranderson - in
;; this case, we still want to disable reloading of namespaces that a user has
;; added the (non-rewritten) metadata to.
(defn- load-disabled?
[sym]
(false? (get (meta (find-ns sym))
(keyword "clojure.tools.namespace.repl" "load"))))
;; As documented in clojure.tools.namespace.repl/disable-reload!,
;; ^{:c.t.n.r/load false} implies ^{:c.t.n.r/unload false}
(defn- unload-disabled?
[sym]
(or (load-disabled? sym)
(false? (get (meta (find-ns sym))
(keyword "clojure.tools.namespace.repl" "unload")))))
(defn- remove-disabled
[tracker]
(-> tracker
(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 u/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 {})]
(do
(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 session transport] :as msg}]
(transport/send
transport
(response-for msg (cond-> {:status :error}
error (assoc :error (analyze-causes 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)
(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
[{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)))))
(defn- refresh-reply
[{:keys [dirs transport session id] :as msg}]
(let [{:keys [exec]} (meta session)]
(exec id
(fn []
(locking refresh-tracker
(vswap! refresh-tracker
(fn [tracker]
(try
(before-reply msg)
(-> tracker
(dir/scan-dirs (or (seq dirs) (user-refresh-dirs))
(select-keys msg [:platform :add-all?]))
(remove-disabled)
(doto (reloading-reply msg))
(reload/track-reload)
(doto (result-reply msg))
(doto (after-reply msg)))
(catch Throwable e
(error-reply {:error e} msg)
tracker))))))
(fn []
(transport/send transport (response-for msg {:status :done}))))))
(defn- clear-reply
[{:keys [transport session id] :as msg}]
(let [{:keys [exec]} (meta session)]
(exec id
(fn []
(locking refresh-tracker
(vreset! refresh-tracker (track/tracker))))
(fn []
(transport/send transport (response-for msg {:status :done}))))))
(defn handle-refresh [handler msg]
(case (:op msg)
"refresh" (refresh-reply (assoc msg :platform find/clj))
"refresh-all" (refresh-reply (assoc msg :platform find/clj :add-all? true))
"refresh-clear" (clear-reply msg)
(handler msg)))
You can’t perform that action at this time.