diff mbox series

[bug#63538,v2,3/3] gnu: services: Error in MODIFY-SERVICES when services don't exist

Message ID 13ab94bbed475a933d8376ad8fc166c6ad124b67.1685140217.git.bjc@spork.org
State New
Headers show
Series [bug#63538,v2,1/3] tests: Add tests for MODIFY-SERVICES procedure | expand

Commit Message

Brian Cully May 26, 2023, 10:30 p.m. UTC 
This patch causes MODIFY-SERVICES to raise an error if a reference is made to
a service which isn't in its service list. This it to help users notice if
they have an invalid rule, which is currently silently ignored.

* gnu/services.scm (%delete-service):  new procedure
(%apply-clauses): new syntax rule
(%modify-service): remove syntax rule
---
 gnu/services.scm | 47 ++++++++++++++++++++++++++++++-----------------
 1 file changed, 30 insertions(+), 17 deletions(-)
diff mbox series

Patch

diff --git a/gnu/services.scm b/gnu/services.scm
index 31eba9f035..a58cffe536 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -296,20 +296,35 @@  (define (simple-service name target value)
                                   (description "This is a simple service."))))
     (service type value)))
 
-(define-syntax %modify-service
+(define (%delete-service kind services)
+  (let loop ((found #f)
+             (return '())
+             (services services))
+    (match services
+      ('()
+       (if found
+           (values return found)
+           (raise (formatted-message
+                   (G_ "modify-services: service '~a' not found in service list")
+                   (service-type-name kind)))))
+      ((svc . rest)
+       (if (eq? (service-kind svc) kind)
+           (loop svc return rest)
+           (loop found (cons svc return) rest))))))
+
+(define-syntax %apply-clauses
   (syntax-rules (=> delete)
-    ((_ svc (delete kind) clauses ...)
-     (if (eq? (service-kind svc) kind)
-         #f
-         (%modify-service svc clauses ...)))
-    ((_ service)
-     service)
-    ((_ svc (kind param => exp ...) clauses ...)
-     (if (eq? (service-kind svc) kind)
-         (let ((param (service-value svc)))
-           (service (service-kind svc)
-                    (begin exp ...)))
-         (%modify-service svc clauses ...)))))
+    ((_ ((delete kind) . rest) services)
+     (%apply-clauses rest (%delete-service kind services)))
+    ((_ ((kind param => exp ...) . rest) services)
+     (call-with-values (lambda () (%delete-service kind services))
+       (lambda (svcs found)
+         (let ((param (service-value found)))
+           (cons (service (service-kind found)
+                          (begin exp ...))
+                 (%apply-clauses rest svcs))))))
+    ((_ () services)
+     services)))
 
 (define-syntax modify-services
   (syntax-rules ()
@@ -345,10 +360,8 @@  (define-syntax modify-services
 UDEV-SERVICE-TYPE.
 
 This is a shorthand for (filter-map (lambda (svc) ...) %base-services)."
-    ((_ services clauses ...)
-     (filter-map (lambda (service)
-                   (%modify-service service clauses ...))
-                 services))))
+    ((_ services . clauses)
+     (%apply-clauses clauses services))))
 
 
 ;;;