* bug#65184: (modify-services … (delete …)) should delete all matching service types
@ 2023-08-09 17:40 Tobias Geerinckx-Rice via Bug reports for GNU Guix
0 siblings, 0 replies; 2+ messages in thread
From: Tobias Geerinckx-Rice via Bug reports for GNU Guix @ 2023-08-09 17:40 UTC (permalink / raw)
To: 65184
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.
^ permalink raw reply [flat|nested] 2+ messages in thread
* bug#64106: `modify-services` no longer affects multiple instances of the same service
@ 2023-06-16 12:52 David Wilson
2023-07-17 17:02 ` bug#64106: [PATCH] gnu: services: Revert to deleting and updating all matching services Brian Cully via Bug reports for GNU Guix
0 siblings, 1 reply; 2+ messages in thread
From: David Wilson @ 2023-06-16 12:52 UTC (permalink / raw)
To: 64106; +Cc: Ludovic Courtès
Hi Guix!
Recently there was a change to the behavior of `modify-services` that adds logic to check for any unused clauses so that an exception can be raised to alert the user of this case.
https://git.savannah.gnu.org/cgit/guix.git/commit/?id=181951207339508789b28ba7cb914f983319920f
It seems that the new logic has a bug that prevents a used clause from being executed on more than one instance of a compatible service in a single execution of `modify-services`. Here's a new test case for `gnu/tests/services.scm` that exhibits the issue:
```
(test-equal "modify-services: delete multiple services of the same type"
'(1 3)
(let* ((t1 (service-type (name 't1)
(extensions '())
(description "")))
(t2 (service-type (name 't2)
(extensions '())
(description "")))
(t3 (service-type (name 't3)
(extensions '())
(description "")))
(services (list (service t1 1) (service t2 2)
(service t2 2) (service t3 3))))
(map service-value
(modify-services services
(delete t2)))))
```
Here's the output of the test:
```
test-name: modify-services: delete multiple services of the same type
location: /home/daviwil/Projects/Code/guix/tests/services.scm:325
source:
+ (test-equal
+ "modify-services: delete multiple services of the same type"
+ '(1 3)
+ (let* ((t1 (service-type
+ (name 't1)
+ (extensions '())
+ (description "")))
+ (t2 (service-type
+ (name 't2)
+ (extensions '())
+ (description "")))
+ (t3 (service-type
+ (name 't3)
+ (extensions '())
+ (description "")))
+ (services
+ (list (service t1 1)
+ (service t2 2)
+ (service t2 2)
+ (service t3 3))))
+ (map service-value
+ (modify-services services (delete t2)))))
expected-value: (1 3)
actual-value: (1 2 3)
result: FAIL
```
The problem occurs because of this `fold2` logic in `apply-clauses` of gnu/services.scm`:
```
(fold2 (lambda (clause service remainder)
(if service
(match clause
((kind proc properties)
(if (eq? kind (service-kind service))
(values (proc service) remainder)
(values service
(cons clause remainder)))))
(values #f (cons clause remainder))))
head
'()
clauses)))
```
In the #t case of checking the service kind, `(values (proc service remainder)` is returned, meaning the successful clause is not being added back to the list of clauses as `fold2` continues. Any subsequent items of the service list will no longer be tested against the removed clause.
I believe this function's logic needs to be updated to keep a list of successful clauses to be diffed against the full clause list at the end of `apply-clauses` so that the unapplied clause list can be determined without having to remove successful clauses in-flight.
If anyone has any pointers on the best way to approach this, I'll be happy to submit a patch!
David
^ permalink raw reply [flat|nested] 2+ messages in thread
* bug#64106: [PATCH] gnu: services: Revert to deleting and updating all matching services
2023-06-16 12:52 bug#64106: `modify-services` no longer affects multiple instances of the same service David Wilson
@ 2023-07-17 17:02 ` Brian Cully via Bug reports for GNU Guix
2023-09-01 3:49 ` bug#65184: (modify-services … (delete …)) should delete all matching service types Maxim Cournoyer
0 siblings, 1 reply; 2+ messages in thread
From: Brian Cully via Bug reports for GNU Guix @ 2023-07-17 17:02 UTC (permalink / raw)
To: 64106; +Cc: Brian Cully
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.
---
gnu/services.scm | 95 +++++++++++++++++++++++++++-------------------
tests/services.scm | 68 +++++++++++++++++++++++++++++++++
2 files changed, 124 insertions(+), 39 deletions(-)
diff --git a/gnu/services.scm b/gnu/services.scm
index 109e050a23..4c5b9b16df 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -320,45 +320,62 @@ (define-syntax clause-alist
((_)
'())))
-(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
-used."
- (let loop ((services services)
- (clauses clauses)
- (result '()))
- (match services
- (()
- (match clauses
- (() ;all clauses fired, good
- (reverse result))
- (((kind _ properties) _ ...) ;one or more clauses didn't match
- (raise (make-compound-condition
- (condition
- (&error-location
- (location (source-properties->location properties))))
- (formatted-message
- (G_ "modify-services: service '~a' not found in service list")
- (service-type-name kind)))))))
- ((head . tail)
- (let ((service clauses
- (fold2 (lambda (clause service remainder)
- (if service
- (match clause
- ((kind proc properties)
- (if (eq? kind (service-kind service))
- (values (proc service) remainder)
- (values service
- (cons clause remainder)))))
- (values #f (cons clause remainder))))
- head
+(define (apply-clauses clauses service deleted-services)
+ (define (raise-if-deleted kind properties)
+ (match (find (lambda (deleted)
+ (match deleted
+ ((deleted-kind _)
+ (eq? kind deleted-kind))))
+ deleted-services)
+ ((_ deleted-properties)
+ (raise (make-compound-condition
+ (condition
+ (&error-location
+ (location (source-properties->location properties))))
+ (formatted-message
+ (G_ "modify-services: service '~a' was deleted here: ~a")
+ (service-type-name kind)
+ (source-properties->location deleted-properties)))))
+ (_ #t)))
+
+ (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))))
+ (()
+ service)))
+
+(define (%modify-services services clauses)
+ (define (raise-if-not-found clause)
+ (match clause
+ ((kind _ properties)
+ (when (not (find (lambda (service)
+ (eq? kind (service-kind service)))
+ services))
+ (raise (make-compound-condition
+ (condition
+ (&error-location
+ (location (source-properties->location properties))))
+ (formatted-message
+ (G_ "modify-services: service '~a' not found in service list")
+ (service-type-name kind))))))))
+
+ (for-each raise-if-not-found clauses)
+ (reverse (filter-map identity
+ (fold (lambda (service services)
+ (cons (apply-clauses clauses service '())
+ services))
'()
- clauses)))
- (loop tail
- (reverse clauses)
- (if service
- (cons service result)
- result)))))))
+ services))))
(define-syntax modify-services
(syntax-rules ()
@@ -393,7 +410,7 @@ (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))))
+ (%modify-services services (clause-alist clauses ...)))))
\f
;;;
diff --git a/tests/services.scm b/tests/services.scm
index 20ff4d317e..98b584f6c0 100644
--- a/tests/services.scm
+++ b/tests/services.scm
@@ -370,4 +370,72 @@ (define-module (test-services)
(modify-services services
(t2 value => 22)))))
+(test-error "modify-services: delete then modify"
+ #t
+ (let* ((t1 (service-type (name 't1)
+ (extensions '())
+ (description "")))
+ (t2 (service-type (name 't2)
+ (extensions '())
+ (description "")))
+ (t3 (service-type (name 't3)
+ (extensions '())
+ (description "")))
+ (services (list (service t1 1) (service t2 2) (service t3 3))))
+ (map service-value
+ (modify-services services
+ (delete t2)
+ (t2 value => 22)))))
+
+(test-equal "modify-services: modify then delete"
+ '(2 3)
+ (let* ((t1 (service-type (name 't1)
+ (extensions '())
+ (description "")))
+ (t2 (service-type (name 't2)
+ (extensions '())
+ (description "")))
+ (t3 (service-type (name 't3)
+ (extensions '())
+ (description "")))
+ (services (list (service t1 1) (service t2 2) (service t3 3))))
+ (map service-value
+ (modify-services services
+ (t1 value => 11)
+ (delete t1)))))
+
+(test-equal "modify-services: delete multiple services of the same type"
+ '(1 3)
+ (let* ((t1 (service-type (name 't1)
+ (extensions '())
+ (description "")))
+ (t2 (service-type (name 't2)
+ (extensions '())
+ (description "")))
+ (t3 (service-type (name 't3)
+ (extensions '())
+ (description "")))
+ (services (list (service t1 1) (service t2 2)
+ (service t2 2) (service t3 3))))
+ (map service-value
+ (modify-services services
+ (delete t2)))))
+
+(test-equal "modify-services: modify multiple services of the same type"
+ '(1 12 13 4)
+ (let* ((t1 (service-type (name 't1)
+ (extensions '())
+ (description "")))
+ (t2 (service-type (name 't2)
+ (extensions '())
+ (description "")))
+ (t3 (service-type (name 't3)
+ (extensions '())
+ (description "")))
+ (services (list (service t1 1) (service t2 2)
+ (service t2 3) (service t3 4))))
+ (map service-value
+ (modify-services services
+ (t2 value => (+ value 10))))))
+
(test-end)
base-commit: 29a7bd209c7a37bbc0c46a18de6d81bf0569041b
--
2.41.0
^ permalink raw reply related [flat|nested] 2+ messages in thread
* bug#65184: (modify-services … (delete …)) should delete all matching service types
2023-07-17 17:02 ` bug#64106: [PATCH] gnu: services: Revert to deleting and updating all matching services Brian Cully via Bug reports for GNU Guix
@ 2023-09-01 3:49 ` Maxim Cournoyer
0 siblings, 0 replies; 2+ messages in thread
From: Maxim Cournoyer @ 2023-09-01 3:49 UTC (permalink / raw)
To: Brian Cully; +Cc: ludo, me, david, felix.lechner, 65184-done, 64106-done
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
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2023-09-01 3:51 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-08-09 17:40 bug#65184: (modify-services … (delete …)) should delete all matching service types Tobias Geerinckx-Rice via Bug reports for GNU Guix
-- strict thread matches above, loose matches on Subject: below --
2023-06-16 12:52 bug#64106: `modify-services` no longer affects multiple instances of the same service David Wilson
2023-07-17 17:02 ` bug#64106: [PATCH] gnu: services: Revert to deleting and updating all matching services Brian Cully via Bug reports for GNU Guix
2023-09-01 3:49 ` bug#65184: (modify-services … (delete …)) should delete all matching service types Maxim Cournoyer
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).