1 files changed, 65 insertions, 1 deletions
diff --git a/gnu/packages.scm b/gnu/packages.scm
index 8365a00051..77d9d3ee82 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,10 +32,16 @@
             search-bootstrap-binary
             %patch-directory
             %bootstrap-binaries-path
+
             fold-packages
+
             find-packages-by-name
             find-best-packages-by-name
-            find-newest-available-packages))
+            find-newest-available-packages
+
+            package-direct-dependents
+            package-transitive-dependents
+            package-covering-dependents))
 
 ;;; Commentary:
 ;;;
@@ -182,3 +189,60 @@ VERSION."
       (match (vhash-assoc name (find-newest-available-packages))
         ((_ version pkgs ...) pkgs)
         (#f '()))))
+
+
+(define* (vhash-refq vhash key #:optional (dflt #f))
+  "Look up KEY in the vhash VHASH, and return the value (if any) associated
+with it.  If KEY is not found, return DFLT (or `#f' if no DFLT argument is
+supplied).  Uses `eq?' for equality testing."
+  (or (and=> (vhash-assq key vhash) cdr)
+      dflt))
+
+(define package-dependencies
+  (memoize
+   (lambda ()
+     "Return a vhash keyed by package, and with associated values that are a
+list of packages that depend on that package."
+     (fold-packages
+      (lambda (package dag)
+        (fold
+         (lambda (in d)
+           ;; Insert a graph edge from each of package's inputs to package.
+           (vhash-consq in
+                        (cons package (vhash-refq d in '()))
+                        (vhash-delq in d)))
+         dag
+         (match (package-direct-inputs package)
+           (((labels packages . _) ...)
+            packages) )))
+      vlist-null))))
+
+(define (package-direct-dependents packages)
+  "Return a list of packages from the distribution that directly depend on the
+packages in PACKAGES."
+  (delete-duplicates
+   (concatenate
+    (map (lambda (p)
+           (vhash-refq (package-dependencies) p '()))
+         packages))))
+
+(define (package-transitive-dependents packages)
+  "Return the transitive dependent packages of the distribution packages in
+PACKAGES---i.e. the dependents of those packages, plus their dependents,
+recursively."
+  (let ((dependency-dag (package-dependencies)))
+    (fold-tree
+     cons '()
+     (lambda (node) (vhash-refq dependency-dag node))
+     ;; Start with the dependents to avoid including PACKAGES in the result.
+     (package-direct-dependents packages))))
+
+(define (package-covering-dependents packages)
+  "Return a minimal list of packages from the distribution whose dependencies
+include all of PACKAGES and all packages that depend on PACKAGES."
+  (let ((dependency-dag (package-dependencies)))
+    (fold-tree-leaves
+     cons '()
+     (lambda (node) (vhash-refq dependency-dag node))
+     ;; Start with the dependents to avoid including PACKAGES in the result.
+     (package-direct-dependents packages))))