Browse Source

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.
gn-latest-20200428
Ludovic Courtès 6 years ago
parent
commit
80a6773483
2 changed files with 43 additions and 1 deletions
  1. +33
    -1
      gnu/services/dmd.scm
  2. +10
    -0
      tests/services.scm

+ 33
- 1
gnu/services/dmd.scm View File

@ -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

+ 10
- 0
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 @@
(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)


Loading…
Cancel
Save