1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/stacktrace.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,79 @@
     1.4 +;   Copyright (c) Rich Hickey. All rights reserved.
     1.5 +;   The use and distribution terms for this software are covered by the
     1.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
     1.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
     1.8 +;   By using this software in any fashion, you are agreeing to be bound by
     1.9 +;   the terms of this license.
    1.10 +;   You must not remove this notice, or any other, from this software.
    1.11 +
    1.12 +;;; stacktrace.clj: print Clojure-centric stack traces
    1.13 +
    1.14 +;; by Stuart Sierra
    1.15 +;; January 6, 2009
    1.16 +
    1.17 +(ns ^{:doc "Print stack traces oriented towards Clojure, not Java."
    1.18 +       :author "Stuart Sierra"}
    1.19 +  clojure.stacktrace)
    1.20 +
    1.21 +(defn root-cause
    1.22 +  "Returns the last 'cause' Throwable in a chain of Throwables."
    1.23 +  {:added "1.1"}
    1.24 +  [tr]
    1.25 +  (if-let [cause (.getCause tr)]
    1.26 +    (recur cause)
    1.27 +    tr))
    1.28 +
    1.29 +(defn print-trace-element
    1.30 +  "Prints a Clojure-oriented view of one element in a stack trace."
    1.31 +  {:added "1.1"}
    1.32 +  [e]
    1.33 +  (let [class (.getClassName e)
    1.34 +	method (.getMethodName e)] 
    1.35 +    (let [match (re-matches #"^([A-Za-z0-9_.-]+)\$(\w+)__\d+$" class)]
    1.36 +      (if (and match (= "invoke" method))
    1.37 +	(apply printf "%s/%s" (rest match))
    1.38 +	(printf "%s.%s" class method))))
    1.39 +  (printf " (%s:%d)" (or (.getFileName e) "") (.getLineNumber e)))
    1.40 +
    1.41 +(defn print-throwable
    1.42 +  "Prints the class and message of a Throwable."
    1.43 +  {:added "1.1"}
    1.44 +  [tr]
    1.45 +  (printf "%s: %s" (.getName (class tr)) (.getMessage tr)))
    1.46 +
    1.47 +(defn print-stack-trace
    1.48 +  "Prints a Clojure-oriented stack trace of tr, a Throwable.
    1.49 +  Prints a maximum of n stack frames (default: unlimited).
    1.50 +  Does not print chained exceptions (causes)."
    1.51 +  {:added "1.1"}
    1.52 +  ([tr] (print-stack-trace tr nil))
    1.53 +  ([tr n]
    1.54 +     (let [st (.getStackTrace tr)]
    1.55 +       (print-throwable tr)
    1.56 +       (newline)
    1.57 +       (print " at ") 
    1.58 +       (print-trace-element (first st))
    1.59 +       (newline)
    1.60 +       (doseq [e (if (nil? n)
    1.61 +		   (rest st)
    1.62 +		   (take (dec n) (rest st)))]
    1.63 +	 (print "    ")
    1.64 +	 (print-trace-element e)
    1.65 +	 (newline)))))
    1.66 +
    1.67 +(defn print-cause-trace
    1.68 +  "Like print-stack-trace but prints chained exceptions (causes)."
    1.69 +  {:added "1.1"}
    1.70 +  ([tr] (print-cause-trace tr nil))
    1.71 +  ([tr n]
    1.72 +     (print-stack-trace tr n)
    1.73 +     (when-let [cause (.getCause tr)]
    1.74 +       (print "Caused by: " )
    1.75 +       (recur cause n))))
    1.76 +
    1.77 +(defn e
    1.78 +  "REPL utility.  Prints a brief stack trace for the root cause of the
    1.79 +  most recent exception."
    1.80 +  {:added "1.1"}
    1.81 +  []
    1.82 +  (print-stack-trace (root-cause *e) 8))