;;;; 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 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)))))


(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 "VALIDATE-~a" type)))
                (t (error "Validator Name: Either TYPE must be a symbol or a NAME must be provided.")))))
    `(defun ,validator-name (,var)
       (let ((terrafirma::*type* ',type)
             (terrafirma::*instance* ',var))
         ,@body))))