implant: implement a new link handler "Reveal via nREPL"

src/implant/dirac/implant.cljs

@@ -15,7 +15,8 @@
             [dirac.implant.munging :as munging]
             [dirac.implant.helpers :as helpers]
             [dirac.implant.reporter :as reporter]
-            [dirac.implant.repl :as repl])
+            [dirac.implant.repl :as repl]
+            [dirac.implant.link-handlers :as link-handlers])
   (:import goog.async.Debouncer))
 
 (defonce ^:dynamic *console-initialized* false)
@@ -86,6 +87,7 @@
   (post-feedback! (str "setCurrentPanel: " panel-id)))
 
 (defn notify-frontend-initialized []
+  (link-handlers/install!)
   (helpers/warm-up-namespace-cache!))
 
 (defn trigger-internal-error-for-testing! []

src/implant/dirac/implant/intercom.cljs

@@ -414,3 +414,16 @@
             "interrupt" (handle-forwarded-interrupt-message! forwarded-nrepl-message job-id)
             (error-response job-id (unrecognized-forwarded-nrepl-op-msg op forwarded-nrepl-message))))
         (error-response job-id (unable-unserialize-msg forwarded-nrepl-message serialized-forwarded-nrepl-message))))))
+
+; -- devtools requests ------------------------------------------------------------------------------------------------------
+
+(defn make-devtools-request-message [request payload]
+  {:op      "dirac-devtools-request"
+   :request request
+   :payload payload})
+
+(defn send-devtools-request! [request payload]
+  (assert (repl-ready?))
+  (let [nrepl-message (make-devtools-request-message request payload)
+        responses-chan (nrepl-tunnel-client/tunnel-message-with-responses! nrepl-message)]
+    responses-chan))

src/implant/dirac/implant/link_handlers.cljs

@@ -0,0 +1,50 @@
+(ns dirac.implant.link-handlers
+  (:require-macros [cljs.core.async.macros :refer [go go-loop]])
+  (:require [cljs.core.async :refer [put! <! chan timeout alts! close!]]
+            [oops.core :refer [gset! oget oset! oset!+ ocall! ocall oapply gget gcall!]]
+            [chromex.logging :refer-macros [log warn error info]]
+            [dirac.implant.intercom :as intercom]))
+
+(defn ^:dynamic make-open-request-error-message [error url]
+  (str "A request to reveal a link reported an error: " error "\n"
+       "The url requested to be revealed was: " url "\n"
+       "Please inspect your nREPL server terminal output for more details."))
+
+(defn ^:dynamic make-repl-readiness-warning-message [url]
+  (str "Cannot reveal a link via nREPL. REPL connection is not ready.\n"
+       "The url requested to be revealed was: " url "\n"
+       "Please connect to nREPL server in DevTools console first."))
+
+; -- reveal-url -------------------------------------------------------------------------------------------------------------
+
+(defn should-call-dirac-action? [event]
+  (not (ocall event "getModifierState" "Meta")))
+
+(defn should-call-original-action? [event]
+  (not (ocall event "getModifierState" "Alt")))
+
+(defn open-via-nrepl! [url line column]
+  (if (intercom/repl-ready?)
+    (go
+      (let [payload {:url url :line (inc line) :column column}                                                                ; devtools line numbers are 0-based
+            response (<! (intercom/send-devtools-request! :reveal-url payload))
+            result (:result response)]
+        (if (some? result)
+          (error (make-open-request-error-message result url)))))
+    (warn (make-repl-readiness-warning-message url))))
+
+(defn open-via-nrepl-link-handler [all-actions url line column event]
+  (let [next-action (second all-actions)]
+    (if (should-call-dirac-action? event)
+      (open-via-nrepl! url line column))
+    (if (and (some? next-action) (should-call-original-action? event))
+      (ocall! next-action "handler"))))
+
+(defn register-open-via-nrepl-handler! []
+  (gcall! "dirac.registerDiracLinkAction" #js {:title   "Reveal via nREPL"
+                                               :handler open-via-nrepl-link-handler}))
+
+; -- installation -----------------------------------------------------------------------------------------------------------
+
+(defn install! []
+  (register-open-via-nrepl-handler!))