summaryrefslogtreecommitdiff
path: root/guix/graph.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-11-21 14:48:34 +0100
committerLudovic Courtès <ludo@gnu.org>2015-11-21 16:26:43 +0100
commit923d846c4dfe0f51357d3329697f54c779148dde (patch)
tree7a976f7d38f241d285d005881f17133e9032751b /guix/graph.scm
parent8fb583714f78d1b283523ef7edbb6e098946182f (diff)
graph: Add procedures to query a node's edges.
* guix/graph.scm (%node-edges, node-edges, node-back-edges) (node-transitive-edges): New procedures. * tests/graph.scm ("node-edges") ("node-transitive-edges + node-back-edges"): New tests.
Diffstat (limited to 'guix/graph.scm')
-rw-r--r--guix/graph.scm55
1 files changed, 55 insertions, 0 deletions
diff --git a/guix/graph.scm b/guix/graph.scm
index 05325ba0a6..a39208e7f9 100644
--- a/guix/graph.scm
+++ b/guix/graph.scm
@@ -21,8 +21,11 @@
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix sets)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-26)
#:use-module (ice-9 match)
+ #:use-module (ice-9 vlist)
#:export (node-type
node-type?
node-type-identifier
@@ -32,6 +35,10 @@
node-type-name
node-type-description
+ node-edges
+ node-back-edges
+ node-transitive-edges
+
%graphviz-backend
graph-backend?
graph-backend
@@ -63,6 +70,54 @@
(name node-type-name) ;string
(description node-type-description)) ;string
+(define (%node-edges type nodes cons-edge)
+ (with-monad %store-monad
+ (match type
+ (($ <node-type> identifier label node-edges)
+ (define (add-edge node edges)
+ (>>= (node-edges node)
+ (lambda (nodes)
+ (return (fold (cut cons-edge node <> <>)
+ edges nodes)))))
+
+ (mlet %store-monad ((edges (foldm %store-monad
+ add-edge vlist-null nodes)))
+ (return (lambda (node)
+ (reverse (vhash-foldq* cons '() node edges)))))))))
+
+(define (node-edges type nodes)
+ "Return, as a monadic value, a one-argument procedure that, given a node of TYPE,
+returns its edges. NODES is taken to be the sinks of the global graph."
+ (%node-edges type nodes
+ (lambda (source target edges)
+ (vhash-consq source target edges))))
+
+(define (node-back-edges type nodes)
+ "Return, as a monadic value, a one-argument procedure that, given a node of TYPE,
+returns its back edges. NODES is taken to be the sinks of the global graph."
+ (%node-edges type nodes
+ (lambda (source target edges)
+ (vhash-consq target source edges))))
+
+(define (node-transitive-edges nodes node-edges)
+ "Return the list of nodes directly or indirectly connected to NODES
+according to the NODE-EDGES procedure. NODE-EDGES must be a one-argument
+procedure that, given a node, returns its list of direct dependents; it is
+typically returned by 'node-edges' or 'node-back-edges'."
+ (let loop ((nodes (append-map node-edges nodes))
+ (result '())
+ (visited (setq)))
+ (match nodes
+ (()
+ result)
+ ((head . tail)
+ (if (set-contains? visited head)
+ (loop tail result visited)
+ (let ((edges (node-edges head)))
+ (loop (append edges tail)
+ (cons head result)
+ (set-insert head visited))))))))
+
;;;
;;; Graphviz export.