Expand the set of frames considered as :tooling

Fixes #13

CHANGELOG.md

@@ -6,6 +6,7 @@
   * It represents exceptions that happen at runtime (and therefore never include a `:phase`) which however, represent code that cannot possibly work, and therefore are a "compile-like" exception (i.e. a linter could have caught them).
   * The set of conditions which are considered a 'compile-like' exception is private and subject to change. 
 * Use Orchard [0.15.1](https://github.com/clojure-emacs/orchard/blob/v0.15.1/CHANGELOG.md#0151-2023-09-21).
+* [#13](https://github.com/clojure-emacs/haystack/issues/13): Expand the set of frames considered as `:tooling`. 
 
 ## 0.2.0 (2023-08-20)
 

src/haystack/analyzer.clj

@@ -121,29 +121,38 @@
     frame))
 
 (def ^:private tooling-frame-re
-  #"^clojure\.lang\.AFn|^clojure\.lang\.RestFn|^clojure\.lang\.RT|clojure\.lang\.Compiler|^nrepl\.|^cider\.|^clojure\.core/eval|^clojure\.core/apply|^clojure\.core/with-bindings|^clojure\.core/binding-conveyor-fn|^clojure\.main/repl")
+  #"^clojure\.lang\.LazySeq|^clojure\.lang\.Var|^clojure\.lang\.MultiFn|^clojure\.lang\.AFn|^clojure\.lang\.RestFn|^clojure\.lang\.RT|clojure\.lang\.Compiler|^nrepl\.|^cider\.|^refactor-nrepl\.|^shadow.cljs\.|^clojure\.core/eval|^clojure\.core/apply|^clojure\.core/with-bindings|^clojure\.core\.protocols|^clojure\.core\.map/fn|^clojure\.core/binding-conveyor-fn|^clojure\.main/repl")
 
 (defn- tooling-frame-name? [frame-name last?]
   (let [demunged (repl/demunge frame-name)]
     (boolean (or (re-find tooling-frame-re demunged)
                  (and last?
                       ;; Everything runs from a Thread, so this frame, if at root, is irrelevant.
                       ;; However one can invoke this method 'by hand', which is why we also observe `last?`.
-                      (re-find #"^java\.lang\.Thread/run" demunged))))))
+                      (re-find #"^java\.lang\.Thread/run|^java\.util\.concurrent" demunged))))))
 
 (defn- flag-tooling
   "Given a collection of stack `frames`, marks the 'tooling' ones as such.
 
   A 'tooling' frame is one that generally represents Clojure, JVM, nREPL or CIDER internals,
   and that is therefore not relevant to application-level code."
   [frames]
-  (let [last-index (dec (count frames))]
-    (into []
-          (map-indexed (fn [i {frame-name :name :as frame}]
-                         (cond-> frame
-                           (some-> frame-name (tooling-frame-name? (= i last-index)))
-                           (flag-frame :tooling))))
-          frames)))
+  (let [results (volatile! {})]
+    (->> frames
+         reverse
+         (into []
+               (map-indexed (fn [^long i {frame-name :name :as frame}]
+                              (let [;; A frame is considered the last if it's literally the last one,
+                                    ;; or if the previous element was marked as tooling.
+                                    last? (or (zero? i)
+                                              (some-> @results (get (dec i))))
+                                    tooling? (some-> frame-name (tooling-frame-name? last?))]
+                                (vswap! results assoc i tooling?)
+                                (cond-> frame
+                                  tooling?
+                                  (flag-frame :tooling))))))
+         reverse
+         vec)))
 
 (defn directory-namespaces
   "Looks for all namespaces inside of directories on the class

test/haystack/analyzer_test.clj

@@ -656,14 +656,20 @@
                                       (#'sut/tooling-frame-name? frame-name false)))
                                true)
     "cider.foo"                                                 true
+    "refactor-nrepl.middleware/wrap-refactor"                   true
+    "shadow.cljs.devtools.server.nrepl/shadow-inint"            true
     "acider.foo"                                                false
     ;; `+` is "application" level, should not be hidden:
     "clojure.core/+"                                            false
     ;; `apply` typically is internal, should be hidden:
     "clojure.core/apply"                                        true
     "clojure.core/binding-conveyor-fn/fn"                       true
+    "clojure.core.protocols/iter-reduce"                        true
     "clojure.core/eval"                                         true
     "clojure.core/with-bindings*"                               true
+    "clojure.lang.MultiFn/invoke"                               true
+    "clojure.lang.LazySeq/sval"                                 true
+    "clojure.lang.Var/invoke"                                   true
     "clojure.lang.AFn/applyTo"                                  true
     "clojure.lang.AFn/applyToHelper"                            true
     "clojure.lang.RestFn/invoke"                                true
@@ -685,7 +691,7 @@
           {:name "nrepl.foo", :flags #{:tooling}}
           {:name "clojure.lang.RestFn/invoke", :flags #{:tooling}}
           {:name "don't touch me 2"}
-          ;; gets the flag because it's not the root frame:
+          ;; gets the flag because it's the root frame:
           {:name "java.lang.Thread/run", :flags #{:tooling}}]
          (#'sut/flag-tooling [{:name "cider.foo"}
                               {:name "java.lang.Thread/run"}
@@ -694,4 +700,22 @@
                               {:name "clojure.lang.RestFn/invoke"}
                               {:name "don't touch me 2"}
                               {:name "java.lang.Thread/run"}]))
-      "Adds the flag when appropiate, leaving other entries untouched"))
+      "Adds the flag when appropiate, leaving other entries untouched")
+
+  (let [frames [{:name "don't touch me"}
+                {:name "java.util.concurrent.FutureTask/run"}
+                {:name "java.util.concurrent.ThreadPoolExecutor/runWorker"}
+                {:name "java.util.concurrent.ThreadPoolExecutor$Worker/run"}]]
+    (is (= [{:name "don't touch me"}
+            {:name "java.util.concurrent.FutureTask/run", :flags #{:tooling}}
+            {:name "java.util.concurrent.ThreadPoolExecutor/runWorker", :flags #{:tooling}}
+            {:name "java.util.concurrent.ThreadPoolExecutor$Worker/run", :flags #{:tooling}}]
+           (#'sut/flag-tooling frames))
+        "Three j.u.concurrent frames get the flag if they're at the bottom")
+    (is (= [{:name "don't touch me"}
+            {:name "java.util.concurrent.FutureTask/run"}
+            {:name "java.util.concurrent.ThreadPoolExecutor/runWorker"}
+            {:name "java.util.concurrent.ThreadPoolExecutor$Worker/run"}
+            {:name "x"}]
+           (#'sut/flag-tooling (conj frames {:name "x"})))
+        "The j.u.concurrent frames don't get the flag if they're not at the bottom")))