ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: Add 'lookup-service-types'.

Browse source 
* gnu/services.scm (lookup-service-types): New procedure.
* tests/services.scm ("lookup-service-types"): New test.
This commit is contained in:
Ludovic Courtès 2017-11-08 13:26:08 +01:00
parent 3943913fac
commit 49483f7138
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 20 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
gnu/services.scm
View file

@ -55,6 +55,7 @@ (define-module (gnu services)
%service-type-path
fold-service-types
lookup-service-types
service
service?
@ -192,6 +193,16 @@ (define* (fold-service-types proc seed
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)

10
tests/services.scm
View file

@ -23,7 +23,8 @@ (define-module (test-services)
#: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 @@ (define live-service
(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)