[shepherd] 04/05: service: Registry explicitly has only one service with a given name.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit fc6e37c5ec46ea68437a2baf42d427a4125058c1
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Mar 22 22:47:01 2023 +0100

    service: Registry explicitly has only one service with a given name.
    
    This was already the case before but parts of the code, such as the
    'service-list' message handler in 'service-registry', maintained the
    illusion that there could be several same-named services.
    
    * modules/shepherd/service.scm (service-registry): Simplify
    'service-list' based on the assumption that there can only be one
    service for each name: registering a service with the same name as an
    existing one turns it into a "replacement" for that service.
    (lookup-canonical-service): Remove.
    (fold-services): Expect a single service in the alist returned by
    'service-list'.
---
 modules/shepherd/service.scm | 33 ++++++---------------------------
 1 file changed, 6 insertions(+), 27 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index ff1043d..0f97ca8 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -1012,21 +1012,8 @@ requests arriving on @var{channel}."
                     (vhash-foldq* cons '() name registered))
        (loop registered))
       (('service-list reply)
-       (let ((names (delete-duplicates
-                     (vhash-fold (lambda (key _ result)
-                                   (cons key result))
-                                 '()
-                                 registered)
-                     eq?)))
-         (put-message reply
-                      (fold (lambda (name result)
-                              (alist-cons name
-                                          (vhash-foldq* cons '() name
-                                                        registered)
-                                          result))
-                            '()
-                            names))
-         (loop registered))))))
+       (put-message reply (vlist->list registered))
+       (loop registered)))))
 
 (define (spawn-service-registry)
   "Spawn a new service monitor fiber and return a channel to send it requests."
@@ -2113,13 +2100,6 @@ This must be paired with @code{make-systemd-destructor}."
 
 ;;; Perform actions with services:
 
-(define (lookup-canonical-service name services)
-  "Return service with canonical NAME from SERVICES list.
-Return #f if service is not found."
-  (find (lambda (service)
-          (eq? name (canonical-name service)))
-        services))
-
 (define fold-services
   (let ((reply (make-channel)))
     (lambda (proc init)
@@ -2128,11 +2108,10 @@ result.  Works in a manner akin to `fold' from SRFI-1."
       (put-message (current-registry-channel)
                    `(service-list ,reply))
       (fold (match-lambda*
-              (((name . services) result)
-               (let ((service (lookup-canonical-service name services)))
-                 (if service
-                     (proc service result)
-                     result))))
+              (((name . service) result)
+               (if (eq? name (canonical-name service))
+                   (proc service result)
+                   result)))
             init
             (get-message reply)))))