Browse files

Add try+ as augmented dce-aware try.

  • Loading branch information...
1 parent 80d065b commit 608c3220ea32228ab70566ea6d41e1c8129cde13 @technomancy committed Jun 10, 2011
Showing with 56 additions and 12 deletions.
  1. +34 −10 src/dce/handle.clj
  2. +22 −2 test/dce/test/exception.clj
View
44 src/dce/handle.clj
@@ -1,14 +1,14 @@
(ns dce.handle)
+(def ^{:doc "While a handler is running, bound to the selector returned by the
+ handler-case dispatch-fn for the exception."} *selector*)
+
(defn- separate [f s] ; lifted from c.c.seq
[(filter f s) (filter (complement f) s)])
(defn starts-with-fn [x]
(fn [c] (and (coll? c) (= x (first c)))))
-(def ^{:doc "While a handler is running, bound to the selector returned by the
- handler-case dispatch-fn for *condition*"} *selector*)
-
(defmacro handler-case
"Executes body in a context where raised exceptions can be handled.
@@ -18,7 +18,7 @@
Handlers are forms within body:
- (handle key
+ (handle key ex
...)
If a data-conveying Exception is raised, executes the body of the
@@ -30,15 +30,39 @@
that matched the handler's key."
[dispatch-fn & body]
(let [[handlers code] (separate (starts-with-fn 'handle) body)
- [catches code] (separate (starts-with-fn 'catch) code)]
+ [catches code] (separate (starts-with-fn 'catch) code)
+ exception (gensym)]
`(try
~@code
- (catch dce.Exception e#
- (binding [*selector* (~dispatch-fn e#)]
+ (catch dce.Exception ~exception
+ (binding [*selector* (~dispatch-fn ~exception)]
(cond
~@(mapcat
- (fn [[_ key & body]]
- `[(isa? *selector* ~key) (do ~@body)])
+ (fn [[_ key local & body]]
+ `[(isa? *selector* ~key) (let [~local ~exception] ~@body)])
handlers)
- :else (raise))))
+ :else (throw ~exception))))
~@catches)))
+
+(defn- body-form? [x]
+ (or (not (seq? x)) (not= 'catch (first x))))
+
+(defn- raw? [[_ x]]
+ (and (symbol? x) (class? (resolve x))))
+
+(defmacro try+
+ [& body]
+ (let [[tried catches] (partition-by body-form? body)
+ [raw-catches dce-catches] (separate raw? catches)
+ exception (gensym)]
+ `(try
+ (try
+ ~@tried
+ (catch dce.Exception ~exception
+ (cond
+ ~@(mapcat
+ (fn [[_ pred local & body]]
+ `[(~pred ~exception) (let [~local ~exception] ~@body)])
+ dce-catches)
+ :else (throw ~exception))))
+ ~@raw-catches)))
View
24 test/dce/test/exception.clj
@@ -1,5 +1,7 @@
(ns dce.test.exception
- (:use [clojure.test]))
+ (:use [clojure.test]
+ [dce.handle]
+ [dce.Exception :only [toss]]))
(def e (dce.Exception. {:a :bob :b :alice}))
@@ -12,7 +14,6 @@
(deftest test-str
(is (= "{:a :bob, :b :alice}" (str e))))
-;; TODO: implementing ISeq breaks this; works with just ILookup.
(deftest test-destructure
(is (= [:bob :alice]
(let [{:keys [a b]} e]
@@ -39,3 +40,22 @@
(deftest test-ifn
(is (= :bob (e :a))))
+
+(deftest test-handler-case
+ (is (= :lots (handler-case :type
+ (toss :message "duuuude" :type :funky :funkiness :lots)
+ (handle :non-funky _)
+ (handle :funky {:keys [funkiness]}
+ funkiness)))))
+
+(defn funky? [])
+
+(deftest test-try+
+ (is (= :lots (try+
+ (toss :message "duuuude" :funky true :funkiness :lots)
+ (catch :funky {:keys [funkiness]}
+ funkiness)
+ (catch :non-funky _
+ :bummer-dude)
+ (catch funky? x)
+ (catch Exception _)))))

0 comments on commit 608c322

Please sign in to comment.