wip [skip ci]

This commit is contained in:
Michiel Borkent 2023-03-11 21:26:17 +01:00
parent 7aba75564e
commit a1a53fcc65
2 changed files with 22 additions and 13 deletions

2
sci

@ -1 +1 @@
Subproject commit 8d9f1d2e29b5d359f92b976d45786f7d5e415468 Subproject commit 617bf809d1810b48cab24980864b85249c2a9d8b

View file

@ -96,24 +96,33 @@
(defn render-native-stacktrace-elem [[sym _ _file _line]] (defn render-native-stacktrace-elem [[sym _ _file _line]]
(render-native-sym sym)) (render-native-sym sym))
(defn error-handler [^Exception e opts] (defn via [^Throwable t]
(loop [via [], ^Throwable t t]
(if t
(recur (conj via t) (.getCause t))
via)))
(defn error-handler [^Throwable e opts]
(binding [*out* *err*] (binding [*out* *err*]
(let [d (ex-data e) (let [via-exs (reverse (via e))
cause-exit (some-> e ex-cause ex-data :babashka/exit) ^Throwable root (first via-exs)
exit-code (or (:babashka/exit d) cause-exit) d (ex-data e)
dr (ex-data root)
exit-code (or (:babashka/exit d) (:babashka/exit dr))
sci-error? (isa? (:type d) :sci/error) sci-error? (isa? (:type d) :sci/error)
ex-name (when sci-error? ex-name (when sci-error? (some-> root .getClass .getName))
(some-> ^Throwable (ex-cause e) _ (prn :exes (mapcat sci/stacktrace via-exs))
.getClass .getName))
stacktrace (dedupe stacktrace (dedupe
(concat (sequence (comp (map StackTraceElement->vec) (concat (sequence (comp (map StackTraceElement->vec)
(take-while #(not (str/starts-with? (first %) "sci.impl."))) (take-while #(not (str/starts-with? (first %) "sci.impl.")))
(keep render-native-stacktrace-elem)) (keep render-native-stacktrace-elem))
(.getStackTrace (or (ex-cause e) e))) (.getStackTrace root))
(sci/stacktrace e)))] (mapcat sci/stacktrace via-exs)))
;; _ (clojure.pprint/pprint stacktrace)
ex-m (ex-message root)]
(if exit-code (if exit-code
(do (do
(when-let [m (.getMessage e)] (when-let [m ex-m]
(println m)) (println m))
[nil exit-code]) [nil exit-code])
(do (do
@ -121,9 +130,9 @@
(println "Type: " (or (println "Type: " (or
ex-name ex-name
(.. e getClass getName))) (.. e getClass getName)))
(when-let [m (.getMessage e)] (when-let [m ex-m]
(println (str "Message: " m))) (println (str "Message: " m)))
(when-let [d (ex-data (.getCause e))] (when-let [d (ex-data root)]
(print (str "Data: ")) (print (str "Data: "))
(prn d)) (prn d))
(let [{:keys [:file :line :column]} d] (let [{:keys [:file :line :column]} d]