diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-11-08 13:26:08 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-11-08 22:31:58 +0100 |
| commit | 49483f71381ad32cdbe81b1c8ed2cc023329cc18 (patch) | |
| tree | fc5c0bd7a626e2c1d5f505b00dc1201a3dd98c1c | |
| parent | 3943913faca20854453cb873144e2844a07ac31f (diff) | |
| download | gnu-guix-49483f71381ad32cdbe81b1c8ed2cc023329cc18.tar gnu-guix-49483f71381ad32cdbe81b1c8ed2cc023329cc18.tar.gz | |
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.scm | 11 | ||||
| -rw-r--r-- | tests/services.scm | 10 |
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) |