Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

file 147 lines (123 sloc) 4.89 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 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))))
Something went wrong with that request. Please try again.