|
rlm@10
|
1 ;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and
|
|
rlm@10
|
2 ;; distribution terms for this software are covered by the Eclipse Public
|
|
rlm@10
|
3 ;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
|
|
rlm@10
|
4 ;; be found in the file epl-v10.html at the root of this distribution. By
|
|
rlm@10
|
5 ;; using this software in any fashion, you are agreeing to be bound by the
|
|
rlm@10
|
6 ;; terms of this license. You must not remove this notice, or any other,
|
|
rlm@10
|
7 ;; from this software.
|
|
rlm@10
|
8 ;;
|
|
rlm@10
|
9 ;; except.clj
|
|
rlm@10
|
10 ;;
|
|
rlm@10
|
11 ;; Provides functions that make it easy to specify the class, cause, and
|
|
rlm@10
|
12 ;; message when throwing an Exception or Error. The optional message is
|
|
rlm@10
|
13 ;; formatted using clojure.core/format.
|
|
rlm@10
|
14 ;;
|
|
rlm@10
|
15 ;; scgilardi (gmail)
|
|
rlm@10
|
16 ;; Created 07 July 2008
|
|
rlm@10
|
17
|
|
rlm@10
|
18 (ns
|
|
rlm@10
|
19 ^{:author "Stephen C. Gilardi",
|
|
rlm@10
|
20 :doc "Provides functions that make it easy to specify the class, cause, and
|
|
rlm@10
|
21 message when throwing an Exception or Error. The optional message is
|
|
rlm@10
|
22 formatted using clojure.core/format."}
|
|
rlm@10
|
23 clojure.contrib.except
|
|
rlm@10
|
24 (:import (clojure.lang Reflector)))
|
|
rlm@10
|
25
|
|
rlm@10
|
26 (declare throwable)
|
|
rlm@10
|
27
|
|
rlm@10
|
28 (defn throwf
|
|
rlm@10
|
29 "Throws an Exception or Error with an optional message formatted using
|
|
rlm@10
|
30 clojure.core/format. All arguments are optional:
|
|
rlm@10
|
31
|
|
rlm@10
|
32 class? cause? format? format-args*
|
|
rlm@10
|
33
|
|
rlm@10
|
34 - class defaults to Exception, if present it must name a kind of
|
|
rlm@10
|
35 Throwable
|
|
rlm@10
|
36 - cause defaults to nil, if present it must be a Throwable
|
|
rlm@10
|
37 - format is a format string for clojure.core/format
|
|
rlm@10
|
38 - format-args are objects that correspond to format specifiers in
|
|
rlm@10
|
39 format."
|
|
rlm@10
|
40 [& args]
|
|
rlm@10
|
41 (throw (throwable args)))
|
|
rlm@10
|
42
|
|
rlm@10
|
43 (defn throw-if
|
|
rlm@10
|
44 "Throws an Exception or Error if test is true. args are those documented
|
|
rlm@10
|
45 for throwf."
|
|
rlm@10
|
46 [test & args]
|
|
rlm@10
|
47 (when test
|
|
rlm@10
|
48 (throw (throwable args))))
|
|
rlm@10
|
49
|
|
rlm@10
|
50 (defn throw-if-not
|
|
rlm@10
|
51 "Throws an Exception or Error if test is false. args are those documented
|
|
rlm@10
|
52 for throwf."
|
|
rlm@10
|
53 [test & args]
|
|
rlm@10
|
54 (when-not test
|
|
rlm@10
|
55 (throw (throwable args))))
|
|
rlm@10
|
56
|
|
rlm@10
|
57 (defn throw-arg
|
|
rlm@10
|
58 "Throws an IllegalArgumentException. All arguments are optional:
|
|
rlm@10
|
59
|
|
rlm@10
|
60 cause? format? format-args*
|
|
rlm@10
|
61
|
|
rlm@10
|
62 - cause defaults to nil, if present it must be a Throwable
|
|
rlm@10
|
63 - format is a format string for clojure.core/format
|
|
rlm@10
|
64 - format-args are objects that correspond to format specifiers in
|
|
rlm@10
|
65 format."
|
|
rlm@10
|
66 [& args]
|
|
rlm@10
|
67 (throw (throwable (cons IllegalArgumentException args))))
|
|
rlm@10
|
68
|
|
rlm@10
|
69 (defn- throwable?
|
|
rlm@10
|
70 "Returns true if x is a Throwable"
|
|
rlm@10
|
71 [x]
|
|
rlm@10
|
72 (instance? Throwable x))
|
|
rlm@10
|
73
|
|
rlm@10
|
74 (defn- throwable
|
|
rlm@10
|
75 "Constructs a Throwable with optional cause and formatted message. Its
|
|
rlm@10
|
76 stack trace will begin with our caller's caller. Args are as described
|
|
rlm@10
|
77 for throwf except throwable accepts them as list rather than inline."
|
|
rlm@10
|
78 [args]
|
|
rlm@10
|
79 (let [[arg] args
|
|
rlm@10
|
80 [class & args] (if (class? arg) args (cons Exception args))
|
|
rlm@10
|
81 [arg] args
|
|
rlm@10
|
82 [cause & args] (if (throwable? arg) args (cons nil args))
|
|
rlm@10
|
83 message (when args (apply format args))
|
|
rlm@10
|
84 ctor-args (into-array Object
|
|
rlm@10
|
85 (cond (and message cause) [message cause]
|
|
rlm@10
|
86 message [message]
|
|
rlm@10
|
87 cause [cause]))
|
|
rlm@10
|
88 throwable (Reflector/invokeConstructor class ctor-args)
|
|
rlm@10
|
89 our-prefix "clojure.contrib.except$throwable"
|
|
rlm@10
|
90 not-us? #(not (.startsWith (.getClassName %) our-prefix))
|
|
rlm@10
|
91 raw-trace (.getStackTrace throwable)
|
|
rlm@10
|
92 edited-trace (into-array StackTraceElement
|
|
rlm@10
|
93 (drop 3 (drop-while not-us? raw-trace)))]
|
|
rlm@10
|
94 (.setStackTrace throwable edited-trace)
|
|
rlm@10
|
95 throwable))
|
