From c46f063b1a730f8d74312d875875c8946a82d154 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 16 Sep 2015 23:32:41 +0100 Subject: [PATCH] [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 | 56 ++++++++++--------- .../nrepl/middleware/track_state_test.clj | 56 +++++++++++-------- 2 files changed, 64 insertions(+), 48 deletions(-) diff --git a/src/cider/nrepl/middleware/track_state.clj b/src/cider/nrepl/middleware/track_state.clj index 463079781..2f5e3806c 100644 --- a/src/cider/nrepl/middleware/track_state.clj +++ b/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." diff --git a/test/clj/cider/nrepl/middleware/track_state_test.clj b/test/clj/cider/nrepl/middleware/track_state_test.clj index d3acbf6cc..28a6833e7 100644 --- a/test/clj/cider/nrepl/middleware/track_state_test.clj +++ b/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})