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