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
|
;; 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
;;
;; Flexible raising and handling of conditions. A condition is a map
;; containing:
;;
;; - keys and values specified as arguments to raise, and
;; - a stack trace at key :stack-trace.
;;
;; Note: requires AOT compilation.
;;
;; Based on an idea from Chouser:
;; http://groups.google.com/group/clojure/browse_frm/thread/da1285c538f22bb5
;;
;; scgilardi (gmail)
;; Created 09 June 2009
(ns #^{:author "Stephen C. Gilardi"
:doc "Flexible raising and handling of conditions. A condition is a map
containing:
- keys and values specified as arguments to raise, and
- a stack trace at key :stack-trace.
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)
(: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
dispatch-fn for *condition*")
(defvar *condition-object*
"While a handler is running, bound to the Condition object whose metadata
is the condition being handled")
(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]
`(throw (Condition. (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.
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* ^c#
*selector* (~dispatch-fn ^c#)]
(cond
~@(mapcat
(fn [[_ key & body]]
`[(isa? *selector* ~key) (do ~@body)])
handlers)
:else (raise)))))))
(defn print-stack-trace
"Prints the stack trace for a condition. Skips frames for classes in
clojure.{core,lang,main} unless the *full-stack-traces* is bound to
logical true"
[condition]
(printf "condition: %s\n"
(dissoc condition :stack-trace))
(doseq [frame (:stack-trace condition)]
(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))))))
|
