services: Add 'lookup-service-types'.
* gnu/services.scm (lookup-service-types): New procedure. * tests/services.scm ("lookup-service-types"): New test.
This commit is contained in:
parent
3943913fac
commit
49483f7138
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue