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

services: Add 'dmd-service-back-edges'.

Browse source 
* gnu/services/dmd.scm (dmd-service-back-edges): New procedure.
* tests/services.scm ("dmd-service-back-edges"): New test.
This commit is contained in:
Ludovic Courtès 2015-10-14 18:40:33 +02:00
parent c5d735f798
commit 80a6773483
2 changed files with 43 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
gnu/services/dmd.scm
View file

@ -27,7 +27,9 @@ (define-module (gnu services dmd)
#:use-module (gnu services)
#:use-module (gnu packages admin)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:export (dmd-root-service-type
@ -42,7 +44,9 @@ (define-module (gnu services dmd)
dmd-service-respawn?
dmd-service-start
dmd-service-stop
dmd-service-auto-start?))
dmd-service-auto-start?
dmd-service-back-edges))
;;; Commentary:
;;;
@ -179,4 +183,32 @@ (define config
(gexp->file "dmd.conf" config)))
(define (dmd-service-back-edges services)
"Return a procedure that, when given a <dmd-service> from SERVICES, returns
the list of <dmd-service> that depend on it."
(define provision->service
(let ((services (fold (lambda (service result)
(fold (cut vhash-consq <> service <>)
result
(dmd-service-provision service)))
vlist-null
services)))
(lambda (name)
(match (vhash-assq name services)
((_ . service) service)
(#f #f)))))
(define edges
(fold (lambda (service edges)
(fold (lambda (requirement edges)
(vhash-consq (provision->service requirement) service
edges))
edges
(dmd-service-requirement service)))
vlist-null
services))
(lambda (service)
(vhash-foldq* cons '() service edges)))
;;; dmd.scm ends here

10
tests/services.scm
View file

@ -18,6 +18,7 @@
(define-module (test-services)
#:use-module (gnu services)
#:use-module (gnu services dmd)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
@ -104,6 +105,15 @@ (define-module (test-services)
(fold-services (list s) #:target-type t1)
#f)))
(test-assert "dmd-service-back-edges"
(let* ((s1 (dmd-service (provision '(s1)) (start #f)))
(s2 (dmd-service (provision '(s2)) (requirement '(s1)) (start #f)))
(s3 (dmd-service (provision '(s3)) (requirement '(s1 s2)) (start #f)))
(e (dmd-service-back-edges (list s1 s2 s3))))
(and (lset= eq? (e s1) (list s2 s3))
(lset= eq? (e s2) (list s3))
(null? (e s3)))))
(test-end)