Track namespace info as part of track-state

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)

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"

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))))