Wispy Lisp

Wisp Conditions 

(define-condition werror (error)
  ())

Model 

(define-condition wisp-no-object-with-id (werror)
  ((class :initarg :class)
   (id :initarg :id))
  (:report (lambda (c s)
	     (with-slots (class id) c 
	       (fmt :> s
		    "No object of class " class " stored by ID " id " is found.")))))

View 

(define-condition wisp-undefined-view (werror)
  ((view-name :initarg :view-name))
  (:report (lambda (c s)
	     (with-slots (view-name) c
	       (fmt :> s
		    "Unable to render the undefined view " view-name)))))

Control  

(define-condition wisp-undefined-wethod-discriminator (werror)
  ((discriminator :initarg :discriminator)
   (valid-discriminators :initarg :valid-discriminators)
   (wethod-name :initarg :wethod-name))
  (:report (lambda (c s)
	     (with-slots (discriminator wethod-name valid-discriminators) c
	       (fmt :> s "Discriminator " discriminator " is not available to wethod " wethod-name "."
		    :% "The valid discriminators are " valid-discriminators)))))

Urlmap 

(define-condition wisp-no-dispatch-for-url (werror)
  ((url :initarg :url))
  (:report (lambda (c s)
	     (with-slots (url) c
	       (fmt :> s
		    "No dispatch is associated with " url)))))

(define-condition wisp-undefined-nested-urlmap (werror)
  ((nested-map :initarg :nested-map)
   (root-map :initarg :root-map))
  (:report (lambda (c s)
	     (with-slots (nested-map root-map) c
	       (fmt :> s
		    "Undefined nested-urlmap "  nested-map
		    " in root map " root-map)))))

(eval-always
  (defmacro def-wisp-condition (name slots report)
    (let ((name (symcat 'wisp- name))
	  (s (gensym)))
      `(define-condition ,name (werror)
	 ,(mapcar (fn (slot)
		    `(,slot :initarg ,(^keyword slot) :initform nil))
		  slots)
	 (:report (lambda (c ,s)
		    (with-slots ,slots c
		      (let ((*fmt-stream* ,s))
			,report))))))))

#+(or)
(define-condition wisp-circular-nested-urlmap (werror)
  ((circular-map :initarg :circular-map)
   (parent-map :initarg :parent-map)
   (root-map :initarg :root-map))
  (:report (lambda (c s)
	     (with-slots (circular-map parent-map root-map) c
	       (fmt :> s
		    "Circular nested-urlmap "  circular-map
		    " detected under parent map " parent-map
		    " in root map " root-map)))))

(def-wisp-condition circular-nested-urlmap (circular-map parent-map root-map)
  (fmt "Circular nested-urlmap "  circular-map
       " detected under parent map " parent-map
       " in root map " root-map))

Continuation 

(def-wisp-condition invalid-continuation-id (k-id)
  (fmt "No continuation associated with the k-id: " k-id))