1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and
;; distribution terms for this software are covered by the Eclipse Public
;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
;; be found in the file epl-v10.html at the root of this distribution. By
;; using this software in any fashion, you are agreeing to be bound by the
;; terms of this license. You must not remove this notice, or any other,
;; from this software.
;;
;; condition.clj
;;
;; scgilardi (gmail)
;; Created 09 June 2009
(ns #^{:author "Stephen C. Gilardi"
:doc "Flexible raising and handling of conditions:
Functions:
raise: raises a condition
handler-case: dispatches raised conditions to appropriate handlers
print-stack-trace: prints abbreviated or full condition stack traces
Data:
A condition is a map containing values for these keys:
- :type, a condition type specifier, typically a keyword
- :stack-trace, a stack trace to the site of the raise
- :message, a human-readable message (optional)
- :cause, a wrapped exception or condition (optional)
- other keys given as arguments to raise (optional)
Note: requires AOT compilation.
Based on an idea from Chouser:
http://groups.google.com/group/clojure/browse_frm/thread/da1285c538f22bb5"}
clojure.contrib.condition
(:require clojure.contrib.condition.Condition)
(:import clojure.contrib.condition.Condition
clojure.lang.IPersistentMap)
(:use (clojure.contrib
[def :only (defvar)]
[seq-utils :only (separate)])))
(defvar *condition*
"While a handler is running, bound to the condition being handled")
(defvar *selector*
"While a handler is running, bound to the selector returned by the
handler-case dispatch-fn for *condition*")
(defvar *condition-object*
"While a handler is running, bound to the Condition object whose metadata
is the condition")
(defvar *full-stack-traces* false
"Bind to true to include clojure.{core,lang,main} frames in stack
traces")
(defmacro raise
"Raises a condition. With no arguments, re-raises the current condition.
With one argument (a map), raises the argument. With two or more
arguments, raises a map with keys and values from the arguments."
([]
`(throw *condition-object*))
([m]
`(throw (Condition. ~m)))
([key val & keyvals]
`(raise (hash-map ~key ~val ~@keyvals))))
(defmacro handler-case
"Executes body in a context where raised conditions can be handled.
dispatch-fn accepts a raised condition (a map) and returns a selector
used to choose a handler. Commonly, dispatch-fn will be :type to dispatch
on the condition's :type value.
Handlers are forms within body:
(handle key
...)
If a condition is raised, executes the body of the first handler whose
key satisfies (isa? selector key). If no handlers match, re-raises the
condition.
While a handler is running, *condition* is bound to the condition being
handled and *selector* is bound to to the value returned by dispatch-fn
that matched the handler's key."
[dispatch-fn & body]
(let [[handlers code]
(separate #(and (list? %) (= 'handle (first %))) body)]
`(try
~@code
(catch Condition c#
(binding [*condition-object* c#
*condition* (meta c#)
*selector* (~dispatch-fn (meta c#))]
(cond
~@(mapcat
(fn [[_ key & body]]
`[(isa? *selector* ~key) (do ~@body)])
handlers)
:else (raise)))))))
(defmulti stack-trace-info
"Returns header, stack-trace, and cause info from conditions and
Throwables"
class)
(defmethod stack-trace-info IPersistentMap
[condition]
[(format "condition: %s, %s" (:type condition)
(dissoc condition :type :stack-trace :cause))
(:stack-trace condition)
(:cause condition)])
(defmethod stack-trace-info Condition
[condition]
(stack-trace-info (meta condition)))
(defmethod stack-trace-info Throwable
[throwable]
[(str throwable)
(.getStackTrace throwable)
(.getCause throwable)])
(defn print-stack-trace
"Prints a stack trace for a condition or Throwable. Skips frames for
classes in clojure.{core,lang,main} unless the *full-stack-traces* is
bound to logical true"
[x]
(let [[header frames cause] (stack-trace-info x)]
(printf "%s\n" header)
(doseq [frame frames]
(let [classname (.getClassName frame)]
(if (or *full-stack-traces*
(not (re-matches
#"clojure.(?:core|lang|main).*" classname)))
(printf " at %s/%s(%s:%s)\n"
classname
(.getMethodName frame)
(.getFileName frame)
(.getLineNumber frame)))))
(when cause
(printf "caused by: ")
(recur cause))))
|
