TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

services: shepherd: Add 'shepherd-service-lookup-procedure'. 

* gnu/services/shepherd.scm (shepherd-service-lookup-procedure): New
procedure.
(shepherd-service-back-edges)[provision->service]: Use it.
* tests/services.scm ("shepherd-service-lookup-procedure"): New test.
This commit is contained in:
Ludovic Courtès 2016-08-31 12:38:38 +02:00
parent b8692e4696
commit a5d78eb64b
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 30 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
gnu/services/shepherd.scm
View File

@ -52,6 +52,7 @@
shepherd-service-file
shepherd-service-lookup-procedure
shepherd-service-back-edges))
;;; Commentary:
@ -249,20 +250,29 @@ stored."
(gexp->file "shepherd.conf" config)))
(define* (shepherd-service-lookup-procedure services
#:optional
(provision
shepherd-service-provision))
"Return a procedure that, when passed a symbol, return the item among
SERVICES that provides this symbol. PROVISION must be a one-argument
procedure that takes a service and returns the list of symbols it provides."
(let ((services (fold (lambda (service result)
(fold (cut vhash-consq <> service <>)
result
(provision service)))
vlist-null
services)))
(lambda (name)
(match (vhash-assq name services)
((_ . service) service)
(#f #f)))))
(define (shepherd-service-back-edges services)
"Return a procedure that, when given a <shepherd-service> from SERVICES,
returns the list of <shepherd-service> that depend on it."
(define provision->service
(let ((services (fold (lambda (service result)
(fold (cut vhash-consq <> service <>)
result
(shepherd-service-provision service)))
vlist-null
services)))
(lambda (name)
(match (vhash-assq name services)
((_ . service) service)
(#f #f)))))
(shepherd-service-lookup-procedure services))
(define edges
(fold (lambda (service edges)

11
tests/services.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -105,6 +105,15 @@
(fold-services (list s) #:target-type t1)
#f)))
(test-assert "shepherd-service-lookup-procedure"
(let* ((s1 (shepherd-service (provision '(s1 s1b)) (start #f)))
(s2 (shepherd-service (provision '(s2 s2b)) (start #f)))
(s3 (shepherd-service (provision '(s3 s3b s3c)) (start #f)))
(lookup (shepherd-service-lookup-procedure (list s1 s2 s3))))
(and (eq? (lookup 's1) (lookup 's1b) s1)
(eq? (lookup 's2) (lookup 's2b) s2)
(eq? (lookup 's3) (lookup 's3b) s3))))
(test-assert "shepherd-service-back-edges"
(let* ((s1 (shepherd-service (provision '(s1)) (start #f)))
(s2 (shepherd-service (provision '(s2))