[debug] Correctly process #dbg during load-file

Author: alexander-yakushev

project.clj

@@ -20,7 +20,7 @@
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :scm {:name "git" :url "https://github.com/clojure-emacs/cider-nrepl"}
-  :dependencies [[nrepl/nrepl "1.4.0" :exclusions [org.clojure/clojure]]
+  :dependencies [[nrepl/nrepl "1.5.0-SNAPSHOT" :exclusions [org.clojure/clojure]]
                  [cider/orchard "0.37.0" :exclusions [org.clojure/clojure]]
                  ^:inline-dep [compliment "0.7.1"]
                  ^:inline-dep [org.rksm/suitable "0.6.2" :exclusions [org.clojure/clojure

src/cider/nrepl.clj

@@ -207,12 +207,15 @@ Depending on the type of the return value of the evaluation this middleware may
               "complete-flush-caches"
               {:doc "Forces the completion backend to repopulate all its caches"}}}))
 
+;; `wrap-debug` has to be sandwiched between `load-file` and `eval`. First
+;; `load-file` transforms its message into an `eval`, then `wrap-debug` attaches
+;; its instrumenting functions to the message, and finally `eval` does the work.
 (def-wrapper wrap-debug cider.nrepl.middleware.debug/handle-debug
   #{"eval"}
   (cljs/requires-piggieback
    {:doc "Provide instrumentation and debugging functionality."
     :expects  #{"eval"}
-    :requires #{#'wrap-print #'session}
+    :requires #{#'wrap-print #'session "load-file"}
     :handles {"debug-input"
               {:doc "Read client input on debug action."
                :requires {"input" "The user's reply to the input request."

src/cider/nrepl/middleware/debug.clj

@@ -2,12 +2,14 @@
   "Expression-based debugger for clojure code"
   {:author "Artur Malabarba"}
   (:require
+   [clojure.string :as str]
    [cider.nrepl.middleware.inspect :refer [swap-inspector!]]
    [cider.nrepl.middleware.util :as util :refer [respond-to]]
    [cider.nrepl.middleware.util.cljs :as cljs]
+   [cider.nrepl.middleware.util.eval]
    [cider.nrepl.middleware.util.instrument :as ins]
    [cider.nrepl.middleware.util.nrepl :refer [notify-client]]
-   [nrepl.middleware.interruptible-eval :refer [*msg*]]
+   [nrepl.middleware.interruptible-eval :as ieval :refer [*msg*]]
    [nrepl.middleware.print :as print]
    [orchard.info :as info]
    [orchard.inspect :as inspect]
@@ -466,6 +468,10 @@ this map (identified by a key), and will `dissoc` it afterwards."}
 
 (def ^:dynamic *tmp-forms* (atom {}))
 (def ^:dynamic *do-locals* true)
+#_:clj-kondo/ignore
+(def ^:dynamic ^:private *found-debugger-tag*)
+#_:clj-kondo/ignore
+(def ^:dynamic ^:private *top-level-form-meta*)
 
 (defmacro with-initial-debug-bindings
   "Let-wrap `body` with STATE__ map containing code, file, line, column etc.
@@ -476,17 +482,26 @@ this map (identified by a key), and will `dissoc` it afterwards."}
   {:style/indent 0}
   [& body]
   ;; NOTE: *msg* is the message that instrumented the function,
-  `(let [~'STATE__ {:msg ~(let [{:keys [code id file line column ns]} *msg*]
-                            {:code code
-                             ;; Passing clojure.lang.Namespace object
-                             ;; as :original-ns breaks nREPL in bewildering
-                             ;; ways.
-                             ;; NOTE: column numbers in the response map
-                             ;; start from 1 according to Clojure.
-                             ;; This is not a bug and should be converted to
-                             ;; 0-based indexing by the client if necessary.
-                             :original-id id, :original-ns (str (or ns *ns*))
-                             :file file, :line line, :column column})
+  `(let [~'STATE__ {:msg ~(if (bound? #'*top-level-form-meta*)
+                            (let [{:keys [line column ns], form-info ::form-info}
+                                  *top-level-form-meta*
+                                  {:keys [code file original-id]} form-info]
+                              {:code code
+                               ;; Passing clojure.lang.Namespace object
+                               ;; as :original-ns breaks nREPL in bewildering
+                               ;; ways.
+                               ;; NOTE: column numbers in the response map
+                               ;; start from 1 according to Clojure.
+                               ;; This is not a bug and should be converted to
+                               ;; 0-based indexing by the client if necessary.
+                               :original-ns (str (or ns *ns*))
+                               :original-id original-id
+                               :file file, :line line, :column column})
+                            (let [{:keys [code file line column ns original-id]} *msg*]
+                              {:code code
+                               :original-ns (str (or ns *ns*))
+                               :original-id original-id
+                               :file file, :line line, :column column}))
                     ;; the coor of first form is used as the debugger session id
                     :session-id (atom nil)
                     :skip (atom false)
@@ -626,50 +641,59 @@ this map (identified by a key), and will `dissoc` it afterwards."}
 ;;; ## Data readers
 ;;
 ;; Set in `src/data_readers.clj`.
+
+(defn- found-debugger-tag []
+  (when (bound? #'*found-debugger-tag*)
+    (set! *found-debugger-tag* true)))
+
 (defn breakpoint-reader
   "#break reader. Mark `form` for breakpointing."
   [form]
+  (found-debugger-tag)
   (ins/tag-form form #'breakpoint-with-initial-debug-bindings true))
 
 (defn debug-reader
   "#dbg reader. Mark all forms in `form` for breakpointing.
   `form` itself is also marked."
   [form]
+  (found-debugger-tag)
   (ins/tag-form (ins/tag-form-recursively form #'breakpoint-if-interesting)
                 #'breakpoint-if-interesting-with-initial-debug-bindings))
 
 (defn break-on-exception-reader
   "#exn reader. Wrap `form` in try-catch and break only on exception"
   [form]
+  (found-debugger-tag)
   (ins/tag-form form #'breakpoint-if-exception-with-initial-debug-bindings true))
 
 (defn debug-on-exception-reader
   "#dbgexn reader. Mark all forms in `form` for breakpointing on exception.
   `form` itself is also marked."
   [form]
+  (found-debugger-tag)
   (ins/tag-form (ins/tag-form-recursively form #'breakpoint-if-exception)
                 #'breakpoint-if-exception-with-initial-debug-bindings))
 
 (defn instrument-and-eval [form]
-  (let [form1 (ins/instrument-tagged-code form)]
-    ;; (ins/print-form form1 true false)
-    (try
-      (binding [*tmp-forms* (atom {})]
-        (eval form1))
-      (catch java.lang.RuntimeException e
-        (if (some #(when %
-                     (re-matches #".*Method code too large!.*"
-                                 (.getMessage ^Throwable %)))
-                  [e (.getCause e)])
-          (do (notify-client *msg*
-                             (str "Method code too large!\n"
-                                  "Locals and evaluation in local context won't be available.")
-                             :warning)
-              ;; re-try without locals
-              (binding [*tmp-forms* (atom {})
-                        *do-locals* false]
-                (eval form1)))
-          (throw e))))))
+  (binding [*top-level-form-meta* (meta form)]
+    (let [form1 (ins/instrument-tagged-code form)]
+      (try
+        (binding [*tmp-forms* (atom {})]
+          (eval form1))
+        (catch java.lang.RuntimeException e
+          (if (some #(when %
+                       (re-matches #".*Method code too large!.*"
+                                   (.getMessage ^Throwable %)))
+                    [e (.getCause e)])
+            (do (notify-client *msg*
+                               (str "Method code too large!\n"
+                                    "Locals and evaluation in local context won't be available.")
+                               :warning)
+                ;; re-try without locals
+                (binding [*tmp-forms* (atom {})
+                          *do-locals* false]
+                  (eval form1)))
+            (throw e)))))))
 
 (def ^:dynamic *debug-data-readers*
   "Reader macros like #dbg which cause code to be instrumented when present."
@@ -701,6 +725,30 @@ this map (identified by a key), and will `dissoc` it afterwards."}
       ;; If there was no reader macro, fallback on regular eval.
       msg)))
 
+(defn- maybe-debug-nrepl-1-5+
+  "Alternative implementation of `maybe-debug` that is only supported with nREPL
+  1.5+ or higher. This version supports forms compiled by `load-file` and
+  doesn't perform double read like the older version."
+  [msg]
+  (let [read-fn
+        (fn [options reader]
+          (binding [*found-debugger-tag* false]
+            ;; Read the form normally and then check if the flag turned on that
+            ;; tells us the form contains any debugger reader tags.
+            (let [[form code] (ins/comment-trimming-read+string options reader)]
+              (if *found-debugger-tag*
+                ;; Attach the original (but cleaned up) source code for the
+                ;; instrumenter to set up correct debugger state later.
+                (vary-meta form assoc
+                           ::form-info {:code code
+                                        :file (:file msg)
+                                        :original-id (:id msg)})
+                form))))]
+    (assoc msg
+           ::ieval/read-fn read-fn
+           ::ieval/eval-fn (cider.nrepl.middleware.util.eval/eval-dispatcher
+                            instrument-and-eval ::form-info))))
+
 (defn- initialize
   "Initialize the channel used for debug-input requests."
   [{:keys [:nrepl.middleware.print/options] :as msg}]
@@ -723,7 +771,9 @@ this map (identified by a key), and will `dissoc` it afterwards."}
   (case op
     "eval" (do (when (instance? clojure.lang.Atom session)
                  (swap! session assoc #'*skip-breaks* (atom nil)))
-               (handler (maybe-debug msg)))
+               (handler (if (cider.nrepl.middleware.util.nrepl/satisfies-version? 1 5)
+                          (maybe-debug-nrepl-1-5+ msg)
+                          (maybe-debug msg))))
     "debug-instrumented-defs" (instrumented-defs-reply msg)
     "debug-input" (when-let [pro (@promises (:key msg))]
                     (deliver pro input))

src/cider/nrepl/middleware/util/eval.clj

@@ -0,0 +1,15 @@
+(ns cider.nrepl.middleware.util.eval
+  (:import clojure.lang.Compiler))
+
+;; The sole reason for this namespace to exist is to prevent
+;; `cider.nrepl.middleware.debug/instrument-and-eval` from appearing on the
+;; stacktrace when we don't, in fact, compile with the debugger. Sure, this may
+;; seem minor, but I don't want to confuse users and send them on wild geese
+;; chases thinking that the debugger may be somehow related to the thrown
+;; exceptions when it is not enabled at all.
+
+(defn eval-dispatcher [debugger-eval-fn dispatch-kw]
+  (fn [form]
+    (if (get (meta form) dispatch-kw)
+      (debugger-eval-fn form)
+      (Compiler/eval form true))))

src/cider/nrepl/middleware/util/instrument.clj

@@ -4,7 +4,8 @@
   (:require
    clojure.pprint
    [clojure.walk :as walk]
-   [orchard.meta :as m]))
+   [orchard.meta :as m])
+  (:import (clojure.lang LineNumberingPushbackReader)))
 
 ;;;; # Instrumentation
 ;;;
@@ -382,6 +383,52 @@
          (filter (comp :cider/instrumented meta second))
          (map first))))
 
+;; Utilities for correctly mapping the read form to its string content. Default
+;; Clojure `read+string` returns leading comments and other garbage as if it is
+;; part of the read form, making our lives harder when we want to align that
+;; with the content of Emacs buffer.
+
+(defn- skip-n-lines
+  "Find the character offset where the nth line starts (after n newlines)."
+  [s lines-to-skip]
+  (try
+    (let [matcher (re-matcher #"\r?\n" s)]
+      (dotimes [_ lines-to-skip] (re-find matcher))
+      (.end matcher))
+    (catch IllegalStateException _ 0)))
+
+(defn- trim-to-form
+  "Trim captured string from reader start position to actual form start position"
+  [captured-string start-line start-col form-line form-col]
+  (if (and (= start-line form-line) (= start-col form-col))
+    ;; No trimming needed - form starts exactly where we started reading
+    captured-string
+    ;; Need to trim: walk through the string counting lines and columns
+    (let [lines-to-skip (- form-line start-line)
+          final-offset (if (= lines-to-skip 0)
+                         (- form-col start-col)
+                         (+ (skip-n-lines captured-string lines-to-skip)
+                            (dec form-col)))] ;; 1-based to 0-based
+      (subs captured-string final-offset))))
+
+(defn comment-trimming-read+string
+  "Like `read+string` but trims comments and skipped forms from the string result,
+  thus only returning the string that actually backs the read form, without the
+  cruft could be before it."
+  [opts, ^LineNumberingPushbackReader reader]
+  (let [start-line (.getLineNumber reader)
+        start-col (.getColumnNumber reader)]
+    (.captureString reader)
+    (let [form (read opts reader)
+          captured-string (.getString reader)
+          {:keys [line column]} (meta form)
+          ;; If form has line/column metadata, trim the captured string.
+          trimmed-string (if (and line column)
+                           (trim-to-form captured-string start-line start-col
+                                         line column)
+                           captured-string)]
+      [form trimmed-string])))
+
 ;;; Instrumentation test support
 ;;;
 ;;; This code migrated out of the test namespace to avoid a dependency

src/cider/nrepl/middleware/util/nrepl.clj

@@ -1,9 +1,18 @@
 (ns cider.nrepl.middleware.util.nrepl
-  "Common utilities for interaction with the client."
+  "Common nREPL-related utilities."
   (:require
    [nrepl.middleware.interruptible-eval :refer [*msg*]]
    [nrepl.misc :refer [response-for]]
-   [nrepl.transport :as transport]))
+   [nrepl.transport :as transport]
+   [nrepl.version :refer [version]]))
+
+(defn satisfies-version?
+  "Check if the nREPL version is of the provided major and minor parts or newer."
+  [major minor]
+  (>= (compare ((juxt :major :minor) version) [major minor]) 0))
+
+#_(satisfies-version? 0 9)
+#_(satisfies-version? 1 10)
 
 (defn notify-client
   "Send user level notification to client as a response to request `msg`.

test/clj/cider/nrepl/middleware/debug_integration_test.clj

@@ -98,6 +98,10 @@
 (defmethod debugger-send :eval [_ code]
   (nrepl-send {:op "eval" :code code}))
 
+(defmethod debugger-send :load-file [_ code]
+  (nrepl-send {:op "load-file", :file code
+               :file-path "path/to/file.clj", :file-name "file.clj"}))
+
 (defmacro def-debug-op [op]
   `(defmethod debugger-send ~op [_#]
      (nrepl-send {:op "debug-input" :input ~(str op) :key (current-key)})))
@@ -712,3 +716,20 @@
   (--> :continue-all)
   (<-- {:value "{:transport 23}"})
   (<-- {:status ["done"]}))
+
+(deftest load-file-enables-debugger-test
+  (--> :load-file ";; comments before form
+                   #_(redundant stuff)
+                   (defn foo [a b] #dbg (+ a b))")
+  (<-- {:value "#'user/foo"})
+  (<-- {:status ["done"]})
+
+  (--> :eval "(foo 4 5)")
+  (<-- {:debug-value "4" :coor [3 1]
+        :code "(defn foo [a b] #dbg (+ a b))"})
+  (--> :next)
+  (<-- {:debug-value "5" :coor [3 2]})
+  (--> :next)
+  (<-- {:debug-value "9" :coor [3]})
+  (--> :next)
+  (<-- {:value "9"}))

test/clj/cider/nrepl/middleware/debug_test.clj

@@ -208,12 +208,12 @@
                                          v)
                   d/debugger-message   (atom [:fake])
                   d/*skip-breaks*      (atom nil)]
-      (binding [*msg* {:session (atom {})
-                       :code    :code
-                       :id      :id
-                       :file    :file
-                       :line    :line
-                       :column  :column}]
+      (with-bindings {#'d/*top-level-form-meta*
+                      {::d/form-info {:code        :code
+                                      :file        :file
+                                      :original-id :id}
+                       :line         :line
+                       :column       :column}}
         (let [form `(d/with-initial-debug-bindings
                       (d/breakpoint-if-interesting (inc 10) {:coor [6]} ~'(inc 10)))
               m (eval form)]