[shepherd] 02/03: service: Replace 'lookup-services' with 'lookup-service' (singular).

[Ludovic Courtès]

civodul pushed a commit to branch wip-goopsless
in repository shepherd.

commit 602b30adcdafe8e2cff47de69fd0625eba7846ff
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Apr 8 18:25:51 2023 +0200

    service: Replace 'lookup-services' with 'lookup-service' (singular).
    
    This is a followup to 7e206fbad57578f67d34ff1804880ae099f10b01.
    
    * modules/shepherd/service.scm (lookup-service): New procedure.
    (lookup-services): Rewrite and deprecate.
    (service-registry): Change 'lookup' reply to use 'vhash-assq' instead of
    'vhash-foldq*'.
    * doc/shepherd.texi (Service Convenience): Update accordingly.
---
 doc/shepherd.texi            |  5 ++---
 modules/shepherd/service.scm | 26 ++++++++++++++++++++------
 2 files changed, 22 insertions(+), 9 deletions(-)

diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index 56200d6..e7a1dbd 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -813,9 +813,8 @@ Register all @var{services}, so that they can be taken into 
account
 when trying to resolve dependencies.
 @end deffn
 
-@deffn {procedure} lookup-services name
-Return a list of all registered services which provide the symbol
-@var{name}.
+@deffn {procedure} lookup-service name
+Return the service that provides @var{name}, @code{#f} if there is none.
 @end deffn
 
 @deffn {macro} make-actions (name proc) ...
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index f0acfbc..d07add7 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -82,7 +82,6 @@
             lookup-running
             lookup-running-or-providing
             for-each-service
-            lookup-services
             respawn-service
             handle-SIGCHLD
             with-process-monitor
@@ -144,7 +143,7 @@
 
             get-message*                      ;XXX: for lack of a better place
 
-            ;; Deprecated GOOPS methods.
+            ;; Deprecated bindings.
             provided-by
             required-by
             one-shot?
@@ -158,7 +157,8 @@
             disable
             action-list
             lookup-action
-            defines-action?))
+            defines-action?
+            lookup-services))
 
 
 (define sleep (@ (fibers) sleep))
@@ -996,6 +996,9 @@ requests arriving on @var{channel}."
 
     (match (get-message channel)
       (('register service)                        ;no reply
+       ;; Register SERVICE or, if its name is provided by an
+       ;; already-registered service, make it a replacement for that service.
+       ;; There cannot be two services providing the same name.
        (match (any (lambda (name)
                      (vhash-assq name registered))
                    (service-provision service))
@@ -1026,8 +1029,11 @@ requests arriving on @var{channel}."
                      vlist-null
                      (service-provision root)))))
       (('lookup name reply)
+       ;; Look up NAME and return it, or #f, to REPLY.
        (put-message reply
-                    (vhash-foldq* cons '() name registered))
+                    (match (vhash-assq name registered)
+                      (#f #f)
+                      ((_ . service) service)))
        (loop registered))
       (('service-list reply)
        (put-message reply (vlist->list registered))
@@ -2179,13 +2185,21 @@ returned in unspecified."
                                (return service)))
                         #f))))))
 
-(define lookup-services
+(define lookup-service
   (let ((reply (make-channel)))
     (lambda (name)
-      "Return a (possibly empty) list of services that provide NAME."
+      "Return the service that provides @var{name}, @code{#f} if there is 
none."
       (put-message (current-registry-channel) `(lookup ,name ,reply))
       (get-message reply))))
 
+(define (lookup-services name)
+  "Deprecated.  Use @code{lookup-service} instead."
+  (issue-deprecation-warning "The 'lookup-services' procedure is deprecated; \
+use 'lookup-service' instead.")
+  (match (lookup-service name)
+    (#f '())
+    (service (list service))))
+
 (define waitpid*
   (lambda (what flags)
     "Like 'waitpid', and return (0 . _) when there's no child left."