Rewrite the debugger

README.md

@@ -99,7 +99,7 @@ Middleware        | Op(s)      | Description
 `wrap-apropos`    | `apropos`  | Pattern search for symbols and documentation.
 `wrap-classpath`  | `classpath` | Java classpath.
 `wrap-complete`   | `complete` | Simple completion. Supports both Clojure & ClojureScript.
-`wrap-debug`      | `init-debugger` | Establish a channel for `cider-debug` commands.
+`wrap-debug`      | `init-debugger/debug-input` | Establish a channel for `cider-debug` commands, use it to get debug input, and also wrap the eval op.
 `wrap-format`     | `format-(code/edn)` | Code and data formatting.
 `wrap-info`       | `info/eldoc` | File/line, arglists, docstrings and other metadata for vars.
 `wrap-inspect`    |`inspect-(start/refresh/pop/push/reset)` | Inspect a Clojure expression.

src/cider/nrepl/middleware/debug.clj

@@ -5,9 +5,18 @@
             [clojure.tools.nrepl.middleware :refer [set-descriptor!]]
             [clojure.tools.nrepl.misc :refer [response-for]]
             [clojure.tools.nrepl.middleware.interruptible-eval :refer [*msg*]]
-            [cider.nrepl.middleware.util.instrument :refer [instrument]])
+            [cider.nrepl.middleware.util.instrument :as ins]
+            [cider.nrepl.middleware.util.cljs :as cljs]
+            [clojure.walk :as walk])
   (:import [clojure.lang Compiler$LocalBinding]))
 
+(defn random-uuid-str []
+  (letfn [(hex [] (format "%x" (rand-int 15)))
+          (nhex [n] (apply str (repeatedly n hex)))]
+    (let [rhex (format "%x" (bit-or 0x8 (bit-and 0x3 (rand-int 14))))]
+      (str (nhex 8) "-" (nhex 4) "-4" (nhex 3)
+        "-" rhex (nhex 3) "-" (nhex 12)))))
+
 ;;;; # The Debugger
 ;;; The debugger is divided into two parts, intrument.clj and
 ;;; debug.clj.
@@ -63,7 +72,7 @@
        (and (= sb parent)
             (> (count coordinates) (count parent)))))))
 
-(defn- skip-breaks!
+(defn skip-breaks!
   "Set the value of *skip-breaks* in the session binding map."
   [bool-or-vec]
   (swap! (:session *msg*) assoc #'*skip-breaks* bool-or-vec))
@@ -72,6 +81,8 @@
   "Stop current eval thread.
   This does not quit the repl, it only interrupts an eval operation."
   []
+  (transport/send (:transport *msg*) (response-for *msg* :value 'QUIT))
+  (transport/send (:transport *msg*) (response-for *msg* :status :done))
   (.stop (:thread (meta (:session *msg*)))))
 
 ;;; Politely borrowed from clj-debugger.
@@ -92,7 +103,7 @@
   for debug input through the :need-debug-input status."
   (atom nil))
 
-(def debugger-input
+(def promises
   "Map atom holding all unprocessed debug inputs.
   This is where the \"debug\" op stores replies received for debug
   input requests. `read-debug` will halt until it finds its input in
@@ -109,14 +120,15 @@
   autogenerated by a macro, and turning keys and values to strings."
   [m]
   (map (partial map pr-str)
-       (remove (fn [[k]] (re-find  #"__" (name k)))
-               m)))
+       (remove (fn [[k]] (re-find  #"_" (name k))) m)))
 
 (defn- read-debug
   "Like `read`, but reply is sent through `debugger-message`.
   type is sent in the message as :input-type."
   [extras type prompt]
-  (let [key (str (java.util.UUID/randomUUID))]
+  (let [key (random-uuid-str)
+        input (promise)]
+    (swap! promises assoc key input)
     (->> (assoc extras
                 :status :need-debug-input
                 :locals (locals-for-message *locals*)
@@ -125,11 +137,7 @@
                 :input-type type)
          (response-for @debugger-message)
          (transport/send (:transport @debugger-message)))
-    (while (not (@debugger-input key))
-      (java.lang.Thread/sleep 100))
-    (let [input (@debugger-input key)]
-      (swap! debugger-input dissoc key)
-      input)))
+    @input))
 
 (defn- eval-with-locals
   "`eval` form wrapped in a let of the *locals* map."
@@ -145,86 +153,133 @@
   [prompt extras]
   (eval-with-locals (read-debug extras :expression prompt)))
 
-(def commands
-  "Vector of defined debug commands."
-  [:next :continue :out :inject :eval :quit])
-
-(def commands-prompt
-  "Vector of defined debug commands."
-  "(n)ext (c)ontinue (o)ut (i)nject (e)val (q)uit")
-
 (defn read-debug-command
   "Read and take action on a debugging command.
   Ask for one of the following debug commands using `read-debug`:
 
-  next: Return value.
-  continue: Skip breakpoints for the remainder of this eval session.
-  out: Skip breakpoints in the current sexp.
-  inject: Evaluate an expression and return it.
-  eval: Evaluate an expression, display result, and prompt again.
-  quit: Abort current eval session."
+    next: Return value.
+    continue: Skip breakpoints for the remainder of this eval session.
+    out: Skip breakpoints in the current sexp.
+    inject: Evaluate an expression and return it.
+    eval: Evaluate an expression, display result, and prompt again.
+    quit: Abort current eval session."
   [value extras]
-  (case (read-debug extras commands commands-prompt)
-    :next     value
-    :continue (do (skip-breaks! true) value)
-    :out      (do (skip-breaks! (butlast (:coor extras))) value)
-    :inject   (read-debug-eval-expression "Expression to inject: " extras)
-    :eval     (let [return (read-debug-eval-expression "Expression to evaluate: " extras)]
-                (read-debug-command value (assoc extras :debug-value (pr-str return))))
-    :quit     (abort!)))
+  (let [commands (if (cljs/grab-cljs-env *msg*)
+                   [:next :continue :out :inject :eval :quit]
+                   [:next :continue :out :inject :eval :quit])
+        prompt (apply str (map #(let [[f & r] (name %)]
+                                  (apply str " (" f ")" r))
+                               commands))]
+    (case (read-debug extras commands prompt)
+      :next     value
+      :continue (do (skip-breaks! true) value)
+      :out      (do (skip-breaks! (butlast (:coor extras))) value)
+      :inject   (read-debug-eval-expression "Expression to inject: " extras)
+      :eval     (let [return (read-debug-eval-expression "Expression to evaluate: " extras)]
+                  (read-debug-command value (assoc extras :debug-value (pr-str return))))
+      :quit     (abort!))))
 
 ;;; ## High-level functions
 (defmacro breakpoint
   "Send value and coordinates to the client through the debug channel.
   Sends a response to the message stored in debugger-message."
-  [value extras]
+  [value coor]
   `(binding [*locals* ~(sanitize-env &env)]
-     (let [val# ~value
-           ex#  ~extras]
-       (if (skip-breaks? (:coor ex#))
-         val#
-         (read-debug-command val#
-                             (assoc ex#
-                                    :debug-value (pr-str val#)
-                                    :breakfunction nil))))))
-
-(defn instrument-and-eval
-  "Instrument form and evaluate the result.
-  Call cider.nrepl.middleware.util.instrument."
-  [ex form]
-  (eval
-   (instrument (merge {:coor [], :breakfunction #'breakpoint} ex)
-               form)))
+     (let [val# ~value]
+       (cond
+         (skip-breaks? ~coor) val#
+         (not (seq @debugger-message)) (do (println "Debugger not initialized")
+                                           (skip-breaks! true)
+                                           val#)
+         :else (read-debug-command
+                val#
+                ;; This *msg* is evaluated at compile-time, so it's
+                ;; the message that instrumented the function, not the
+                ;; message that led to its evaluation.
+                (assoc ~(let [{:keys [code id file point]} *msg*]
+                          {:code code, :original-id id, :coor coor
+                           :file file, :point point})
+                       :debug-value (pr-str val#)))))))
+
+;;; Data readers
+(defn breakpoint-reader
+  "#break reader. Mark `form` for breakpointing."
+  [form]
+  (ins/with-meta-safe form {:cider-breakfunction #'breakpoint}))
+
+(defn debug-reader
+  "#dbg reader. Mark all forms in `form` for breakpointing.
+  `form` itself is also marked."
+  [form]
+  (walk/postwalk breakpoint-reader form))
+
+(defn instrument-and-eval [form]
+  (eval (ins/instrument-tagged-code form)))
+
+;;; Middleware setup
+(defn- maybe-debug
+  "Return msg, prepared for debugging if code contains debugging macros."
+  [{:keys [code session] :as msg}]
+  (when (instance? clojure.lang.Atom session)
+    (swap! session update-in [#'*data-readers*] assoc
+           'dbg #'debug-reader 'bp  #'breakpoint-reader))
+  ;; The best way of checking if there's a #break reader-macro in
+  ;; `code` is by reading it, in which case it toggles `has-debug?`.
+  (let [has-debug? (atom false)
+        fake-reader (fn [x] (reset! has-debug? true) nil)]
+    (binding [*data-readers* {'dbg fake-reader, 'bp fake-reader}]
+      (try
+        (read-string code)
+        (catch Exception e))
+      (if @has-debug?
+        ;; Technically, `instrument-and-eval` acts like a regular eval
+        ;; if there are no debugging macros. But we still only use it
+        ;; when we know it's necessary.
+        (assoc msg :eval "cider.nrepl.middleware.debug/instrument-and-eval")
+        ;; If there was no reader macro, fallback on regular eval.
+        msg))))
+
+(defn- initialize
+  "Initialize the channel used for debug-input requests."
+  [msg]
+  (when-let [stored-message @debugger-message]
+    (transport/send (:transport stored-message)
+                    (response-for stored-message :status :done)))
+  ;; The above is just bureaucracy. The below is important.
+  (reset! debugger-message msg))
 
-;;; ## The middleware definition
 (defn wrap-debug [h]
-  (fn [{:keys [op input force] :as msg}]
+  (fn [{:keys [op input] :as msg}]
     (case op
-      "debug-input"
-      (do (swap! debugger-input assoc (:key msg) (read-string input))
-          (transport/send (:transport msg) (response-for msg :status :done)))
-      "init-debugger"
-      (let [stored-message @debugger-message]
-        (if (and stored-message (not force))
-          (transport/send (:transport msg)
-                          (response-for msg :status :done))
-          (do (when stored-message
-                (transport/send (:transport stored-message)
-                                (response-for stored-message :status :done)))
-              (reset! debugger-message msg))))
+      "eval" (h (maybe-debug msg))
+      "debug-input" (when-let [pro (@promises (:key msg))]
+                      (swap! promises dissoc  (:key msg))
+                      (deliver pro (read-string input))
+                      (transport/send (:transport msg)
+                                      (response-for msg :status :done)))
+      "init-debugger" (initialize msg)
       ;; else
       (h msg))))
 
 (set-descriptor!
  #'wrap-debug
- {:handles
-  {"debug-input"
-   {:doc "Read client input on debug action."
-    :requires {"input" "The user's reply to the input request."}
-    :returns {"status" "done"}}
-   "init-debugger"
-   {:doc "Initialize the debugger so that `breakpoint` works correctly.
+ (cljs/requires-piggieback
+  {:expects #{"eval"}
+   :handles
+   {"debug-input"
+    {:doc "Read client input on debug action."
+     :requires {"input" "The user's reply to the input request."}
+     :returns {"status" "done"}}
+    "init-debugger"
+    {:doc "Initialize the debugger so that `breakpoint` works correctly.
 This usually does not respond immediately. It sends a response when a
 breakpoint is reached or when the message is discarded."
-    :requires {"id" "A message id that will be responded to when a breakpoint is reached."}
-    :returns {"status" "\"done\" if the message will no longer be used, or \"need-debug-input\" during debugging sessions"}}}})
+     :requires {"id" "A message id that will be responded to when a breakpoint is reached."}}
+    "debug-middleware"
+    {:doc "Debug a code form or fall back on regular eval."
+     :requires {"id" "A message id that will be responded to when a breakpoint is reached."
+                "code" "Code to debug, there must be a #dbg or a #break reader macro in it, or nothing will happen."
+                "file" "File where the code is located."
+                "ns" "Passed to \"eval\"."
+                "point" "Position in the file where the provided code begins."}
+     :returns {"status" "\"done\" if the message will no longer be used, or \"need-debug-input\" during debugging sessions"}}}}))