diff --git a/CHANGELOG.md b/CHANGELOG.md index 8ed1f2d9..778a42cc 100644 --- a/CHANGELOG.md +++ b/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: diff --git a/src/orchard/misc.clj b/src/orchard/misc.clj index fa3cb3fd..90d5d660 100644 --- a/src/orchard/misc.clj +++ b/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!)) diff --git a/src/orchard/stacktrace.clj b/src/orchard/stacktrace.clj index 52e163b6..8c7fd647 100644 --- a/src/orchard/stacktrace.clj +++ b/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,30 +251,28 @@ "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 @@ -280,27 +280,38 @@ :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))) diff --git a/test/orchard/stacktrace_test.clj b/test/orchard/stacktrace_test.clj index c0664d35..037900df 100644 --- a/test/orchard/stacktrace_test.clj +++ b/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?