Custom slot options don't apply any reduction to its argument

Question

Say if I define a metaclass that enhances standard slots with a validator slot, when I pass :validator (clavier:valid-email "The email is invalid") as an option, instead of storing the result of of the expression, which is a funcallable, it stores the expression itself. Am I'm missing a step when extending the standard slots? How do I ensure the expression is evaluated before stored? I'm using SBCL 1.2.11 btw. Here is the code in question

(unless (find-package 'clavier)
  (ql:quickload :clavier))
(unless (find-package 'c2mop)
  (ql:quickload :c2mop))
(defpackage #:clos2web/validation
  (:use #:cl)
  (:import-from #:c2mop
                #:standard-class
                #:standard-direct-slot-definition
                #:standard-effective-slot-definition
                #:validate-superclass
                #:direct-slot-definition-class
                #:effective-slot-definition-class
                #:compute-effective-slot-definition
                #:slot-value-using-class))

(in-package #:clos2web/validation)

(defun true (value)
  "Always return true."
  (declare (ignore value))
  t)

(defclass validation-class (standard-class)
  ()
  (:documentation "Meta-class for objects whose slots know how to validate
  their values."))

(defmethod validate-superclass
    ((class validation-class) (super standard-class))
  t)

(defmethod validate-superclass
    ((class standard-class) (super validation-class))
  t)

(defclass validation-slot (c2mop:standard-slot-definition)
  ((validator :initarg :validator :accessor validator :initform #'true
              :documentation "The function to determine if the value is
  valid. It takes as a parameter the value.")))

(defclass validation-direct-slot (validation-slot
                                  standard-direct-slot-definition)
  ())

(defclass validation-effective-slot (validation-slot
                                     standard-effective-slot-definition)
  ())

(defmethod direct-slot-definition-class ((class validation-class) &rest initargs)
  (declare (ignore initargs))
  (find-class 'validation-direct-slot))

(defmethod effective-slot-definition-class ((class validation-class) &rest initargs)
  (declare (ignore initargs))
  (find-class 'validation-effective-slot))

(defmethod compute-effective-slot-definition
    ((class validation-class) slot-name direct-slot-definitions)
  (let ((effective-slot-definition (call-next-method)))
    (setf (validator effective-slot-definition)
          (some #'validator direct-slot-definitions))
    effective-slot-definition))

(defmethod (setf slot-value-using-class) :before
    (new (class validation-class) object (slot validation-effective-slot))
  (when (slot-boundp slot 'validator)
    (multiple-value-bind (validp msg)
        (funcall (validator slot) new)
      (unless validp
        (error msg)))))

;; Example usage

(defclass user ()
  ((name :initarg :name)
   (email :initarg :email :validator (clavier:valid-email "The email is invalid") :accessor email))
  (:metaclass validation-class))

(let ((pepe (make-instance 'user :name "Pepe" :email "[email protected]")))
  (setf (email pepe) "FU!")) ;; should throw

The code fails when making an instance as (CLAVIER:VALID-EMAIL "The email is invalid") is not a funcallable.

 (CLAVIER:VALID-EMAIL
  "The email is invalid") fell through ETYPECASE expression.
 Wanted one of (FUNCTION SYMBOL).
    [Condition of type SB-KERNEL:CASE-FAILURE]

Answer 1

Like the comment above says, defclass does not evaluate arguments (it is a macro). While the usual advice is to avoid eval, I think that eval in this circumstance might be exactly what you want. While usually you would splice the form directly into some macro body, with defclass I think the answer is to eval the form in slot initialization and store the evaluation (if it has not yet been evaled).

This would probably occur in:

(defmethod initialize-instance :after ((obj validation-slot)
                                       &key &allow-other-keys)
  #| ... |#)

Optionally you could also store the :validation-message and :validation-fn as two separate arguments then call:

(multiple-value-bind (validp msg)
    (funcall (funcall (validator-fn slot)
                      (validator-message slot))
             new)
  (unless validp
    (error msg)))

Another alternative would be to store the evaluation of the form and pass that to the macro:

(defvar *email-validator* (CLAVIER:VALID-EMAIL "The email is invalid"))
(defun email-validator (val)
  (funcall *email-validator* val))

Then pass email-validator to defclass.

Additionally I might suggest that your validation functions signal slot-validation-error type conditions instead of error type conditions. Then your condition could contain references to the validator that failed, the value, the slot and the instance. This could give you much better control than the raw error. You could also add some restarts (abort to skip setting the slot, use-value to provide a different value).

Depending on your setup, it might also make more sense for your validation function to signal these directly instead of returning multiple values that are then coerced to signals.