With this commit, modify-services will delete all instances of the services that match the indicated service-type. At the same time, it will also raise errors for misconfigurations.
The patch was motivated by Brian Cully's statements about the difficult tradeoff here. [1] Using the changes respectfully submitted there, modify-services will extract the "delete" clauses from the clause-alist via code inspired by SRFI-1's lset-difference. It applies those deletions first, before then passing the remaining clauses (and the remaining services) on to apply-clauses. It is possible that apply-clauses can also be simplified since the "delete" case is now gone, but I remain unsure about how to do that. This commit was lightly tested on a production machine. The author owes a deep debt of gratitude to Zipheir from the IRC channel Libera:#scheme for their expert help in understanding the problem and in coming up with an elegant solution. Similarly, Bruno Victal (aka mirai) provided major encouragment with his participation in the same conversation. Thank you to both of you! [1] https://issues.guix.gnu.org/64106#4 * gnu/services.scm: In modify-services, delete multiple services with one stanza. (Closes: #63921, #64106) --- gnu/services.scm | 38 +++++++++++++++++++++++++++++++++++--- 1 file changed, 35 insertions(+), 3 deletions(-) diff --git a/gnu/services.scm b/gnu/services.scm index 109e050a23..f3772ad6b9 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -46,6 +46,7 @@ (define-module (gnu services) #:use-module (gnu packages hurd) #:use-module (gnu system setuid) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-8) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-26) @@ -305,8 +306,7 @@ (define-syntax clause-alist is the source location information." ((_ (delete kind) rest ...) (cons (list kind - (lambda (service) - #f) + #f (current-source-location)) (clause-alist rest ...))) ((_ (kind param => exp ...) rest ...) @@ -320,6 +320,16 @@ (define-syntax clause-alist ((_) '()))) +(define (clause-kind clause) + (match clause + ((kind _ _) + kind))) + +(define (clause-proc clause) + (match clause + ((_ proc _) + proc))) + (define (apply-clauses clauses services) "Apply CLAUSES, an alist as returned by 'clause-alist', to SERVICES, a list of services. Use each clause at most once; raise an error if a clause was not @@ -393,7 +403,29 @@ (define-syntax modify-services all the MINGETTY-SERVICE-TYPE instances, and it deletes instances of the UDEV-SERVICE-TYPE." ((_ services clauses ...) - (apply-clauses (clause-alist clauses ...) services)))) + (receive (others deletes) (partition clause-proc (clause-alist clauses ...)) + (let ((reduced-services (remove (lambda (service) + (find (lambda (clause) + (eq? (clause-kind clause) + (service-kind service))) + deletes)) + services)) + (deletes-not-found (remove (lambda (clause) + (find (lambda (service) + (eq? (clause-kind clause) + (service-kind service))) + services)) + deletes))) + (for-each (lambda (clause) + (raise (make-compound-condition + (condition + (&error-location + (location (current-source-location)))) + (formatted-message + (G_ "modify-services: cannot delete '~a'; not present in service list") + (service-type-name (clause-kind clause)))))) + deletes-not-found) + (apply-clauses others reduced-services)))))) ;;; base-commit: 269cfe341f242c2b5f37774cb9b1e17d9aa68e2c -- 2.40.1