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