[Fix clojure-emacs/cider#1320] Do state tracking with an agent

This should fix all lags associated with the new namespace tracking,
both the long delay at first connection and the ~1sec lag in the REPL.

src/cider/nrepl/middleware/track_state.clj

@@ -7,7 +7,9 @@
             [cljs-tooling.util.analysis :as cljs-ana]
             [clojure.java.classpath :as cp]
             [clojure.tools.namespace.find :as ns-find]
-            [clojure.tools.nrepl.middleware :refer [set-descriptor!]])
+            [clojure.tools.nrepl.middleware :refer [set-descriptor!]]
+            [clojure.tools.nrepl.misc :refer [response-for]]
+            [clojure.tools.nrepl.transport :as transport])
   (:import clojure.lang.Namespace
            clojure.tools.nrepl.transport.Transport))
 
@@ -78,8 +80,10 @@
 
 (def clojure-core-map
   (when clojure-core
-    (update-vals #(relevant-meta (meta %))
-                 (ns-map clojure-core))))
+    {:aliases {}
+     :interns (->> (.getMappings clojure-core)
+                   (filter #(var? (second %)))
+                   (update-vals #(relevant-meta (meta %))))}))
 
 (defn calculate-changed-ns-map
   "Return a map of namespaces that changed between new and old-map.
@@ -127,24 +131,26 @@
   "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 {}))
+  (agent {}
+         :error-handler
+         (fn [_ e]
+           (println "Exception updating the ns-cache" e))))
 
-(defn assoc-state
-  "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.
+(defn update-and-send-cache
+  "Send a reply to msg with state information assoc'ed.
+  old-data is the ns-cache that needs to be updated (the one
+  associated with msg's session). Return the updated value for it.
+  This function has side-effects (sending the message)!
 
-  The state is a map of two entries. One is the :repl-type, which is
-  either :clj or :cljs.
+  Two extra entries are sent in the reply. 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)
+  [old-data msg]
+  (let [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).
@@ -154,26 +160,26 @@
                            (calculate-changed-ns-map old-data))
         used-aliases (calculate-used-aliases changed-ns-map (or old-data {}))
         changed-ns-map (merge changed-ns-map used-aliases)]
-    (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)})))
+    (->> (response-for
+          msg :status :state
+          :repl-type (if cljs :cljs :clj)
+          :changed-namespaces (misc/transform-value changed-ns-map))
+         (transport/send (:transport msg)))
+    (merge old-data changed-ns-map)))
 
 ;;; Middleware
 (defn make-transport
   "Return a Transport that defers to `transport` and possibly notifies
   about the state."
-  [{:keys [^Transport transport] :as msg}]
+  [{:keys [^Transport transport session] :as msg}]
   (reify Transport
     (recv [this] (.recv transport))
     (recv [this timeout] (.recv transport timeout))
     (send [this {:keys [status] :as response}]
-      (.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))))))
+      (.send transport response)
+      (when (contains? status :done)
+        (send ns-cache update-in [session]
+              update-and-send-cache msg)))))
 
 (def ops-that-can-eval
   "Set of nREPL ops that can lead code being evaluated."

test/clj/cider/nrepl/middleware/track_state_test.clj

@@ -16,29 +16,39 @@
 (deftest track-ns?
   (is (not (some s/track-ns? s/jar-namespaces))))
 
-(deftest assoc-state
-  (with-redefs [s/ns-cache (atom {})
-                s/track-ns? (constantly true)]
-    (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-and-send-cache
+  (let [sent-value (atom nil)]
+    (with-redefs [s/track-ns? (constantly true)
+                  t/send (fn [t m] (reset! sent-value m))]
+      (let [new-data (s/update-and-send-cache nil msg)]
+        (is (map? new-data))
+        (is (> (count new-data) 100)))
+      (let [{:keys [repl-type changed-namespaces]} @sent-value]
+        (is (= repl-type :clj))
+        (is (map? changed-namespaces))
+        (is (> (count changed-namespaces) 100)))
+      (let [full-cache (s/update-and-send-cache nil msg)
+            get-sent-value (fn [old] (s/update-and-send-cache old msg)
+                             @sent-value)]
+        ;; Return value depends only on the current state.
+        (is (= (s/update-and-send-cache nil msg)
+               (s/update-and-send-cache (into {} (take 5 full-cache)) msg)
+               (s/update-and-send-cache full-cache msg)))
+        ;; Sent message depends on the first arg.
+        (is (= (get-sent-value full-cache)
+               (get-sent-value full-cache)))
+        (is (= (get-sent-value (into {} (drop 3 full-cache)))
+               (get-sent-value (into {} (drop 3 full-cache))))))
+      ;; In particular, the sent message only contains the diff.
+      (let [changed-again (:changed-namespaces @sent-value)]
+        (is (map? changed-again))
+        (is (= (count changed-again) 3)))
+      ;; Check repl-type :cljs
+      (with-redefs [cljs/grab-cljs-env (constantly true)]
+        (s/update-and-send-cache nil msg)
+        (let [{:keys [repl-type changed-namespaces]} @sent-value]
+          (is (= repl-type :cljs))
+          (is (map? changed-namespaces)))))))
 
 (deftest update-vals
   (is (= (s/update-vals inc {1 2 3 4 5 6})