diff options
Diffstat (limited to 'modules/condition')
3 files changed, 216 insertions, 0 deletions
diff --git a/modules/condition/pom.xml b/modules/condition/pom.xml new file mode 100644 index 00000000..53113fc7 --- /dev/null +++ b/modules/condition/pom.xml @@ -0,0 +1,26 @@ +<?xml version="1.0" encoding="UTF-8"?> +<project xmlns="http://maven.apache.org/POM/4.0.0" + xmlns:xsi="http//www.w3.org/2001/XMLSchema-instance" + xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 + http://maven.apache.org/maven-v4_0_0.xsd"> + <modelVersion>4.0.0</modelVersion> + <parent> + <groupId>org.clojure.contrib</groupId> + <artifactId>parent</artifactId> + <version>1.3.0-SNAPSHOT</version> + <relativePath>../parent</relativePath> + </parent> + <artifactId>condition</artifactId> + <dependencies> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>seq</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + </dependencies> +</project>
\ No newline at end of file diff --git a/modules/condition/src/main/clojure/clojure/contrib/condition.clj b/modules/condition/src/main/clojure/clojure/contrib/condition.clj new file mode 100644 index 00000000..57525bfe --- /dev/null +++ b/modules/condition/src/main/clojure/clojure/contrib/condition.clj @@ -0,0 +1,147 @@ +;; 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 :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)))) diff --git a/modules/condition/src/main/clojure/clojure/contrib/condition/Condition.clj b/modules/condition/src/main/clojure/clojure/contrib/condition/Condition.clj new file mode 100644 index 00000000..18449653 --- /dev/null +++ b/modules/condition/src/main/clojure/clojure/contrib/condition/Condition.clj @@ -0,0 +1,43 @@ +;; 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 +;; +;; Used by clojure.contrib.condition to implement a "Throwable map" +;; +;; scgilardi (gmail) +;; Created 09 June 2009 + +(ns clojure.contrib.condition.Condition + (:gen-class :extends Throwable + :implements [clojure.lang.IMeta] + :state state + :init init + :post-init post-init + :constructors {[clojure.lang.IPersistentMap] + [String Throwable]})) + +(defn -init + "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] + @(.state this)) |