[cells-devel] Cells: Controlling the way kids are added to a parent ...
Hi - I want to control if a kid is added to a parent based on the execution of a check function. The check function is supposed to throw an condition when the check fails. Current use case: Control which classes of kids are added to a parent. I do have a model of class BOM (bill of material) that only can accept classes Assembly and Part as kids. I found two places at which I could insert a call to the check function: function fm-kid-add (higher level interface) function fm-kid-insert (lower level interface) Question now is: Why would one be better than the other? Idea here is based on adding a new slot to class family: (defmodel family (model) ((.kid-slots :cell nil :initform nil :accessor kid-slots :initarg :kid-slots) (.kids :initform (c-in nil) ;; most useful :owning t :accessor kids :initarg :kids) (registry? :cell nil :initform nil :initarg :registry? :accessor registry?) (registry :cell nil :initform nil :accessor registry) ;; added: frgo, 2008-10-30 ----- (kid-add-control-hook :cell nil :initform nil :initarg: kid-add-control-hook))) and then do run the check functions that have been added to the control hook (= list of functions to be funcalled). Right approach? Any comments? (It works but I'd like to know if am on the right track). Thanks for feedback. Cheers Frank
Frank Goenninger wrote:
Hi -
I want to control if a kid is added to a parent based on the execution of a check function. The check function is supposed to throw an condition when the check fails.
Current use case:
Control which classes of kids are added to a parent. I do have a model of class BOM (bill of material) that only can accept classes Assembly and Part as kids.
I found two places at which I could insert a call to the check function:
function fm-kid-add (higher level interface) function fm-kid-insert (lower level interface)
Question now is: Why would one be better than the other?
Idea here is based on adding a new slot to class family:
(defmodel family (model) ((.kid-slots :cell nil :initform nil :accessor kid-slots :initarg :kid-slots) (.kids :initform (c-in nil) ;; most useful :owning t :accessor kids :initarg :kids) (registry? :cell nil :initform nil :initarg :registry? :accessor registry?) (registry :cell nil :initform nil :accessor registry) ;; added: frgo, 2008-10-30 ----- (kid-add-control-hook :cell nil :initform nil :initarg: kid-add-control-hook)))
and then do run the check functions that have been added to the control hook (= list of functions to be funcalled).
Right approach? Any comments? (It works but I'd like to know if am on the right track).
Thanks for feedback.
My purely engineer's reaction is that (setf .kids) is the official gateway to that slot. I actually forgot about those "fm" functions. Of course if /you/ are consistent in their use you should be OK, but how about an :around method on (setf .kids) where you check before calling call-next-method to complete the operation? If you need it to work for kids computed by rules, that might have to be (setf cells::md-slot-value) further specialized with (slot-name (eql '.kids)), but I guess we are not talking about this since you are thinking the "fm" functions are a possible solution. hth, kenny
... and again a question related to this: Suppose I have : (defmd kid-test-2 (family) (a-slot (c-in nil)) :kids (list (make-instance 'my-kid) (make-instance 'my-kid))) Now - this completely bypasses the control mechanism inserted into fm- kid-add - which is not what I wanted ;-) So, I am asking myself if it would be better to insert the check into the .kids observer ... I now have: (defmodel family (model) ((.kid-slots :cell nil :initform nil :accessor kid-slots :initarg :kid-slots) (.kids :initform (c-in nil) ;; most useful :owning t :accessor kids :initarg :kids) (registry? :cell nil :initform nil :initarg :registry? :accessor registry?) (registry :cell nil :initform nil :accessor registry) ;; added: frgo, 2008-10-30 (control-hooks :cell nil :accessor control-hooks :initform (make-hash-table :test 'eql) :initarg :control-hooks))) (defmethod get-control-hooks ((self family) hook-id) (gethash hook-id (control-hooks self))) (defmethod add-hook ((self family) id hook) (setf (gethash id (control-hooks self)) hook)) (defun call-control-hook (hook self &rest args) ;;; to be completed here ) (eval-when (:compile-time :load-toplevel) (proclaim '(inline mklist)) (if (not (fboundp 'mklist)) (defun mklist (obj) (if (listp obj) obj (list obj))))) (defun run-control-hooks (id self &rest args) (c-assert (typep self 'family)) (let ((hooks (get-control-hooks self id))) (if hooks (loop for hook in (get-control-hooks self id) collect (call-control-hook hook self args) into result finally (return (mklist result))) (mklist t)))) and (define-condition cells-adding-kid-not-allowed-error (error) ((text :initarg :text :reader text))) (defun kid-add-allowed? (fm-parent kid) (notany #'null (run-control-hooks 'fm-kid-add-control fm-parent kid))) (defun fm-kid-add (fm-parent kid &optional before) (c-assert (or (null (fm-parent kid)) (eql fm-parent (fm-parent kid)))) (c-assert (typep fm-parent 'family)) ;; Added: frgo, 2008-10-30 (if (kid-add-allowed? fm-parent kid) (progn ;; (trc "Adding kid to parent" kid fm-parent) (setf (fm-parent kid) fm-parent) (fm-kid-insert kid before)) (error 'cells-adding-kid-not-allowed-error :text (format nil "ERROR: Kid ~s not allowed for parent ~s." kid fm-parent)))) - which is incomplete, of course, but shows the basic idea, or so I hope. Any thoughts if I should use the observer or do some clever slot trickery using MOP ? Thanks for feedback! Regards Frank Am 30.10.2008 um 13:15 schrieb Frank Goenninger:
* PGP Signed: 10/30/08 at 13:15:51
Hi -
I want to control if a kid is added to a parent based on the execution of a check function. The check function is supposed to throw an condition when the check fails.
Current use case:
Control which classes of kids are added to a parent. I do have a model of class BOM (bill of material) that only can accept classes Assembly and Part as kids.
I found two places at which I could insert a call to the check function:
function fm-kid-add (higher level interface) function fm-kid-insert (lower level interface)
Question now is: Why would one be better than the other?
Idea here is based on adding a new slot to class family:
(defmodel family (model) ((.kid-slots :cell nil :initform nil :accessor kid-slots :initarg :kid-slots) (.kids :initform (c-in nil) ;; most useful :owning t :accessor kids :initarg :kids) (registry? :cell nil :initform nil :initarg :registry? :accessor registry?) (registry :cell nil :initform nil :accessor registry) ;; added: frgo, 2008-10-30 ----- (kid-add-control-hook :cell nil :initform nil :initarg: kid-add-control-hook)))
and then do run the check functions that have been added to the control hook (= list of functions to be funcalled).
Right approach? Any comments? (It works but I'd like to know if am on the right track).
Thanks for feedback.
Cheers Frank
* Frank Goenninger <frgo@me.com> * 0xE6BDA9B9:0x6AEA9601 _______________________________________________ cells-devel site list cells-devel@common-lisp.net http://common-lisp.net/mailman/listinfo/cells-devel
* PGP Signed: 10/30/08 at 13:15:51 * text/plain body * Frank Goenninger <frgo@me.com> * 0xE6BDA9B9:0x6AEA9601
[hmmm... did you get my other response? This is a diff question, but you did not mention my other so I am concenred.] Frank Goenninger wrote:
... and again a question related to this:
Suppose I have :
(defmd kid-test-2 (family) (a-slot (c-in nil)) :kids (list (make-instance 'my-kid) (make-instance 'my-kid)))
Now - this completely bypasses the control mechanism inserted into fm- kid-add - which is not what I wanted ;-)
Good point, another hole. In ACL and any CL supporting a full MOP, btw, you can supply an around method to (setf slot-value-using-class) which is the implementation of (setf slot-value) and /really/ control access. Anyway...
So, I am asking myself if it would be better to insert the check into the .kids observer ...
One big concern I have is, is this too late? Do you have any requirement to stop these sooner? ie, If you want to signal a condition that is fine, but recovering from it means also backing out the change and /that/ would be a lot of work at the late stage when the observer gets called.
I now have:
(defmodel family (model) ((.kid-slots :cell nil :initform nil :accessor kid-slots :initarg :kid-slots) (.kids :initform (c-in nil) ;; most useful :owning t :accessor kids :initarg :kids) (registry? :cell nil :initform nil :initarg :registry? :accessor registry?) (registry :cell nil :initform nil :accessor registry) ;; added: frgo, 2008-10-30 (control-hooks :cell nil :accessor control-hooks :initform (make-hash-table :test 'eql) :initarg :control-hooks)))
(defmethod get-control-hooks ((self family) hook-id) (gethash hook-id (control-hooks self)))
(defmethod add-hook ((self family) id hook) (setf (gethash id (control-hooks self)) hook))
(defun call-control-hook (hook self &rest args) ;;; to be completed here )
(eval-when (:compile-time :load-toplevel) (proclaim '(inline mklist)) (if (not (fboundp 'mklist)) (defun mklist (obj) (if (listp obj) obj (list obj)))))
(defun run-control-hooks (id self &rest args) (c-assert (typep self 'family)) (let ((hooks (get-control-hooks self id))) (if hooks (loop for hook in (get-control-hooks self id) collect (call-control-hook hook self args) into result finally (return (mklist result))) (mklist t))))
and
(define-condition cells-adding-kid-not-allowed-error (error) ((text :initarg :text :reader text)))
(defun kid-add-allowed? (fm-parent kid) (notany #'null (run-control-hooks 'fm-kid-add-control fm-parent kid)))
(defun fm-kid-add (fm-parent kid &optional before) (c-assert (or (null (fm-parent kid)) (eql fm-parent (fm-parent kid)))) (c-assert (typep fm-parent 'family)) ;; Added: frgo, 2008-10-30 (if (kid-add-allowed? fm-parent kid) (progn ;; (trc "Adding kid to parent" kid fm-parent) (setf (fm-parent kid) fm-parent) (fm-kid-insert kid before)) (error 'cells-adding-kid-not-allowed-error :text (format nil "ERROR: Kid ~s not allowed for parent ~s." kid fm-parent))))
- which is incomplete, of course, but shows the basic idea, or so I hope.
Any thoughts if I should use the observer or do some clever slot trickery using MOP ?
Ah, you were way ahead of me. The observer might be too late if you want this to be recoverable. kt
Am 31.10.2008 um 00:16 schrieb Kenny Tilton:
[hmmm... did you get my other response? This is a diff question, but you did not mention my other so I am concenred.]
No, I actually didn't.
Frank Goenninger wrote:
... and again a question related to this: Suppose I have : (defmd kid-test-2 (family) (a-slot (c-in nil)) :kids (list (make-instance 'my-kid) (make-instance 'my-kid))) Now - this completely bypasses the control mechanism inserted into fm- kid-add - which is not what I wanted ;-)
Good point, another hole. In ACL and any CL supporting a full MOP, btw, you can supply an around method to (setf slot-value-using- class) which is the implementation of (setf slot-value) and /really/ control access. Anyway...
So, I am asking myself if it would be better to insert the check into the .kids observer ...
One big concern I have is, is this too late? Do you have any requirement to stop these sooner? ie, If you want to signal a condition that is fine, but recovering from it means also backing out the change and /that/ would be a lot of work at the late stage when the observer gets called.
Ok. Understood. I will try the s-v-u-c approach ... Thanks! Regards, Frank
participants (2)
-
Frank Goenninger -
Kenny Tilton