annotate src/clojure/stacktrace.clj @ 10:ef7dbbd6452c

added clojure source goodness
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Aug 2010 06:25:44 -0400
parents
children
rev   line source
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))