自定义插槽选项不会对其参数应用任何缩减
Custom slot options don't apply any reduction to its argument
假设我定义了一个元类,它使用验证器插槽增强了标准插槽,当我将 :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 "pepe@tumadre.com")))
(setf (email pepe) "FU!")) ;; should throw
创建实例时代码失败,因为 (CLAVIER:VALID-EMAIL "The email is invalid") 不是函数调用。
(CLAVIER:VALID-EMAIL
"The email is invalid") fell through ETYPECASE expression.
Wanted one of (FUNCTION SYMBOL).
[Condition of type SB-KERNEL:CASE-FAILURE]
正如上面的评论所说,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
传递给defclass。
此外,我可能建议您的验证函数发出 slot-validation-error
类型条件信号,而不是 error
类型条件信号。然后您的条件可能包含对失败的验证器、值、插槽和实例的引用。与原始错误相比,这可以为您提供更好的控制。您还可以添加一些重启(中止以跳过设置插槽,使用值以提供不同的值)。
根据您的设置,您的验证函数直接向这些信号发送信号可能更有意义,而不是返回多个值,然后将这些值强制转换为信号。
假设我定义了一个元类,它使用验证器插槽增强了标准插槽,当我将 :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 "pepe@tumadre.com")))
(setf (email pepe) "FU!")) ;; should throw
创建实例时代码失败,因为 (CLAVIER:VALID-EMAIL "The email is invalid") 不是函数调用。
(CLAVIER:VALID-EMAIL
"The email is invalid") fell through ETYPECASE expression.
Wanted one of (FUNCTION SYMBOL).
[Condition of type SB-KERNEL:CASE-FAILURE]
正如上面的评论所说,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
传递给defclass。
此外,我可能建议您的验证函数发出 slot-validation-error
类型条件信号,而不是 error
类型条件信号。然后您的条件可能包含对失败的验证器、值、插槽和实例的引用。与原始错误相比,这可以为您提供更好的控制。您还可以添加一些重启(中止以跳过设置插槽,使用值以提供不同的值)。
根据您的设置,您的验证函数直接向这些信号发送信号可能更有意义,而不是返回多个值,然后将这些值强制转换为信号。