diff options
Diffstat (limited to 'src/clojure/contrib/condition.clj')
| -rw-r--r-- | src/clojure/contrib/condition.clj | 147 |
1 files changed, 0 insertions, 147 deletions
diff --git a/src/clojure/contrib/condition.clj b/src/clojure/contrib/condition.clj deleted file mode 100644 index 98aa589a..00000000 --- a/src/clojure/contrib/condition.clj +++ /dev/null @@ -1,147 +0,0 @@ -;; 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 -;; -;; scgilardi (gmail) -;; Created 09 June 2009 - -(ns #^{:author "Stephen C. Gilardi" - :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: - - - :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. - -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 - clojure.lang.IPersistentMap) - (: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 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") - -(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] - `(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. Commonly, dispatch-fn will be :type to dispatch - on the condition's :type value. - - 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* (meta c#) - *selector* (~dispatch-fn (meta c#))] - (cond - ~@(mapcat - (fn [[_ key & body]] - `[(isa? *selector* ~key) (do ~@body)]) - handlers) - :else (raise))))))) - -(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] - (stack-trace-info (meta 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)))) |