;;;; terrafirma.lisp

(defpackage #:terrafirma
  (:use #:cl)
  (:export
   #:validate
   #:defvalidator))

(in-package #:terrafirma)

(defvar *indentation* 0)

(defun report-validation-error (err stream)
  (with-slots (type reason suberror) err
    (loop :repeat *indentation* :do (princ #\space stream))
    (format stream "Error validating ~a: ~a~%" type reason)
    (when suberror
      (loop :repeat *indentation* :do (princ #\space stream))
      (format stream "More specifically:~%")
      (let ((*indentation* (+ 2 *indentation*))) 
        (report-validation-error suberror stream)))))

(define-condition validation-error (error)
  ((type
    :initarg :type
    :initform (error "TYPE Required")
    :type symbol
    :documentation "The type of the invalid object.")
   (instance
    :initarg :instance
    :initform (error "INSTANCE Required")
    :documentation "The invalid object.")
   (reason
    :initarg :reason
    :initform (error "INSTANCE Required")
    :type string
    :documentation "A description of why the instance is invalid.")
   (suberror
    :initarg :suberror
    :initform nil
    :documentation
    "A validation error that may have been signalled while validating a part of the structure of INSTANCE."))
  (:report report-validation-error))


(defvar *type*)
(defvar *instance*)

(defmacro defvalidator ((var type &key name) &body body)
  (assert (and var (symbolp var)) (var) "VAR must be a symbol.")
  (let ((validator-name
          (cond ((and name (symbolp name)) name)
                ((symbolp type) (intern (format nil "VALIDATED-~a" type)))
                (t (error "Validator Name: Either TYPE must be a symbol or a NAME must be provided.")))))
    `(defun ,validator-name (,var)
       (macrolet ((validate (check msg &rest args)
                    (let ((suberr (gensym)))
                      `(prog1 t
                         (let (,suberr)
                           (assert (handler-case ,check (validation-error (sub) (setf ,suberr sub) nil))
                                   () 'terrafirma::validation-error
                                   :type terrafirma::*type*
                                   :instance terrafirma::*instance*
                                   :reason (format nil ,msg ,@args)
                                   :suberror ,suberr)))))) 

         (let ((terrafirma::*type* ',type)
               (terrafirma::*instance* ,var))
           ,@body)))))