diff options
| -rw-r--r-- | src/clojure/contrib/condition.clj | 104 | ||||
| -rw-r--r-- | src/clojure/contrib/condition/Condition.clj | 26 | ||||
| -rw-r--r-- | src/clojure/contrib/condition/example.clj | 21 |
3 files changed, 97 insertions, 54 deletions
diff --git a/src/clojure/contrib/condition.clj b/src/clojure/contrib/condition.clj index 4d7ad422..8df8acff 100644 --- a/src/clojure/contrib/condition.clj +++ b/src/clojure/contrib/condition.clj @@ -8,26 +8,27 @@ ;; ;; 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: + :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: - - keys and values specified as arguments to raise, and - - a stack trace at key :stack-trace. + - :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. @@ -35,7 +36,8 @@ 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) + (:import clojure.contrib.condition.Condition + clojure.lang.IPersistentMap) (:use (clojure.contrib [def :only (defvar)] [seq-utils :only (separate)]))) @@ -44,12 +46,12 @@ http://groups.google.com/group/clojure/browse_frm/thread/da1285c538f22bb5"} "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*") + "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 being handled") + is the condition") (defvar *full-stack-traces* false "Bind to true to include clojure.{core,lang,main} frames in stack @@ -62,15 +64,16 @@ http://groups.google.com/group/clojure/browse_frm/thread/da1285c538f22bb5"} ([] `(throw *condition-object*)) ([m] - `(throw (Condition. m))) + `(throw (Condition. ~m))) ([key val & keyvals] - `(throw (Condition. (hash-map ~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. + used to choose a handler. Commonly, dispatch-fn will be :type to dispatch + on the condition's :type value. Handlers are forms within body: @@ -100,20 +103,45 @@ http://groups.google.com/group/clojure/browse_frm/thread/da1285c538f22bb5"} 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" +(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] - (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)))))) + (stack-trace-info ^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)))) diff --git a/src/clojure/contrib/condition/Condition.clj b/src/clojure/contrib/condition/Condition.clj index b3a24340..18449653 100644 --- a/src/clojure/contrib/condition/Condition.clj +++ b/src/clojure/contrib/condition/Condition.clj @@ -16,16 +16,28 @@ (ns clojure.contrib.condition.Condition (:gen-class :extends Throwable :implements [clojure.lang.IMeta] - :state _meta + :state state :init init - :constructors - {[clojure.lang.IPersistentMap] []})) + :post-init post-init + :constructors {[clojure.lang.IPersistentMap] + [String Throwable]})) (defn -init - [meta] - [[] meta]) + "Constructs a Condition object with condition (a map) as its + metadata. Also initializes the superclass with the values at :message + and :cause, if any, so they are also available via .getMessage and + .getCause." + [condition] + [[(:message condition) (:cause condition)] (atom condition)]) + +(defn -post-init + "Adds :stack-trace to the condition. Drops the bottom 3 frames because + they are always the same: implementation details of Condition and raise." + [this condition] + (swap! (.state this) assoc + :stack-trace (into-array (drop 3 (.getStackTrace this))))) (defn -meta + "Returns this object's metadata, the condition" [this] - (assoc (._meta this) - :stack-trace (into-array (drop 3 (.getStackTrace this))))) + @(.state this)) diff --git a/src/clojure/contrib/condition/example.clj b/src/clojure/contrib/condition/example.clj index 36d7b36f..5a7d72ef 100644 --- a/src/clojure/contrib/condition/example.clj +++ b/src/clojure/contrib/condition/example.clj @@ -12,28 +12,31 @@ ;; Created 09 June 2009 (ns clojure.contrib.condition.example - (:use clojure.contrib.condition)) + (:use (clojure.contrib + [condition + :only (handler-case print-stack-trace raise *condition*)]))) (defn func [x y] - (if (neg? x) - (raise :reason :illegal-argument :arg 'x :value x :message "cannot be negative") - (+ x y))) + "Raises an exception if x is negative" + (when (neg? x) + (raise :type :illegal-argument :arg 'x :value x)) + (+ x y)) (defn main [] ;; simple handler - (handler-case :reason + (handler-case :type (println (func 3 4)) (println (func -5 10)) (handle :illegal-argument - (print-stack-trace *condition*)) + (print-stack-trace *condition*)) (println 3)) ;; multiple handlers - (handler-case :reason + (handler-case :type (println (func 4 1)) (println (func -3 22)) (handle :overflow @@ -43,8 +46,8 @@ ;; nested handlers - (handler-case :reason - (handler-case :reason + (handler-case :type + (handler-case :type nil nil (println 1) |