diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-19 18:48:12 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-19 19:07:08 -0700 |
| commit | 1b6a8a54da3941fb22ade17836c7ab1608422450 (patch) | |
| tree | 96bf7390e8f3938a50b04aef2943ae81fa9fa1fb /src/propspec.lisp | |
| parent | 80b49b8eed4cd8c45fc7a971ff572d47d3ab9c88 (diff) | |
| download | consfigurator-1b6a8a54da3941fb22ade17836c7ab1608422450.tar.gz | |
implement unapplying SEQPROPS, ESEQPROPS, SILENT-SEQPROPS
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
Diffstat (limited to 'src/propspec.lisp')
| -rw-r--r-- | src/propspec.lisp | 22 |
1 files changed, 15 insertions, 7 deletions
diff --git a/src/propspec.lisp b/src/propspec.lisp index 5979187..db8f81e 100644 --- a/src/propspec.lisp +++ b/src/propspec.lisp @@ -287,14 +287,18 @@ expression." (define-function-property-combinator eseqprops (&rest propapps) (:retprop :type (collapse-types (mapcar #'propapptype propapps)) :hostattrs (lambda () (mapc #'propappattrs propapps)) - :apply (lambda () (apply-and-print propapps)))) + :apply (lambda () (apply-and-print propapps)) + :unapply (lambda () (apply-and-print propapps t)))) (define-function-property-combinator seqprops (&rest propapps) (:retprop :type (collapse-types (mapcar #'propapptype propapps)) :hostattrs (lambda () (mapc #'propappattrs propapps)) :apply (lambda () (with-skip-failed-changes - (apply-and-print propapps))))) + (apply-and-print propapps))) + :unapply (lambda () + (with-skip-failed-changes + (apply-and-print propapps t))))) (defmacro with-requirements (propapp &body requirements) "Apply PROPAPP only after applying each dependency in REQUIREMENTS. @@ -307,20 +311,24 @@ apply the elements of REQUIREMENTS in reverse order." :hostattrs (lambda () (mapc #'propappattrs propapps)) :apply (lambda () (with-skip-failed-changes - (mapc #'propappapply propapps))))) + (mapc #'propappapply propapps))) + :unapply (lambda () + (with-skip-failed-changes + (mapc #'propappunapply (reverse propapps)))))) ;; note that the :FAILED-CHANGE value is only used within this function and ;; should not be returned by property subroutines, per the spec -(defun apply-and-print (propapps) - (dolist (propapp propapps) - (let* ((result (restart-case (propappapply propapp) +(defun apply-and-print (propapps &optional unapply) + (dolist (pa (if unapply (reverse propapps) propapps)) + (let* ((result (restart-case + (if unapply (propappunapply pa) (propappapply pa)) (skip-property () :failed-change))) (status (case result (:no-change "ok") (:failed-change "failed") (t "done")))) (format t "~@[~A :: ~]~@[~A ... ~]~A~%" - (get-hostname) (propappdesc propapp) status)))) + (get-hostname) (propappdesc pa) status)))) (define-function-property-combinator unapply (propapp) (destructuring-bind (psym . args) propapp |