From 80a67734834a0981ca65cf1757a7d8408d02f1fd Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 14 Oct 2015 18:40:33 +0200
Subject: 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.
---
 gnu/services/dmd.scm | 34 +++++++++++++++++++++++++++++++++-
 1 file changed, 33 insertions(+), 1 deletion(-)

(limited to 'gnu')

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
-- 
cgit 1.4.1