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
|
;;;; terrafirma.lisp
(defpackage #:terrafirma
(:use #:cl)
(:export
#:validation-error ; Condition
#:validate ; Macrolet Symbol
#:defvalidator ; Macro
))
(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 (type (var &key name) &body body)
"Defines a validation function. If TYPE is a symbolic type identifier,
then the defined function will have a name like VALID-<TYPE>-P.
Otherwise a NAME must be provided.
This means you can define validators for types like (CONS CHAR) if you
want.
Within the body of DEFVALIDATOR, a special VALIDATE macro is
bound. Its syntax is:
(VALIDATE CHECK FORMATSTRING &REST FORMATARGS)
E.G.
(validate (= 10 foo) \"Foo = ~s is not equal to 10\" foo)
A VALIDATE form returns T if CHECK evaluates to non-nil. If CHECK
signals an error, or if CHECK returns NIL, then the whole validator
fails.
If all VALIDATE forms pass, then the function returns T."
(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 "VALID-~a-P" type)))
(t (error "Validator Name: Either TYPE must be a symbol or a NAME must be provided.")))))
`(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))))))
(defun ,validator-name (,var)
(let ((terrafirma::*type* ',type)
(terrafirma::*instance* ,var))
,@body
t)))))
|
