1 (in-package :lisp-on-lines
)
3 ;;;; Validation Conditions
5 (define-condition validation-condition
()
6 ((message :accessor message
:initarg
:message
:initform
"Invalid value")
7 (value :accessor value
:initarg
:value
:initform
(warn "condition was not given a value"))))
10 (define-condition attribute-validation-condition
(validation-condition)
11 ((attribute :accessor attribute
:initarg
:attribute
:initform nil
)))
13 (defgeneric validate-attribute
(instance attribute
&optional value
)
15 Returns T if the ATTRIBUTE-VALUE in INSTANCE passes all the validation functions. Otherwise, returns (values nil conditions) where CONDITIONS is a list of conditions representing the validation errors the slot.")
16 (:method
(instance attribute
&optional
(value nil value-provided-p
))
17 (let ((val (if value-provided-p
19 (attribute-value instance attribute
)))
21 (handler-bind ((attribute-validation-condition
23 (setf conditions
(cons c conditions
))
26 (dolist (f (find-validation-functions instance attribute
))
27 (funcall f instance attribute val
)))
29 (values nil conditions
)
33 (defmethod find-validation-functions (instance (attribute standard-attribute
))
34 (let ((foo (validate-using attribute
)))
35 (warn "validation?~A " foo
)
40 (define-condition instance-validation-condition
(validation-condition)
41 ((instance :accessor instance
:initarg instance
:initform nil
)
42 (conditions :accessor conditions
:initarg
:conditions
:initform nil
)))
44 (defmethod invalid-instance-p (instance attributes
)
46 (handler-bind ((instance-validation-condition
49 (validate-instance instance attributes
))
52 (defmethod validate-instance (instance attributes
)
54 (dolist (att attributes
)
55 (multiple-value-bind (is-valid-p conditions
)
56 (validate-attribute instance att
)
58 (setf all-conditions
(nconc conditions all-conditions
)))))
60 (progn (signal 'instance-validation-condition
61 :message
"Invalid Instance"
63 :conditions all-conditions
)
64 (values nil all-conditions
))
69 ;;;; Attribute Validation Functions
70 ;;;; I have not quite figured all this out yet.
71 ;;;; A generic validation system needs more thought than i've given it, but this is a start.
73 (defun validate-string-exists (instance attribute value
)
76 (not (< 0 (length value
))))
77 (signal 'attribute-validation-condition
78 :message
(format nil
"You must enter a value for ~A."
80 :attribute attribute
)))
83 (defun validate-true (instance attribute value
)
85 (signal 'attribute-validation-condition
86 :message
(format nil
"~A is required."
88 :attribute attribute
)))