Пользовательские параметры слота не применяют никакого сокращения к его аргументу

Question

Скажите, если я определю метакласс, который расширяет стандартные слоты с помощью слота валидатора, когда я передаю :validator (clavier:valid-email "The email is invalid") в качестве опции, вместо сохранения результата выражения, которое является функциональным, оно сохраняет само выражение. Я пропускаю шаг при расширении стандартных слотов? Как мне убедиться, что выражение вычислено перед сохранением? Я использую SBCL 1.2.11 кстати. Вот код, о котором идет речь

(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 "[e-mail]")))
  (setf (email pepe) "FU!")) ;; should throw

При создании экземпляра происходит сбой кода, так как (CLAVIER:VALID-EMAIL "E-mail неверный") не является функциональным вызовом.

 (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

Как сказано в комментарии выше, defclass не оценивает аргументы (это макрос). Хотя обычный совет - избегать eval, я думаю, что eval в этих условиях может быть именно тем, что вы хотите. В то время как обычно вы бы разделяли форму непосредственно на некоторое тело макроса, с помощью defclass я думаю, что ответом является оценка формы при инициализации слота и сохранение оценки (если она еще не была проверена).

Это может произойти в:

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

При желании вы также можете хранить :validation-message а также :validation-fn в качестве двух отдельных аргументов затем вызвать:

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

Другой вариант - сохранить оценку формы и передать ее в макрос:

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

Тогда пройдите email-validator дефклассировать.

Кроме того, я могу предположить, что ваши функции проверки сигнализируют slot-validation-error введите условия вместо error Типовые условия. Тогда ваше условие может содержать ссылки на сбойный валидатор, значение, слот и экземпляр. Это может дать вам гораздо лучший контроль, чем грубая ошибка. Вы также можете добавить некоторые перезапуски (прервать, чтобы пропустить настройку слота, используйте значение для предоставления другого значения).

В зависимости от вашей настройки для вашей функции проверки также может иметь больше смысла сигнализировать об этом напрямую, а не возвращать несколько значений, которые затем приводятся к сигналам.