;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
;;;; This is copyrighted software.  See documentation for terms.
;;;; 
;;;; conditions.cl --- CLASH- and HTTP-specific conditions
;;;; 
;;;; Checkout Tag: $Name$
;;;; $Id$

(in-package :CLASH)

;;;; %File Description:
;;;; 
;;;; This file defines a number of CLASH- and/or HTTP-specific
;;;; conditions, which are used in the rest of CLASH for error
;;;; signalling and handling.
;;;; 

(defun report-clash-error
    (condition stream &optional (fmt "Unspecified error.") args)
  (format stream
	  "CLASH error: ~?~&  Possible HTTP status code: ~D (~A)."
	  fmt args
	  (clash-error-code condition)
	  (HTTP-code-description (clash-error-code condition))))

(define-condition clash-error (error)
  ((code :initarg :code :initform +HTTP-Code-Internal-Server-Error+
	 :type fixnum
	 :reader clash-error-code
	 #+NIL
	 :documentation
	 #+NIL
	 "HTTP status code that might be returned to the client, if
this makes sense.")
   (response-initargs :initarg :response-initargs :initform nil
		      :reader clash-error-response-initargs)
   (entity-initargs :initarg :entity-initargs :initform nil
		    :reader clash-error-entity-initargs))
  (:report report-clash-error))

(define-condition simple-clash-error (simple-condition clash-error)
  ()
  (:report (lambda (condition stream)
	     (report-clash-error condition stream
		     (simple-condition-format-control condition)
		     (simple-condition-format-arguments condition)))))

(define-condition clash-syntax-error (clash-error)
  ((fragment :initarg :fragment :reader clash-syntax-error-fragment)
   (reason :initarg :reason :reader clash-syntax-error-reason))
  (:default-initargs :code +HTTP-Code-Bad-Request+)
  (:report (lambda (condition stream)
	     (report-clash-error
	      condition stream
	      "Syntax error while parsing ~S: ~A"
	      (list (clash-syntax-error-fragment condition)
		    (clash-syntax-error-reason condition))))))