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
|
%service-type-path
|
||||||
fold-service-types
|
fold-service-types
|
||||||
|
lookup-service-types
|
||||||
|
|
||||||
service
|
service
|
||||||
service?
|
service?
|
||||||
|
@ -192,6 +193,16 @@ is used as the initial value of RESULT."
|
||||||
seed
|
seed
|
||||||
modules))
|
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.
|
;; Services of a given type.
|
||||||
(define-record-type <service>
|
(define-record-type <service>
|
||||||
(make-service type value)
|
(make-service type value)
|
||||||
|
|
|
@ -23,7 +23,8 @@
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-64))
|
#:use-module (srfi srfi-64)
|
||||||
|
#:use-module (ice-9 match))
|
||||||
|
|
||||||
(define live-service
|
(define live-service
|
||||||
(@@ (gnu services herd) live-service))
|
(@@ (gnu services herd) live-service))
|
||||||
|
@ -206,4 +207,11 @@
|
||||||
(list (map live-service-provision unload)
|
(list (map live-service-provision unload)
|
||||||
(map shepherd-service-provision load)))))
|
(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)
|
(test-end)
|
||||||
|
|
Loading…
Reference in New Issue