~ruther/guix-local

49483f71381ad32cdbe81b1c8ed2cc023329cc18 — Ludovic Courtès 8 years ago 3943913
services: Add 'lookup-service-types'.

* gnu/services.scm (lookup-service-types): New procedure.
* tests/services.scm ("lookup-service-types"): New test.
2 files changed, 20 insertions(+), 1 deletions(-)

M gnu/services.scm
M tests/services.scm
M gnu/services.scm => gnu/services.scm +11 -0
@@ 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)

M tests/services.scm => tests/services.scm +9 -1
@@ 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)