diff --git a/src/cider/nrepl/middleware/debug.clj b/src/cider/nrepl/middleware/debug.clj index 8892faabc..6eddc985e 100644 --- a/src/cider/nrepl/middleware/debug.clj +++ b/src/cider/nrepl/middleware/debug.clj @@ -1,16 +1,16 @@ (ns cider.nrepl.middleware.debug "Expression-based debugger for clojure code" {:author "Artur Malabarba"} - (:require [clojure.tools.nrepl.transport :as transport] - [clojure.tools.nrepl.middleware :refer [set-descriptor!]] - [clojure.tools.nrepl.misc :refer [response-for]] - [clojure.tools.nrepl.middleware.interruptible-eval :refer [*msg*]] - [cider.nrepl.middleware.util.instrument :as ins] - [cider.nrepl.middleware.inspect :refer [swap-inspector!]] + (:require [cider.nrepl.middleware.inspect :refer [swap-inspector!]] [cider.nrepl.middleware.stacktrace :as stacktrace] [cider.nrepl.middleware.util.cljs :as cljs] [cider.nrepl.middleware.util.inspect :as inspect] + [cider.nrepl.middleware.util.instrument :as ins] [cider.nrepl.middleware.util.misc :as misc] + [clojure.tools.nrepl.middleware :refer [set-descriptor!]] + [clojure.tools.nrepl.middleware.interruptible-eval :refer [*msg*]] + [clojure.tools.nrepl.misc :refer [response-for]] + [clojure.tools.nrepl.transport :as transport] [clojure.walk :as walk]) (:import [clojure.lang Compiler$LocalBinding])) @@ -285,19 +285,7 @@ (when (instance? clojure.lang.Atom session) (swap! session update-in [#'*data-readers*] assoc 'dbg #'debug-reader 'break #'breakpoint-reader) - (swap! session assoc #'*skip-breaks* (atom nil)) - ;; The session atom is reset! after eval, so it's the best way of - ;; running some code after eval is done. Since nrepl evals are async - ;; we can't just run this code after propagating the message. - (add-watch session ::track-instrumented-defs - (fn [& _] - (try - (when (map? @debugger-message) - (let [ins-defs (into [] (if ns (ins/list-instrumented-defs ns)))] - (debugger-send {:ns ns :status :instrumented-defs - :instrumented-defs (misc/transform-value ins-defs)}) - (remove-watch session ::track-instrumented-defs))) - (catch Exception e))))) + (swap! session assoc #'*skip-breaks* (atom nil))) ;; The best way of checking if there's a #break reader-macro in ;; `code` is by reading it, in which case it toggles `has-debug?`. (let [has-debug? (atom false) diff --git a/src/cider/nrepl/middleware/track_state.clj b/src/cider/nrepl/middleware/track_state.clj index 1eb869928..0b3401f70 100644 --- a/src/cider/nrepl/middleware/track_state.clj +++ b/src/cider/nrepl/middleware/track_state.clj @@ -2,17 +2,116 @@ "State tracker for client sessions." {:author "Artur Malabarba"} (:require [cider.nrepl.middleware.util.cljs :as cljs] - [clojure.tools.nrepl.middleware :refer [set-descriptor!]] - [clojure.tools.nrepl.middleware.interruptible-eval :refer [*msg*]] - [clojure.tools.nrepl.misc :refer [response-for]] - [clojure.tools.nrepl.transport :as transport]) + [cider.nrepl.middleware.util.misc :as misc] + [cljs-tooling.util.analysis :as cljs-ana] + [clojure.tools.nrepl.middleware :refer [set-descriptor!]]) (:import clojure.tools.nrepl.transport.Transport)) +;;; Auxiliary +(defn update-vals + "Update the keys of map `m` via the function `f`." + [m f] + (reduce (fn [acc [k v]] + (assoc acc k (f v))) + {} m)) + +(defn filter-core + "Remove keys whose values are vars in the core namespace." + [refers] + (let [core (find-ns 'clojure.core)] + (reduce (fn [acc [sym var]] + (if (identical? (:ns (meta var)) core) + acc + (assoc acc sym var))) + {} refers))) + +(def relevant-meta-keys + "Metadata keys that are useful to us. + This is used so that we don't crowd the ns cache with useless or + redudant information, such as :name and :ns." + [:indent :cider-instrumented :macro :arglists :test]) + +(defn relevant-meta + "Return the meta of var, selecting only keys of interest." + [var] + (select-keys (meta var) relevant-meta-keys)) + +;;; State management +(defmulti ns-as-map + "Return a map of useful information about ns." + class) + +;; Clojure Namespaces +(defmethod ns-as-map clojure.lang.Namespace [ns] + {:name (ns-name ns) + :interns (update-vals (ns-interns ns) relevant-meta) + :aliases (update-vals (ns-aliases ns) ns-name) + :refers (filter-core (ns-refers ns))}) +;; ClojureScript Namespaces +(defmethod ns-as-map clojure.lang.Associative [ns] + (let [{:keys [use-macros require-macros uses requires defs]} ns] + ;; For some reason, cljs (or piggieback) adds a :test key to the + ;; var metadata stored in the namespace. + {:name (:name ns) + :interns (update-vals defs #(-> (select-keys % relevant-meta-keys) + (dissoc :test))) + :aliases (merge require-macros requires) + :refers (merge uses use-macros)})) + +(def ns-cache + "Cache of the namespace info that has been sent to each session. + Each key is a session. Each value is a map from namespace names to + data (as returned by `ns-as-map`)." + (atom {})) + +(defn calculate-changed-ns-map + "Return a map of namespaces that changed between new and old-map. + new is a list of namespaces objects, as returned by `all-ns`. + old-map is a map from namespace names to namespace data, which is + the same format of map returned by this function. old-map can also + be nil, which is the same as an empty map." + [new old-map] + (reduce (if (empty? old-map) + ;; Optimization for an empty map. + (fn [acc ns] + (assoc acc (:name ns) ns)) + ;; General implementation. + (fn [acc {:keys [name] :as ns}] + (if (= (get old-map name) ns) + acc + (assoc acc name ns)))) + {} + (map ns-as-map new))) + (defn assoc-state - "Return response with a :state entry assoc'ed." - [response msg] - (assoc response :state {:repl-type (if (cljs/grab-cljs-env msg) :cljs :clj)})) + "Return response with a :state entry assoc'ed. + This function is not pure nor idempotent! + It updates the server's cache, so not sending the value it returns + implies that the client's cache will get outdated. + + The state is a map of two entries. One is the :repl-type, which is + either :clj or :cljs. + The other is :changed-namespaces, which is a map from namespace + names to namespace data (as returned by `ns-as-map`). This contains + only namespaces which have changed since we last notified the + client." + [response {:keys [session] :as msg}] + (let [old-data (@ns-cache session) + cljs (cljs/grab-cljs-env msg) + ;; See what has changed compared to the cache. If the cache + ;; was empty, everything is considered to have changed (and + ;; the cache will then be filled). + changed-ns-map (-> (if cljs + (vals (cljs-ana/all-ns cljs)) + (all-ns)) + (calculate-changed-ns-map old-data))] + (swap! ns-cache update-in [session] + merge changed-ns-map) + (assoc response :state {:repl-type (if cljs :cljs :clj) + :changed-namespaces (misc/transform-value changed-ns-map)}))) + +;;; Middleware (defn make-transport "Return a Transport that defers to `transport` and possibly notifies about the state." @@ -21,20 +120,28 @@ (recv [this] (.recv transport)) (recv [this timeout] (.recv transport timeout)) (send [this {:keys [status] :as response}] - (.send transport (cond-> response - (contains? status :done) (assoc-state msg)))))) + (.send transport (try ;If we screw up, we break eval completely. + (cond-> response + (contains? status :done) (assoc-state msg)) + (catch Exception e + (println e) + response)))))) + +(def ops-that-can-eval + "Set of nREPL ops that can lead code being evaluated." + #{"eval" "load-file" "refresh" "refresh-all" "refresh-clear" "undef"}) (defn wrap-tracker "Middleware that tracks relevant server info and notifies the client." [handler] (fn [{:keys [op] :as msg}] - (cond - (#{"eval" "load-file"} op) (handler (assoc msg :transport (make-transport msg))) - :else (handler msg)))) + (if (ops-that-can-eval op) + (handler (assoc msg :transport (make-transport msg))) + (handler msg)))) (set-descriptor! #'wrap-tracker - (cljs/requires-piggieback + (cljs/expects-piggieback {:expects #{"eval"} :handles {"track-state-middleware" diff --git a/test/clj/cider/nrepl/middleware/track_state_test.clj b/test/clj/cider/nrepl/middleware/track_state_test.clj index 420094164..6b564f1be 100644 --- a/test/clj/cider/nrepl/middleware/track_state_test.clj +++ b/test/clj/cider/nrepl/middleware/track_state_test.clj @@ -5,15 +5,69 @@ [clojure.tools.nrepl.transport :as t]) (:import clojure.tools.nrepl.transport.Transport)) +(def ^:const msg {:session :dummy}) + (deftest make-transport - (is (instance? Transport (s/make-transport nil))) - (is (try (send (s/make-transport nil) 10) + (is (instance? Transport (s/make-transport msg))) + (is (try (send (s/make-transport msg) 10) nil (catch Exception e true)))) (deftest assoc-state - (is (= (s/assoc-state {} {}) - {:state {:repl-type :clj}})) - (with-redefs [cljs/grab-cljs-env identity] - (is (= (s/assoc-state {} {}) - {:state {:repl-type :cljs}})))) + (with-redefs [s/ns-cache (atom {})] + (let [{:keys [repl-type changed-namespaces]} (:state (s/assoc-state {} msg))] + (is (= repl-type :clj)) + (is (map? changed-namespaces)) + (is (> (count changed-namespaces) 100))) + ;; Check the caching + (let [changed-again (get-in (s/assoc-state {} msg) [:state :changed-namespaces])] + (is (map? changed-again)) + (is (empty? changed-again))) + ;; Remove a value + (swap! s/ns-cache update-in [:dummy] + #(dissoc % (ffirst %))) + ;; Check again + (let [changed-again (get-in (s/assoc-state {} msg) [:state :changed-namespaces])] + (is (= (count changed-again) 1)))) + ;; Check repl-type :cljs + (with-redefs [cljs/grab-cljs-env (constantly true) + s/ns-cache (atom {})] + (let [{:keys [repl-type changed-namespaces]} (:state (s/assoc-state {} msg))] + (is (= repl-type :cljs)) + (is (map? changed-namespaces))))) + +(deftest update-vals + (is (= (s/update-vals {1 2 3 4 5 6} inc) + {1 3 3 5 5 7})) + (is (= (s/update-vals {1 2 3 4 5 6} range) + '{5 (0 1 2 3 4 5), 3 (0 1 2 3), 1 (0 1)})) + (is (= (s/update-vals {:a :b :c :d :e :f} str) + {:e ":f", :c ":d", :a ":b"})) + (is (= (s/update-vals {1 2 3 4 5 6} odd?) + {1 false 3 false 5 false}))) + +(deftest filter-core + (is (= (s/filter-core {'and #'and, 'b #'map, 'c #'deftest}) + {'c #'clojure.test/deftest})) + (is (-> (find-ns 'clojure.core) + ns-interns s/filter-core + seq not))) + +(deftest relevant-meta + (is (= (:macro (s/relevant-meta #'deftest)) + true)) + (alter-meta! #'update-vals merge {:indent 1 :cider-instrumented 2 :something-else 3}) + (is (= (s/relevant-meta #'update-vals) + {:cider-instrumented 2, :indent 1, :test (:test (meta #'update-vals))}))) + +(deftest ns-as-map + (alter-meta! #'update-vals + merge {:indent 1 :cider-instrumented 2 :something-else 3}) + (let [{:keys [interns aliases] :as ns} (s/ns-as-map (find-ns 'cider.nrepl.middleware.track-state-test))] + (is (> (count ns) 3)) + (is (> (count interns) 4)) + (is (= (into #{} (keys (interns 'update-vals))) + #{:cider-instrumented :indent :test})) + (is (> (count aliases) 2)) + (is (= (aliases 's) + 'cider.nrepl.middleware.track-state))))