nrepl: implement (dirac! :kill) special command

src/nrepl/dirac/nrepl/compilers.clj

@@ -23,22 +23,50 @@
 (defn get-compiler-descriptor-id [descriptor]
   (:id descriptor))
 
+(defn filter-compiler-descriptors-by-first-match [descriptors]
+  (if-let [descriptor (first descriptors)]
+    (list descriptor)
+    (list)))
+
+(defn filter-compiler-descriptors-by-position [n descriptors]
+  (if-let [descriptor (nth descriptors (dec n) nil)]                                                                          ; user input is 1-based
+    (list descriptor)
+    (list)))
+
+(defn filter-compiler-descriptors-by-id [id descriptors]
+  (filter #(if (= (get-compiler-descriptor-id %) id) %) descriptors))
+
+(defn filter-compiler-descriptors-by-regexp [re descriptors]
+  (filter #(if (re-matches re (get-compiler-descriptor-id %)) %) descriptors))
+
+(defn filter-compiler-descriptors-by-substring [match descriptors]
+  (filter #(if (.contains (get-compiler-descriptor-id %) match) %) descriptors))
+
+(defn filter-matching-compiler-descriptors [match descriptors]
+  (cond
+    (nil? match) (filter-compiler-descriptors-by-first-match descriptors)
+    (integer? match) (filter-compiler-descriptors-by-position match descriptors)
+    (string? match) (filter-compiler-descriptors-by-substring match descriptors)
+    (instance? Pattern match) (filter-compiler-descriptors-by-regexp match descriptors)
+    :else (assert nil (str "invalid match in filter-matching-compiler-descriptors: " (type match)))))
+
+(defn find-compiler-descriptor-by-first-match [descriptors]
+  (first (filter-compiler-descriptors-by-first-match descriptors)))
+
 (defn find-compiler-descriptor-by-id [id descriptors]
-  (some #(if (= (get-compiler-descriptor-id %) id) %) descriptors))
+  (first (filter-compiler-descriptors-by-id id descriptors)))
 
 (defn find-compiler-descriptor-by-regexp [re descriptors]
-  (some #(if (re-matches re (get-compiler-descriptor-id %)) %) descriptors))
+  (first (filter-compiler-descriptors-by-regexp re descriptors)))
 
 (defn find-compiler-descriptor-by-substring [match descriptors]
-  (some #(if (.contains (get-compiler-descriptor-id %) match) %) descriptors))
+  (first (filter-compiler-descriptors-by-substring match descriptors)))
+
+(defn find-compiler-descriptor-by-position [n descriptors]
+  (first (filter-compiler-descriptors-by-position n descriptors)))
 
 (defn find-matching-compiler-descriptor [match descriptors]
-  (cond
-    (nil? match) (first descriptors)
-    (integer? match) (nth descriptors (dec match) nil)                                                                        ; user input is 1-based
-    (string? match) (find-compiler-descriptor-by-substring match descriptors)
-    (instance? Pattern match) (find-compiler-descriptor-by-regexp match descriptors)
-    :else (assert nil (str "invalid match in find-matching-compiler-descriptor: " (type match)))))
+  (first (filter-matching-compiler-descriptors match descriptors)))
 
 (defn register-compiler-descriptor! [descriptor]
   (state/set-session-compiler-descriptors! (conj (or (state/get-session-compiler-descriptors) []) descriptor)))
@@ -70,10 +98,13 @@
     (log/trace "available compiler descriptors:" (logging/pprint (compiler-descriptors-ids descriptors)))
     (find-compiler-descriptor-by-id descriptor-id descriptors)))
 
-(defn find-available-matching-compiler-descriptor [match]
+(defn filter-available-matching-compiler-descriptors [match]
   (let [descriptors (collect-all-available-compiler-descriptors)]
     (log/trace "available compiler descriptors:" (logging/pprint (compiler-descriptors-ids descriptors)))
-    (find-matching-compiler-descriptor match descriptors)))
+    (filter-matching-compiler-descriptors match descriptors)))
+
+(defn find-available-matching-compiler-descriptor [match]
+  (first (filter-available-matching-compiler-descriptors match)))
 
 (defn get-selected-compiler-descriptor []
   (if (state/dirac-session?)

src/nrepl/dirac/nrepl/controls.clj

@@ -2,7 +2,7 @@
   (:require [clojure.string :as string]
             [dirac.nrepl.sessions :as sessions]
             [dirac.nrepl.compilers :as compilers]
-            [dirac.nrepl.helpers :refer [with-err-output get-nrepl-info error-println
+            [dirac.nrepl.helpers :refer [with-err-output get-nrepl-info error-println simple-pluralize
                                          make-human-readable-list make-human-readable-selected-compiler]]
             [dirac.nrepl.state :as state]
             [dirac.nrepl.utils :as utils])
@@ -211,6 +211,19 @@
 (defn ^:dynamic make-cannot-spawn-outside-dirac-session-msg []
   (str "Your session is not a Dirac session. Only Dirac sessions are able to spawn new ClojureScript compilers."))
 
+(defn ^:dynamic make-no-killed-compilers-msg [user-input]
+  (str "No Dirac ClojureScript compilers currently match your input '" user-input "'. No compilers were killed."))
+
+(defn ^:dynamic make-report-killed-compilers-msg [_user-input killed-compiler-ids]
+  (let [cnt (count killed-compiler-ids)]
+    (str "Killed " cnt " " (simple-pluralize cnt "compiler") ": " (make-human-readable-list killed-compiler-ids))))
+
+(defn ^:dynamic make-report-invalid-compilers-not-killed-msg [user-input invalid-compiler-ids]
+  (str "Some compilers matching your input '" user-input "' cannot be killed because they don't belong to Dirac.\n"
+       "The list of invalid matching compilers: " (make-human-readable-list invalid-compiler-ids) ".\n"
+       "For example if you wanted to manipulate Figwheel compilers you have to use Figwheel's own interface for that:\n"
+       "https://github.com/bhauman/lein-figwheel#repl-figwheel-control-functions"))
+
 ; == special REPL commands ==================================================================================================
 
 ; we are forgiving when reading the sub-command argument,
@@ -338,6 +351,22 @@
       :else (utils/spawn-compiler! state/*nrepl-message*)))
   ::no-result)
 
+; -- (dirac! ::kill) --------------------------------------------------------------------------------------------------------
+
+(defmethod dirac! :kill [_ & [user-input]]
+  (let [selected-compiler (validate-selected-compiler user-input)]
+    (if (= ::invalid-input selected-compiler)
+      (error-println (make-invalid-compiler-error-msg user-input))
+      (let [[killed-compiler-ids invalid-compiler-ids] (utils/kill-matching-compilers! selected-compiler)]
+        (if (empty? killed-compiler-ids)
+          (error-println (make-no-killed-compilers-msg user-input))
+          (do
+            (println (make-report-killed-compilers-msg user-input killed-compiler-ids))
+            (state/send-response! (utils/prepare-current-env-info-response))))
+        (if-not (empty? invalid-compiler-ids)
+          (error-println (make-report-invalid-compilers-not-killed-msg user-input invalid-compiler-ids))))))
+  ::no-result)
+
 ; -- default handler --------------------------------------------------------------------------------------------------------
 
 (defmethod dirac! :default [command & _]

src/nrepl/dirac/nrepl/helpers.clj

@@ -72,3 +72,7 @@
   (boolean
     (and (instance? IExceptionInfo e) (#{:js-eval-error :js-eval-exception} (:type (ex-data e))))))
 
+(defn simple-pluralize [n noun]
+  (if (= n 1)
+    noun
+    (str noun "s")))

src/nrepl/dirac/nrepl/piggieback.clj

@@ -48,24 +48,6 @@
         (sessions/joined-session? (:session nrepl-message))
         (our-op? (:op nrepl-message)))))
 
-(defn wrap-nrepl-message-if-observed-job [nrepl-message]
-  (if-let [observed-job (jobs/get-observed-job nrepl-message)]
-    (make-nrepl-message-with-job-observing observed-job nrepl-message)
-    nrepl-message))
-
-(defn wrap-nrepl-message-for-dirac-session [nrepl-message]
-  (if (state/dirac-session? (:session nrepl-message))
-    (-> nrepl-message
-        make-nrepl-message-with-trace-printing                                                                                ; note: the order is important here, message should first have errors observed and then traced
-        make-nrepl-message-with-observed-errors)
-    nrepl-message))
-
-(defn wrap-nrepl-message [nrepl-message]
-  (-> nrepl-message
-      (make-nrepl-message-with-debug-logging)
-      (make-nrepl-message-with-bencode-workarounds)
-      (wrap-nrepl-message-for-dirac-session)))
-
 ; -- message handling cascade -----------------------------------------------------------------------------------------------
 
 (defn handle-identify-message! [nrepl-message]
@@ -96,7 +78,7 @@
       "load-file" (handle-load-file-message! nrepl-message))))
 
 (defn handle-nonspecial-message! [nrepl-message]
-  (let [nrepl-message (wrap-nrepl-message-if-observed-job nrepl-message)
+  (let [nrepl-message (utils/wrap-nrepl-message-if-observed-job nrepl-message)
         joined-session? (sessions/joined-session? (:session nrepl-message))]
     (cond
       joined-session? (joining/forward-message-to-joined-session! nrepl-message)
@@ -112,7 +94,7 @@
 (defn handler-job! [next-handler nrepl-message]
   (state/register-last-seen-nrepl-message! nrepl-message)
   (if (our-message? nrepl-message)
-    (handle-message! (wrap-nrepl-message nrepl-message))
+    (handle-message! (utils/wrap-nrepl-message nrepl-message))
     (next-handler nrepl-message)))
 
 ; -- top entry point (called by nrepl middleware stack) ---------------------------------------------------------------------

src/nrepl/dirac/nrepl/utils.clj

@@ -12,7 +12,31 @@
             [dirac.nrepl.debug :as debug]
             [dirac.nrepl.messages :as messages]
             [dirac.nrepl.sessions :as sessions]
-            [dirac.nrepl.transports.status-cutting :refer [make-nrepl-message-with-status-cutting]]))
+            [dirac.nrepl.transports.status-cutting :refer [make-nrepl-message-with-status-cutting]]
+            [dirac.nrepl.jobs :as jobs]
+            [dirac.nrepl.transports.bencode-workarounds :refer [make-nrepl-message-with-bencode-workarounds]]
+            [dirac.nrepl.transports.debug-logging :refer [make-nrepl-message-with-debug-logging]]
+            [dirac.nrepl.transports.errors-observing :refer [make-nrepl-message-with-observed-errors]]
+            [dirac.nrepl.transports.trace-printing :refer [make-nrepl-message-with-trace-printing]]
+            [dirac.nrepl.transports.job-observing :refer [make-nrepl-message-with-job-observing]]))
+
+(defn wrap-nrepl-message-if-observed-job [nrepl-message]
+  (if-let [observed-job (jobs/get-observed-job nrepl-message)]
+    (make-nrepl-message-with-job-observing observed-job nrepl-message)
+    nrepl-message))
+
+(defn wrap-nrepl-message-for-dirac-session [nrepl-message]
+  (if (state/dirac-session? (:session nrepl-message))
+    (-> nrepl-message
+        make-nrepl-message-with-trace-printing                                                                                ; note: the order is important here, message should first have errors observed and then traced
+        make-nrepl-message-with-observed-errors)
+    nrepl-message))
+
+(defn wrap-nrepl-message [nrepl-message]
+  (-> nrepl-message
+      (make-nrepl-message-with-debug-logging)
+      (make-nrepl-message-with-bencode-workarounds)
+      (wrap-nrepl-message-for-dirac-session)))
 
 (defn prepare-current-env-info-response []
   (eval/prepare-current-env-info-response))
@@ -58,6 +82,26 @@
         (state/set-session-meta! initial-session-meta)                                                                        ; restore session to initial state
         (throw e)))))
 
+(defn kill-compiler! [compiler-id]
+  (compilers/unregister-compiler-descriptor! compiler-id))
+
+(defn valid-compiler-to-kill? [compiler-id]
+  (some? (re-matches #"^dirac.*" compiler-id)))
+
+(defn valid-compiler-descriptor-to-kill? [compiler-descriptor]
+  (valid-compiler-to-kill? (compilers/get-compiler-descriptor-id compiler-descriptor)))
+
+(defn kill-matching-compilers! [which]
+  (let [matching-descriptors (if (nil? which)
+                               (remove nil? (list (compilers/get-selected-compiler-descriptor)))
+                               (compilers/filter-available-matching-compiler-descriptors which))
+        valid-descriptors (filter valid-compiler-descriptor-to-kill? matching-descriptors)
+        invalid-descriptors (remove valid-compiler-descriptor-to-kill? matching-descriptors)
+        valid-compiler-ids (keep compilers/get-compiler-descriptor-id valid-descriptors)
+        invalid-compiler-ids (keep compilers/get-compiler-descriptor-id invalid-descriptors)]
+    (doseq [compiler-id valid-compiler-ids]
+      (kill-compiler! compiler-id))
+    [valid-compiler-ids invalid-compiler-ids]))
 
 (defn report-missing-compiler! [nrepl-message selected-compiler]
   (let [msg (messages/make-missing-compiler-msg selected-compiler)]
@@ -98,4 +142,3 @@
 (defn load-file! [nrepl-message]
   (let [{:keys [file-path]} nrepl-message]
     (evaluate! (assoc nrepl-message :code (format "(load-file %s)" (pr-str file-path))))))
-