Mercurial > lasercutter

     1 ;   Copyright (c) Rich Hickey. All rights reserved.

     2 ;   The use and distribution terms for this software are covered by the

     3 ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)

     4 ;   which can be found in the file epl-v10.html at the root of this distribution.

     5 ;   By using this software in any fashion, you are agreeing to be bound by

     6 ;   the terms of this license.

     7 ;   You must not remove this notice, or any other, from this software.

     8 

     9 ;;; stacktrace.clj: print Clojure-centric stack traces

    10 

    11 ;; by Stuart Sierra

    12 ;; January 6, 2009

    13 

    14 (ns ^{:doc "Print stack traces oriented towards Clojure, not Java."

    15        :author "Stuart Sierra"}

    16   clojure.stacktrace)

    17 

    18 (defn root-cause

    19   "Returns the last 'cause' Throwable in a chain of Throwables."

    20   {:added "1.1"}

    21   [tr]

    22   (if-let [cause (.getCause tr)]

    23     (recur cause)

    24     tr))

    25 

    26 (defn print-trace-element

    27   "Prints a Clojure-oriented view of one element in a stack trace."

    28   {:added "1.1"}

    29   [e]

    30   (let [class (.getClassName e)

    31 	method (.getMethodName e)] 

    32     (let [match (re-matches #"^([A-Za-z0-9_.-]+)\$(\w+)__\d+$" class)]

    33       (if (and match (= "invoke" method))

    34 	(apply printf "%s/%s" (rest match))

    35 	(printf "%s.%s" class method))))

    36   (printf " (%s:%d)" (or (.getFileName e) "") (.getLineNumber e)))

    37 

    38 (defn print-throwable

    39   "Prints the class and message of a Throwable."

    40   {:added "1.1"}

    41   [tr]

    42   (printf "%s: %s" (.getName (class tr)) (.getMessage tr)))

    43 

    44 (defn print-stack-trace

    45   "Prints a Clojure-oriented stack trace of tr, a Throwable.

    46   Prints a maximum of n stack frames (default: unlimited).

    47   Does not print chained exceptions (causes)."

    48   {:added "1.1"}

    49   ([tr] (print-stack-trace tr nil))

    50   ([tr n]

    51      (let [st (.getStackTrace tr)]

    52        (print-throwable tr)

    53        (newline)

    54        (print " at ") 

    55        (print-trace-element (first st))

    56        (newline)

    57        (doseq [e (if (nil? n)

    58 		   (rest st)

    59 		   (take (dec n) (rest st)))]

    60 	 (print "    ")

    61 	 (print-trace-element e)

    62 	 (newline)))))

    63 

    64 (defn print-cause-trace

    65   "Like print-stack-trace but prints chained exceptions (causes)."

    66   {:added "1.1"}

    67   ([tr] (print-cause-trace tr nil))

    68   ([tr n]

    69      (print-stack-trace tr n)

    70      (when-let [cause (.getCause tr)]

    71        (print "Caused by: " )

    72        (recur cause n))))

    73 

    74 (defn e

    75   "REPL utility.  Prints a brief stack trace for the root cause of the

    76   most recent exception."

    77   {:added "1.1"}

    78   []

    79   (print-stack-trace (root-cause *e) 8))
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children