bug#65184: (modify-services … (delete …)) should delete all matching service types

bug#65184: (modify-services … (delete …)) should delete all matching service types

[Tobias Geerinckx-Rice via Bug reports for GNU Guix]

TODO: the snippet

   (modify-services %base-services
     (delete mingetty-service-type))

deletes only the first (tty1) instance of the mingetty service.  I can't 
think of a scenario where this is likely to reflect the user's 
intention.  It should delete all matching services.

A delete-first variant could be added iff there's demand.

Kind regards,

T G-R

Sent from a Web browser.  Excuse or enjoy my brevity.

bug#65184: (modify-services … (delete …)) should delete all matching service types

[Maxim Cournoyer]

Hi Brian!

Brian Cully <bjc@spork.org> writes:

> This patch reverts the behavior introduced in
> 181951207339508789b28ba7cb914f983319920f which caused ‘modify-services’
> clauses to only match a single instance of a service.
>
> We will now match all service instances when doing a deletion or update, while
> still raising an exception when trying to match against a service that does
> not exist in the services list, or which was deleted explicitly by a ‘delete’
> clause (or an update clause that returns ‘#f’ for the service).
>
> Fixes: #64106
>
> * gnu/services.scm (%modify-services): New procedure.
> (modify-services): Use it.
> (apply-clauses): Add DELETED-SERVICES argument, change to modify one service
> at a time.
> * tests/services.scm
> ("modify-services: delete then modify"),
> ("modify-services: modify then delete"),
> ("modify-services: delete multiple services of the same type"),
> ("modify-services: modify multiple services of the same type"): New tests.

[...]

I've applied the following cosmetic changes:

--8<---------------cut here---------------start------------->8---
1 file changed, 20 insertions(+), 18 deletions(-)
gnu/services.scm | 38 ++++++++++++++++++++------------------

modified   gnu/services.scm
@@ -325,11 +325,13 @@ (define-syntax clause-alist
      '())))
 
 (define (apply-clauses clauses service deleted-services)
+  "Apply CLAUSES, an alist as returned by 'clause-alist', to SERVICE.  An
+exception is raised if a clause attempts to modify a service
+present in DELETED-SERVICES."
   (define (raise-if-deleted kind properties)
-    (match (find (lambda (deleted)
-                   (match deleted
-                     ((deleted-kind _)
-                      (eq? kind deleted-kind))))
+    (match (find (match-lambda
+                   ((deleted-kind _)
+                    (eq? kind deleted-kind)))
                  deleted-services)
       ((_ deleted-properties)
        (raise (make-compound-condition
@@ -344,27 +346,27 @@ (define (apply-clauses clauses service deleted-services)
 
   (match clauses
     (((kind proc properties) . rest)
-     (begin
-       (raise-if-deleted kind properties)
-       (if (eq? (and service (service-kind service))
-                kind)
-           (let ((new-service (proc service)))
-             (apply-clauses rest new-service
-                            (if new-service
-                                deleted-services
-                                (cons (list kind properties)
-                                      deleted-services))))
-           (apply-clauses rest service deleted-services))))
+     (raise-if-deleted kind properties)
+     (if (eq? (and service (service-kind service)) kind)
+         (let ((new-service (proc service)))
+           (apply-clauses rest new-service
+                          (if new-service
+                              deleted-services
+                              (cons (list kind properties)
+                                    deleted-services))))
+         (apply-clauses rest service deleted-services)))
     (()
      service)))
 
 (define (%modify-services services clauses)
+  "Apply CLAUSES, an alist as returned by 'clause-alist', to SERVICES.  An
+exception is raised if a clause attempts to modify a missing service."
   (define (raise-if-not-found clause)
     (match clause
       ((kind _ properties)
-       (when (not (find (lambda (service)
-                          (eq? kind (service-kind service)))
-                        services))
+       (unless (find (lambda (service)
+                       (eq? kind (service-kind service)))
+                     services)
          (raise (make-compound-condition
                  (condition
                   (&error-location
--8<---------------cut here---------------end--------------->8---

and installed it.  Thanks for contributing to Guix!

-- 
Thanks,
Maxim