bug#64106: [PATCH] In modify-services, delete multiple services with one stanza. (Closes: #63921, #64106)

[Felix Lechner via Bug reports for GNU Guix <bug-guix@gnu.org>]

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))))))
 
 \f
 ;;;

base-commit: 269cfe341f242c2b5f37774cb9b1e17d9aa68e2c
-- 
2.40.1