clojure-emacs · vemv · Aug 20, 2023 · Aug 19, 2023 · Aug 20, 2023 · Aug 20, 2023
diff --git a/.circleci/config.yml b/.circleci/config.yml
@@ -16,7 +16,7 @@ defaults: &defaults
 executors:
   openjdk8:
     docker:
-      - image: circleci/clojure:openjdk-8-lein-2.9.5
+      - image: circleci/clojure:openjdk-8-lein-2.9.1-node
     environment:
       LEIN_ROOT: "true"   # we intended to run lein as root
       JVM_OPTS: -Xmx3200m # limit the maximum heap size to prevent out of memory errors
@@ -32,15 +32,15 @@ executors:
 
   openjdk11:
     docker:
-      - image: circleci/clojure:openjdk-11-lein-2.9.5
+      - image: circleci/clojure:openjdk-11-lein-2.9.3-buster-node
     environment:
       LEIN_ROOT: "true"   # we intended to run lein as root
       JVM_OPTS: -Xmx3200m --illegal-access=deny # forbid reflective access (this flag doesn't exist for JDK8 or JDK17+)
     <<: *defaults
 
   openjdk17:
     docker:
-      - image: circleci/clojure:openjdk-17-lein-2.9.5-buster
+      - image: circleci/clojure:openjdk-17-lein-2.9.5-buster-node
     environment:
       LEIN_ROOT: "true"   # we intended to run lein as root
       JVM_OPTS: -Xmx3200m
@@ -153,8 +153,11 @@ jobs:
           cache_version: << parameters.clojure_version >>|<< parameters.jdk_version >>
           steps:
             - run:
-                name: Running tests
+                name: Running JVM tests
                 command: make test
+            - run:
+                name: Running cljs tests
+                command: make test-cljs
 
 ######################################################################
 #

diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -5,6 +5,19 @@
 ## Changes
 
 * `analyzer`: include a `:phase` key for the causes that include a `:clojure.error/phase`.
+* Categorize more frames as `:tooling`
+  * `:tooling` now intends to more broadly hide things that are commonly Clojure-internal / irrelevant to the application programmer.
+  * New exhaustive list:
+    * `cider.*`
+    * `clojure.core/apply`
+    * `clojure.core/binding-conveyor-fn`
+    * `clojure.core/eval`
+    * `clojure.core/with-bindings`
+    * `clojure.lang.Compiler`
+    * `clojure.lang.RT`
+    * `clojure.main/repl`
+    * `nrepl.*`
+    * `java.lang.Thread/run` (if it's the root element of the stacktrace)
 
 ## 0.1.0
 

diff --git a/Makefile b/Makefile
@@ -8,8 +8,8 @@ clean:
 test: clean
 	lein with-profile -user,-dev,+$(VERSION) test
 
-test-cljs:
-	lein cljsbuild once
+test-cljs: clean
+	lein with-profile -user,-dev,+cljsbuild cljsbuild once
 	node target/cljs/test.js
 
 cljfmt:

diff --git a/README.org b/README.org
@@ -186,14 +186,6 @@ We get back a sequence of maps, one for each cause, which contain
 additional information about each frame discovered from the class path.
 
 ** Development
-*** Deployment
-
-Here's how to deploy to Clojars:
-
-#+begin_src sh
-git tag -a v0.1.0 -m "0.1.0"
-git push --tags
-#+end_src
 
 *** Creating a parser
 
@@ -255,6 +247,15 @@ for writing Instaparse grammars:
 - If your parser fails on an input, [[https://github.com/Engelberg/instaparse#revealing-hidden-information][reveal hidden information]] to get a
   better understanding of what happened.
 
+*** Deployment
+
+Here's how to deploy to Clojars:
+
+#+begin_src sh
+git tag -a v0.1.0 -m "0.1.0"
+git push --tags
+#+end_src
+
 ** Changelog
 
 [[CHANGELOG.md][CHANGELOG.md]]

diff --git a/project.clj b/project.clj
@@ -2,7 +2,7 @@
 ;; whenever we perform a deployment.
 (defproject mx.cider/haystack (or (not-empty (System/getenv "PROJECT_VERSION"))
                                   "0.0.0")
-  :description ""
+  :description "Let's make the most of Clojure's infamous stacktraces!"
   :url "https://github.com/clojure-emacs/haystack"
   :license {:name "Eclipse Public License"
             :url "https://www.eclipse.org/legal/epl-v10.html"}
@@ -16,15 +16,7 @@
                                     :username :env/clojars_username
                                     :password :env/clojars_password
                                     :sign-releases false}]]
-  :plugins [[lein-cljsbuild "1.1.8"]]
-  :cljsbuild {:builds
-              [{:id "test"
-                :compiler
-                {:main haystack.test.runner
-                 :output-dir "target/cljs/test"
-                 :output-to "target/cljs/test.js"
-                 :target :nodejs}
-                :source-paths ["src" "test"]}]}
+
   :profiles {:provided {:dependencies [[org.clojure/clojure "1.11.1"]
                                        [org.clojure/clojurescript "1.11.4"]]}
 
@@ -40,7 +32,16 @@
                                       "https://oss.sonatype.org/content/repositories/snapshots"]]
                       :dependencies [[org.clojure/clojure "1.12.0-master-SNAPSHOT"]
                                      [org.clojure/clojure "1.12.0-master-SNAPSHOT" :classifier "sources"]]}
-
+             :cljsbuild {:plugins   [[lein-cljsbuild "1.1.8"]]
+                         :dependencies [[lein-doo "0.1.11"]]
+                         :cljsbuild {:builds
+                                     [{:id "test"
+                                       :compiler
+                                       {:main haystack.test.runner
+                                        :output-dir "target/cljs/test"
+                                        :output-to "target/cljs/test.js"
+                                        :target :nodejs}
+                                       :source-paths ["src" "test"]}]}}
              :cljfmt [:test
                       {:plugins [[lein-cljfmt "0.9.0" :exclusions [org.clojure/clojure
                                                                    org.clojure/clojurescript]]]}]

diff --git a/src/haystack/analyzer.clj b/src/haystack/analyzer.clj
@@ -54,7 +54,7 @@
   (or (info/file-path path) (second (resource/resource-path-tuple path))))
 
 (defn- frame->url
-  "Return a java.net.URL to the file referenced in the frame, if possible.
+  "Return a `java.net.URL` to the file referenced in the frame, if possible.
   Useful for handling clojure vars which may not exist. Uncomprehensive list of
   reasons for this:
   * Failed refresh
@@ -120,17 +120,30 @@
     (flag-frame frame :repl)
     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")
+
+(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))))))
+
 (defn- flag-tooling
-  "Walk the call stack from top to bottom, flagging frames below the first call
-  to `clojure.lang.Compiler` or `nrepl.*` as `:tooling` to
-  distinguish compilation and nREPL middleware frames from user code."
+  "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 [tool-regex #"^clojure\.lang\.Compiler|^nrepl\.|^cider\."
-        tool? #(re-find tool-regex (or (:name %) ""))
-        flag  #(if (tool? %)
-                 (flag-frame % :tooling)
-                 %)]
-    (map flag 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)))
 
 (defn directory-namespaces
   "Looks for all namespaces inside of directories on the class
@@ -326,7 +339,7 @@
           (flag-tooling)))))
 
 (defn- analyze-cause
-  "Analyze the `cause-data` of an exception in `Throwable->map` format."
+  "Analyze the `cause-data` of an exception, in `Throwable->map` format."
   [cause-data print-fn]
   (let [pprint-str #(let [writer (StringWriter.)]
                       (print-fn % writer)
@@ -368,8 +381,8 @@
   "Return the analyzed cause chain for `exception` beginning with the
   thrown exception. `exception` can be an instance of `Throwable` or a
   map in the same format as `Throwable->map`. For `ex-info`
-  exceptions, the response contains a :data slot with the pretty
-  printed data. For clojure.spec asserts, the :spec slot contains a
+  exceptions, the response contains a `:data` slot with the pretty
+  printed data. For clojure.spec asserts, the `:spec` slot contains a
   map of pretty printed components describing spec failures."
   {:added "0.1.0"}
   ([exception]

diff --git a/test/haystack/analyzer_test.clj b/test/haystack/analyzer_test.clj
@@ -341,7 +341,7 @@
                     :class "clojure.lang.AFn"
                     :method "applyToHelper"
                     :type :java
-                    :flags #{:java}}
+                    :flags #{:java :tooling}}
                    (dissoc (first stacktrace) :file-url))))
           (testing "last frame"
             (is (= {:name "java.lang.Thread/run"
@@ -350,7 +350,7 @@
                     :class "java.lang.Thread"
                     :method "run"
                     :type :java
-                    :flags #{:java}}
+                    :flags #{:java :tooling}}
                    (dissoc (last stacktrace) :file-url)))))))
     (testing "second cause"
       (let [{:keys [class data message stacktrace]} (second causes)]
@@ -369,7 +369,7 @@
                     :class "clojure.lang.AFn"
                     :method "applyToHelper"
                     :type :java
-                    :flags #{:java}}
+                    :flags #{:java :tooling}}
                    (dissoc (first stacktrace) :file-url)))))))
     (testing "third cause"
       (let [{:keys [class data message stacktrace]} (nth causes 2)]
@@ -388,7 +388,7 @@
                     :class "clojure.lang.AFn"
                     :method "applyToHelper"
                     :type :java
-                    :flags #{:java}}
+                    :flags #{:java :tooling}}
                    (dissoc (first stacktrace) :file-url)))))))))
 
 (deftest test-analyze-short-clojure-tagged-literal-println
@@ -411,7 +411,7 @@
                     :class "java.lang.Thread"
                     :method "run"
                     :type :java
-                    :flags #{:java}}
+                    :flags #{:java :tooling}}
                    (dissoc (first stacktrace) :file-url)))))))))
 
 (deftest test-analyze-java
@@ -434,7 +434,7 @@
                     :class "clojure.lang.AFn"
                     :method "applyToHelper"
                     :type :java
-                    :flags #{:java}}
+                    :flags #{:java :tooling}}
                    (dissoc (first stacktrace) :file-url))))
           (testing "last frame"
             (is (= {:name "java.lang.Thread/run"
@@ -443,7 +443,7 @@
                     :class "java.lang.Thread"
                     :method "run"
                     :type :java
-                    :flags #{:java}}
+                    :flags #{:java :tooling}}
                    (dissoc (last stacktrace) :file-url)))))))
     (testing "second cause"
       (let [{:keys [class data message stacktrace]} (second causes)]
@@ -462,7 +462,7 @@
                     :class "clojure.lang.AFn"
                     :method "applyToHelper"
                     :type :java
-                    :flags #{:java}}
+                    :flags #{:java :tooling}}
                    (dissoc (first stacktrace) :file-url))))
           (testing "last frame"
             (is (= {:name "clojure.lang.Compiler$InvokeExpr/eval"
@@ -490,7 +490,7 @@
                     :class "clojure.lang.AFn"
                     :method "applyToHelper"
                     :type :java
-                    :flags #{:java}}
+                    :flags #{:java :tooling}}
                    (dissoc (first stacktrace) :file-url))))
           (testing "last frame"
             (is (= {:name "clojure.lang.Compiler$InvokeExpr/eval"
@@ -544,12 +544,12 @@
                     :class "clojure.lang.AFn"
                     :method "applyToHelper"
                     :type :java
-                    :flags #{:java}}
+                    :flags #{:java :tooling}}
                    (dissoc (nth stacktrace 0) :file-url))))
           (testing "2nd frame"
             (is (= {:class "clojure.lang.AFn"
                     :file "AFn.java"
-                    :flags #{:java}
+                    :flags #{:java :tooling}
                     :line 144
                     :method "applyTo"
                     :name "clojure.lang.AFn/applyTo"
@@ -572,7 +572,7 @@
                     :line 160
                     :method "applyToHelper"
                     :type :java
-                    :flags #{:java}}
+                    :flags #{:java :tooling}}
                    (dissoc (nth stacktrace 0) :file-url)))))))
     (testing "third cause"
       (let [{:keys [class data message stacktrace]} (nth causes 2 nil)]
@@ -591,7 +591,7 @@
                     :line 156
                     :method "applyToHelper"
                     :type :java
-                    :flags #{:java}}
+                    :flags #{:java :tooling}}
                    (dissoc (nth stacktrace 0) :file-url))))))))
 
   (let [{:keys [major minor]} *clojure-version*]
@@ -604,3 +604,49 @@
                       (catch Throwable e
                         (sut/analyze e)))
                     (map :phase))))))))
+
+(deftest tooling-frame-name?
+  (are [frame-name expected] (testing frame-name
+                               (is (= expected
+                                      (#'sut/tooling-frame-name? frame-name false)))
+                               true)
+    "cider.foo"                                                 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/eval"                                         true
+    "clojure.core/with-bindings*"                               true
+    "clojure.lang.AFn/applyTo"                                  true
+    "clojure.lang.AFn/applyToHelper"                            true
+    "clojure.lang.RestFn/invoke"                                true
+    "clojure.main/repl"                                         true
+    "clojure.main$repl$read_eval_print__9234$fn__9235/invoke"   true
+    "nrepl.foo"                                                 true
+    "nrepl.middleware.interruptible_eval$evaluate/invokeStatic" true
+    "anrepl.foo"                                                false
+    ;; important case - `Numbers` is relevant, should not be hidden:
+    "clojure.lang.Numbers/divide"                               false)
+
+  (is (not (#'sut/tooling-frame-name? "java.lang.Thread/run" false)))
+  (is (#'sut/tooling-frame-name? "java.lang.Thread/run" true)))
+
+(deftest flag-tooling
+  (is (= [{:name "cider.foo", :flags #{:tooling}}
+          {:name "java.lang.Thread/run"} ;; does not get the flag because it's not the root frame
+          {:name "don't touch me 1"}
+          {: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:
+          {:name "java.lang.Thread/run", :flags #{:tooling}}]
+         (#'sut/flag-tooling [{:name "cider.foo"}
+                              {:name "java.lang.Thread/run"}
+                              {:name "don't touch me 1"}
+                              {:name "nrepl.foo"}
+                              {: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"))
diff --git a/test/haystack/parser/clojure/repl_test.cljc b/test/haystack/parser/clojure/repl_test.cljc
@@ -113,7 +113,7 @@
               :reason
               #?(:clj [{:tag :regexp :expecting "[a-zA-Z0-9_$/-]"}
                        {:tag :regexp :expecting "[^\\S\\r\\n]+"}]
-                 :cljs [{:tag :regexp, :expecting "/^[a-zA-Z0-9_$\\/-]/"}
+                 :cljs [{:tag :regexp, :expecting "/^[a-zA-Z0-9_$/-]/"}
                         {:tag :regexp, :expecting "/^[^\\S\\r\\n]+/"}])
               :line 1
               :column 1

diff --git a/test/haystack/parser/clojure/stacktrace_test.cljc b/test/haystack/parser/clojure/stacktrace_test.cljc
@@ -115,7 +115,7 @@
               :reason
               #?(:clj [{:tag :regexp :expecting "[a-zA-Z0-9_$/-]"}
                        {:tag :regexp :expecting "[^\\S\\r\\n]+"}]
-                 :cljs [{:tag :regexp, :expecting "/^[a-zA-Z0-9_$\\/-]/"}
+                 :cljs [{:tag :regexp, :expecting "/^[a-zA-Z0-9_$/-]/"}
                         {:tag :regexp, :expecting "/^[^\\S\\r\\n]+/"}])
               :line 1
               :column 1