commited new validation system.

[clinton/lisp-on-lines.git] / src / validation.lisp

diff --git a/src/validation.lisp b/src/validation.lisp
deleted file mode 100644 (file)
index 00cade6..0000000
--- a/src/validation.lisp
+++ /dev/null
@@ -1,95 +0,0 @@
-(in-package :lisp-on-lines)
-
-;;;; Validation Conditions
-
-(define-condition validation-condition ()
-  ((message :accessor message :initarg :message :initform "Invalid value")
-   (value :accessor value :initarg :value :initform (warn "condition was not given a value"))))
-
-
-;;;; ** Attributes
-(define-condition attribute-validation-condition (validation-condition)
-  ((attribute :accessor attribute :initarg :attribute :initform nil)))
-
-(defgeneric validate-attribute (instance attribute)
-  (:documentation "
-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.")
-  (:method (instance attribute)
-      (let (conditions)
-       (handler-bind ((attribute-validation-condition
-                       #'(lambda (c)
-                           (setf conditions (cons c conditions))
-                           (signal c))))
-             (dolist (f (find-validation-functions instance attribute))
-                      (funcall f instance attribute)))
-       (if conditions
-           (values nil conditions)
-           t)))
-  (:method (instance (attribute symbol))
-    (validate-attribute instance (find-attribute instance attribute))))
-
-
-(defmethod find-validation-functions (instance (attribute standard-attribute))
-  (getf (description.properties attribute) :validate-using))
-
-
-;;;; ** Instances
-(define-condition instance-validation-condition (validation-condition)
-  ((instance :accessor instance :initarg instance :initform nil)
-   (conditions :accessor conditions :initarg :conditions :initform nil)))
-
-(defmethod invalid-instance-p (instance attributes)
-  (let (condition)
-    (handler-bind ((instance-validation-condition
-                 #'(lambda (c)
-                     (setf condition c))))
-      (validate-instance instance attributes))
-    condition))
-  
-(defmethod validate-instance (instance attributes)
-  (let (all-conditions)
-    (dolist (att attributes)
-      (multiple-value-bind (is-valid-p conditions)
-         (validate-attribute instance att)
-       (unless is-valid-p
-         (setf all-conditions (nconc conditions all-conditions)))))
-    (if all-conditions
-       (progn (signal 'instance-validation-condition
-                      :message "Invalid Instance"
-                      :instance instance
-                      :conditions all-conditions)
-              (values nil all-conditions))
-       
-       t)))
-
-;;;; Attribute Validation Functions
-;;;; I have not quite figured all this out yet.
-;;;; A generic validation system needs more thought than i've given it, but this is a start.
-
-(defun validate-string-exists (instance attribute)
-  (let ((value (lol::attribute-value instance attribute)))
-    (if (or
-        (not (stringp value))
-        (not (< 0 (length value))))
-       (signal 'attribute-validation-condition
-               :message (format nil "You must enter a value for ~A."
-                                (getf (description.properties attribute) :label))
-               :attribute attribute))))
-
-
-(defun validate-true (instance attribute)
-  
-  (warn "validate ~A ~A" instance attribute)
-  (let ((value (lol::attribute-value instance attribute)))
-    (warn "value is ~A" value)
-    (unless value 
-        
-      (signal 'attribute-validation-condition
-             :message (format nil "~A must be true."
-                              (getf (description.properties attribute) :label))
-             :attribute attribute))))
-
-
-
-
-