diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-10-14 18:40:33 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-10-14 21:39:06 +0200 |
| commit | 80a67734834a0981ca65cf1757a7d8408d02f1fd (patch) | |
| tree | 4f622b3c5a725544736a75eaee52c6b4db6b29e0 | |
| parent | c5d735f798e0e58774b9ce0c6197695bc6f0daa9 (diff) | |
| download | gnu-guix-80a67734834a0981ca65cf1757a7d8408d02f1fd.tar gnu-guix-80a67734834a0981ca65cf1757a7d8408d02f1fd.tar.gz | |
services: Add 'dmd-service-back-edges'.
* gnu/services/dmd.scm (dmd-service-back-edges): New procedure.
* tests/services.scm ("dmd-service-back-edges"): New test.
| -rw-r--r-- | gnu/services/dmd.scm | 34 | ||||
| -rw-r--r-- | tests/services.scm | 10 |
2 files changed, 43 insertions, 1 deletions
diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm index 7b6434a0ae..e87b9e4415 100644 --- a/gnu/services/dmd.scm +++ b/gnu/services/dmd.scm @@ -27,7 +27,9 @@ #: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 @@ 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 @@ failure." (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 diff --git a/tests/services.scm b/tests/services.scm index ae2d999fee..7d2e31b3a9 100644 --- a/tests/services.scm +++ b/tests/services.scm @@ -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 @@ (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) |