Browse Source

services: Add 'lookup-service-types'.

* gnu/services.scm (lookup-service-types): New procedure.
* tests/services.scm ("lookup-service-types"): New test.
gn-latest-20200428
Ludovic Courtès 4 years ago
parent
commit
49483f7138
No known key found for this signature in database GPG Key ID: 90B11993D9AEBB5
  1. 11
      gnu/services.scm
  2. 10
      tests/services.scm

11
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)

10
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)
Loading…
Cancel
Save