rlm@10
|
1 ; Copyright (c) Rich Hickey. All rights reserved.
|
rlm@10
|
2 ; The use and distribution terms for this software are covered by the
|
rlm@10
|
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
rlm@10
|
4 ; which can be found in the file epl-v10.html at the root of this distribution.
|
rlm@10
|
5 ; By using this software in any fashion, you are agreeing to be bound by
|
rlm@10
|
6 ; the terms of this license.
|
rlm@10
|
7 ; You must not remove this notice, or any other, from this software.
|
rlm@10
|
8
|
rlm@10
|
9 ;;; stacktrace.clj: print Clojure-centric stack traces
|
rlm@10
|
10
|
rlm@10
|
11 ;; by Stuart Sierra
|
rlm@10
|
12 ;; January 6, 2009
|
rlm@10
|
13
|
rlm@10
|
14 (ns ^{:doc "Print stack traces oriented towards Clojure, not Java."
|
rlm@10
|
15 :author "Stuart Sierra"}
|
rlm@10
|
16 clojure.stacktrace)
|
rlm@10
|
17
|
rlm@10
|
18 (defn root-cause
|
rlm@10
|
19 "Returns the last 'cause' Throwable in a chain of Throwables."
|
rlm@10
|
20 {:added "1.1"}
|
rlm@10
|
21 [tr]
|
rlm@10
|
22 (if-let [cause (.getCause tr)]
|
rlm@10
|
23 (recur cause)
|
rlm@10
|
24 tr))
|
rlm@10
|
25
|
rlm@10
|
26 (defn print-trace-element
|
rlm@10
|
27 "Prints a Clojure-oriented view of one element in a stack trace."
|
rlm@10
|
28 {:added "1.1"}
|
rlm@10
|
29 [e]
|
rlm@10
|
30 (let [class (.getClassName e)
|
rlm@10
|
31 method (.getMethodName e)]
|
rlm@10
|
32 (let [match (re-matches #"^([A-Za-z0-9_.-]+)\$(\w+)__\d+$" class)]
|
rlm@10
|
33 (if (and match (= "invoke" method))
|
rlm@10
|
34 (apply printf "%s/%s" (rest match))
|
rlm@10
|
35 (printf "%s.%s" class method))))
|
rlm@10
|
36 (printf " (%s:%d)" (or (.getFileName e) "") (.getLineNumber e)))
|
rlm@10
|
37
|
rlm@10
|
38 (defn print-throwable
|
rlm@10
|
39 "Prints the class and message of a Throwable."
|
rlm@10
|
40 {:added "1.1"}
|
rlm@10
|
41 [tr]
|
rlm@10
|
42 (printf "%s: %s" (.getName (class tr)) (.getMessage tr)))
|
rlm@10
|
43
|
rlm@10
|
44 (defn print-stack-trace
|
rlm@10
|
45 "Prints a Clojure-oriented stack trace of tr, a Throwable.
|
rlm@10
|
46 Prints a maximum of n stack frames (default: unlimited).
|
rlm@10
|
47 Does not print chained exceptions (causes)."
|
rlm@10
|
48 {:added "1.1"}
|
rlm@10
|
49 ([tr] (print-stack-trace tr nil))
|
rlm@10
|
50 ([tr n]
|
rlm@10
|
51 (let [st (.getStackTrace tr)]
|
rlm@10
|
52 (print-throwable tr)
|
rlm@10
|
53 (newline)
|
rlm@10
|
54 (print " at ")
|
rlm@10
|
55 (print-trace-element (first st))
|
rlm@10
|
56 (newline)
|
rlm@10
|
57 (doseq [e (if (nil? n)
|
rlm@10
|
58 (rest st)
|
rlm@10
|
59 (take (dec n) (rest st)))]
|
rlm@10
|
60 (print " ")
|
rlm@10
|
61 (print-trace-element e)
|
rlm@10
|
62 (newline)))))
|
rlm@10
|
63
|
rlm@10
|
64 (defn print-cause-trace
|
rlm@10
|
65 "Like print-stack-trace but prints chained exceptions (causes)."
|
rlm@10
|
66 {:added "1.1"}
|
rlm@10
|
67 ([tr] (print-cause-trace tr nil))
|
rlm@10
|
68 ([tr n]
|
rlm@10
|
69 (print-stack-trace tr n)
|
rlm@10
|
70 (when-let [cause (.getCause tr)]
|
rlm@10
|
71 (print "Caused by: " )
|
rlm@10
|
72 (recur cause n))))
|
rlm@10
|
73
|
rlm@10
|
74 (defn e
|
rlm@10
|
75 "REPL utility. Prints a brief stack trace for the root cause of the
|
rlm@10
|
76 most recent exception."
|
rlm@10
|
77 {:added "1.1"}
|
rlm@10
|
78 []
|
rlm@10
|
79 (print-stack-trace (root-cause *e) 8))
|