[stacktrace] Add ex-str-formatted message to analyzed causes

CHANGELOG.md

@@ -2,6 +2,8 @@
 
 ## master (unreleased)
 
+* [#325](https://github.com/clojure-emacs/orchard/pull/325): Add `ex-str`-formatted message to analyzed causes.
+
 ## 0.31.0 (2025-03-14)
 
 * [#317](https://github.com/clojure-emacs/orchard/pull/317): **BREAKING:** Remove deprecated functions:

src/orchard/misc.clj

@@ -1,6 +1,6 @@
 (ns orchard.misc
   ;; These will be added in clojure 1.11:
-  (:refer-clojure :exclude [update-keys update-vals])
+  (:refer-clojure :exclude [update-keys update-vals pmap])
   (:require
    [clojure.java.io :as io]
    [clojure.string :as str]
@@ -101,6 +101,11 @@
               (last xs)))]
     (apply f (filter identity xs))))
 
+(defn assoc-some
+  "Assoc key-value to the map `m` if `v` is non-nil."
+  [m k v]
+  (if (nil? v) m (assoc m k v)))
+
 (defn parse-java-version
   "Parse a Java version string according to JEP 223 and return the appropriate
   version."
@@ -156,3 +161,22 @@
     (fn [& args]
       (when resolved-fn
         (apply resolved-fn args)))))
+
+(defn- into! [transient-coll1 transient-coll2]
+  (reduce conj! transient-coll1 (persistent! transient-coll2)))
+
+(defn pmap
+  "Like `clojure.core/pmap`, but uses parallel streams for better efficiency."
+  [f, ^java.util.Collection coll]
+  (-> (.parallelStream coll)
+      (.map (reify java.util.function.Function
+              (apply [_ x] (f x))))
+      (.collect (reify java.util.function.Supplier
+                  (get [_] (volatile! (transient []))))
+                (reify java.util.function.BiConsumer
+                  (accept [_ acc x] (vswap! acc conj! x)))
+                (reify java.util.function.BiConsumer
+                  (accept [_ acc1 acc2]
+                    (vswap! acc1 into! @acc2))))
+      deref
+      persistent!))

src/orchard/stacktrace.clj

@@ -3,26 +3,27 @@
   objects and attach extra data to them."
   {:added "0.31"
    :author "Jeff Valk, Oleksandr Yakushev"}
+  (:refer-clojure :exclude [print-str])
   (:require
    [clojure.java.io :as io]
-   [clojure.pprint :as pp]
+   [clojure.main]
    [clojure.repl :as repl]
    [clojure.spec.alpha :as s]
    [clojure.string :as str]
    [orchard.info :as info]
-   [orchard.java.resource :as resource])
+   [orchard.java.resource :as resource]
+   [orchard.misc :as misc :refer [assoc-some]]
+   [orchard.print :as print])
   (:import
-   (java.io StringWriter)
    (java.net URL)
    (java.nio.file Path)))
 
 (def ^:private ^Path cwd-path (.toAbsolutePath (.toPath (io/file ""))))
 
-(defn- pprint-write
-  "We don't use `clojure.pprint/pprint` directly because it appends a newline at
-  the end which we don't want."
-  [value writer]
-  (pp/write value :stream writer))
+(defn- print-str [value]
+  ;; Limit printed collections to 5 items.
+  (binding [*print-length* 5]
+    (print/print-str value)))
 
 ;;; ## Stacktraces
 
@@ -166,14 +167,15 @@
     (if (< i 0)
       frames
       (let [frame-name (:name (get frames i))
-            tooling? (or (tooling-frame-name? frame-name)
-                         ;; Everything runs from a Thread, so this frame, if at
-                         ;; the end, is irrelevant. However one can invoke this
-                         ;; method 'by hand', which is why we only skip
-                         ;; consecutive frames that match this.
-                         (and all-tooling-so-far?
-                              (re-find #"^java\.lang\.Thread/run|^java\.util\.concurrent"
-                                       frame-name)))]
+            tooling? (and frame-name
+                          (or (tooling-frame-name? frame-name)
+                              ;; Everything runs from a Thread, so this frame,
+                              ;; if at the end, is irrelevant. However one can
+                              ;; invoke this method 'by hand', which is why we
+                              ;; only skip consecutive frames that match this.
+                              (and all-tooling-so-far?
+                                   (re-find #"^java\.lang\.Thread/run|^java\.util\.concurrent"
+                                            frame-name))))]
         (recur (cond-> frames
                  tooling? (update i flag-frame :tooling))
                (dec i) (and all-tooling-so-far? tooling?))))))
@@ -218,18 +220,18 @@
 
 (defn- prepare-spec-data
   "Prepare spec problems for display in user stacktraces. Take in a map `ed` as
-  returned by `clojure.spec.alpha/explain-data` and return a map of pretty
-  printed problems. The content of the returned map is modeled after
+  returned by `clojure.spec.alpha/explain-data` and return a map of printed
+  problems. The content of the returned map is modeled after
   `clojure.spec.alpha/explain-printer`."
-  [ed pprint-str]
+  [ed]
   (let [problems (sort-by #(count (:path %)) (::s/problems ed))]
     {:spec (pr-str (::s/spec ed))
-     :value (pprint-str (::s/value ed))
+     :value (print-str (::s/value ed))
      :problems
      (mapv
       (fn [{:keys [in val pred reason via path] :as prob}]
-        (->> {:in (some-> in not-empty pr-str)
-              :val (pprint-str val)
+        (->> {:in (some-> in not-empty print-str)
+              :val (print-str val)
               :predicate (pr-str (s/abbrev pred))
               :reason reason
               :spec (some-> via not-empty last pr-str)
@@ -240,7 +242,7 @@
                                              ::s/failure} (key %)))
                                  prob)]
                 (when (seq extras)
-                  (pprint-str extras)))}
+                  (print-str extras)))}
              (filter clojure.core/val)
              (into {})))
       problems)}))
@@ -249,58 +251,67 @@
   "Return the stacktrace as a sequence of maps, each describing a stack frame."
   [trace]
   (when (seq trace)
-    (-> (pmap analyze-frame trace)
+    (-> (misc/pmap analyze-frame trace)
         (flag-duplicates)
         (flag-tooling))))
 
 (defn- analyze-cause
   "Analyze the `cause-data` of an exception, in `Throwable->map` format."
-  [cause-data print-fn]
-  (let [pprint-str #(let [writer (StringWriter.)]
-                      (print-fn % writer)
-                      (str writer))
-        phase (-> cause-data :data :clojure.error/phase)
-        m {:class (name (:type cause-data))
-           :phase phase
-           :message (:message cause-data)
-           :stacktrace (analyze-stacktrace-data
-                        (cond (seq (:trace cause-data)) (:trace cause-data)
-                              (:at cause-data) [(:at cause-data)]))}]
+  [cause-data]
+  (let [phase (-> cause-data :data :clojure.error/phase)
+        m (-> {:class (name (:type cause-data))
+               :phase phase
+               :message (:message cause-data)
+               :stacktrace (analyze-stacktrace-data
+                            (cond (seq (:trace cause-data)) (:trace cause-data)
+                                  (:at cause-data) [(:at cause-data)]))}
+              (assoc-some :triage (:triage cause-data)))]
     (if-let [data (filter-ex-data (:data cause-data))]
       (if (::s/failure data)
         (assoc m
                :message "Spec assertion failed."
-               :spec (prepare-spec-data data pprint-str))
+               :spec (prepare-spec-data data))
         (assoc m
-               :data (pprint-str data)
+               :data (print-str data)
                :location (select-keys data [:clojure.error/line
                                             :clojure.error/column
                                             :clojure.error/phase
                                             :clojure.error/source
                                             :clojure.error/symbol])))
       m)))
 
+(defn- maybe-triage-message
+  "If the exception is a compiler error which carries Spec-based explanation data,
+  transform it into human readable error message string."
+  [exception-data]
+  (try
+    ;; ex-triage may throw an exception if :phase is incorrect
+    (when-let [explanation-data (:clojure.error/spec
+                                 (clojure.main/ex-triage exception-data))]
+      (with-out-str (s/explain-out explanation-data)))
+    (catch Exception _)))
+
 (defn- analyze-causes
   "Analyze the cause chain of the `exception-data` in `Throwable->map` format."
-  [exception-data print-fn]
-  (let [causes (vec (:via exception-data))
-        ;; If the first cause lacks :trace, add :trace of the exception there.
-        causes (if (:trace (first causes))
-                 causes
-                 (assoc-in causes [0 :trace] (:trace exception-data)))]
-    (mapv #(extract-location (analyze-cause % print-fn)) causes)))
+  [exception-data]
+  (let [triage-message (maybe-triage-message exception-data)
+        causes (update (vec (:via exception-data)) 0
+                       #(cond-> %
+                          ;; If the first cause lacks :trace, add :trace of the
+                          ;; exception there.
+                          (nil? (:trace %)) (assoc :trace (:trace exception-data))
+                          ;; If non-nil, assoc triage-message to first cause.
+                          triage-message (assoc :triage triage-message)))]
+    (mapv #(extract-location (analyze-cause %)) causes)))
 
 (defn analyze
-  "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
-  map of pretty printed components describing spec failures."
-  ([exception]
-   (analyze exception pprint-write))
-  ([exception print-fn]
-   (cond (instance? Throwable exception)
-         (analyze-causes (Throwable->map-with-traces exception) print-fn)
-         (and (map? exception) (:trace exception))
-         (analyze-causes exception print-fn))))
+  "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 printed data. For clojure.spec asserts, the `:spec` slot
+  contains a map of printed components describing spec failures."
+  [exception]
+  (cond (instance? Throwable exception)
+        (analyze-causes (Throwable->map-with-traces exception))
+        (and (map? exception) (:trace exception))
+        (analyze-causes exception)))

test/orchard/stacktrace_test.clj

@@ -1,6 +1,7 @@
 (ns orchard.stacktrace-test
   (:require
    [clojure.spec.alpha :as s]
+   [clojure.string :as str]
    [clojure.test :refer [are deftest is testing]]
    [matcher-combinators.matchers :as matchers]
    [orchard.stacktrace :as sut]))
@@ -180,6 +181,11 @@
               :clojure.error/symbol 'clojure.core/let}
              (:location cause))))))
 
+(deftest ex-triage-test
+  (testing "compilation errors that can be triaged contain :triage message"
+    (is (= "[a] - failed: even-number-of-forms? in: [0] at: [:bindings] spec: :clojure.core.specs.alpha/bindings"
+           (str/trim (:triage (first (catch-and-analyze (eval '(let [a]))))))))))
+
 (deftest test-analyze-throwable
   (testing "shape of analyzed throwable"
     (is (match?