summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-11-08 13:26:08 +0100
committerLudovic Courtès <ludo@gnu.org>2017-11-08 22:31:58 +0100
commit49483f71381ad32cdbe81b1c8ed2cc023329cc18 (patch)
treefc5c0bd7a626e2c1d5f505b00dc1201a3dd98c1c
parent3943913faca20854453cb873144e2844a07ac31f (diff)
services: Add 'lookup-service-types'.
* gnu/services.scm (lookup-service-types): New procedure. * tests/services.scm ("lookup-service-types"): New test.
-rw-r--r--gnu/services.scm11
-rw-r--r--tests/services.scm10
2 files changed, 20 insertions, 1 deletions
diff --git a/gnu/services.scm b/gnu/services.scm
index df1bedeb9b..016ff08e0b 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -55,6 +55,7 @@
%service-type-path
fold-service-types
+ lookup-service-types
service
service?
@@ -192,6 +193,16 @@ is used as the initial value of RESULT."
seed
modules))
+(define lookup-service-types
+ (let ((table
+ (delay (fold-service-types (lambda (type result)
+ (vhash-consq (service-type-name type)
+ type result))
+ vlist-null))))
+ (lambda (name)
+ "Return the list of services with the given NAME (a symbol)."
+ (vhash-foldq* cons '() name (force table)))))
+
;; Services of a given type.
(define-record-type <service>
(make-service type value)
diff --git a/tests/services.scm b/tests/services.scm
index 8484ee982a..ca32b565c4 100644
--- a/tests/services.scm
+++ b/tests/services.scm
@@ -23,7 +23,8 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
- #:use-module (srfi srfi-64))
+ #:use-module (srfi srfi-64)
+ #:use-module (ice-9 match))
(define live-service
(@@ (gnu services herd) live-service))
@@ -206,4 +207,11 @@
(list (map live-service-provision unload)
(map shepherd-service-provision load)))))
+(test-eq "lookup-service-types"
+ system-service-type
+ (and (null? (lookup-service-types 'does-not-exist-at-all))
+ (match (lookup-service-types 'system)
+ ((one) one)
+ (x x))))
+
(test-end)