From 6603684c80dab84cc6b39df57aef8be1e06feacc Mon Sep 17 00:00:00 2001
From: Duncan Coutts <duncan@haskell.org>
Date: Tue, 6 May 2008 23:49:02 +0000
Subject: [PATCH] Add PackageIndex.reverseDependencyClosure It's similar to
 dependencyClosure but looks at reverse dependencies. For example it's useful
 to find all packages that depend on broken packages and are thus themselves
 broken.

---
 Distribution/Simple/PackageIndex.hs | 23 ++++++++++++++++++++++-
 1 file changed, 22 insertions(+), 1 deletion(-)

diff --git a/Distribution/Simple/PackageIndex.hs b/Distribution/Simple/PackageIndex.hs
index 57479be052..fe9eb589bc 100644
--- a/Distribution/Simple/PackageIndex.hs
+++ b/Distribution/Simple/PackageIndex.hs
@@ -42,6 +42,7 @@ module Distribution.Simple.PackageIndex (
   -- ** Special queries
   brokenPackages,
   dependencyClosure,
+  reverseDependencyClosure,
   dependencyInconsistencies,
   dependencyCycles,
   dependencyGraph,
@@ -51,12 +52,13 @@ import Prelude hiding (lookup)
 import Control.Exception (assert)
 import qualified Data.Map as Map
 import Data.Map (Map)
+import qualified Data.Tree  as Tree
 import qualified Data.Graph as Graph
 import qualified Data.Array as Array
 import Data.Array ((!))
 import Data.List (nubBy, group, sort, groupBy, sortBy, find)
 import Data.Monoid (Monoid(..))
-import Data.Maybe (isNothing)
+import Data.Maybe (isNothing, fromMaybe)
 
 import Distribution.Package
          ( PackageIdentifier, Package(..), packageName, packageVersion
@@ -285,6 +287,25 @@ dependencyClosure index pkgids0 = case closure mempty [] pkgids0 of
           where completed' = insert pkg completed
                 pkgids'    = depends pkg ++ pkgids
 
+-- | Takes the transative closure of the packages reverse dependencies.
+--
+-- * The given 'PackageIdentifier's must be in the index.
+--
+reverseDependencyClosure :: PackageFixedDeps pkg
+                         => PackageIndex pkg
+                         -> [PackageIdentifier]
+                         -> [PackageIdentifier]
+reverseDependencyClosure index =
+    map vertexToPkgId
+  . concatMap Tree.flatten
+  . Graph.dfs reverseDepGraph
+  . map (fromMaybe noSuchPkgId . pkgIdToVertex)
+
+  where
+    (depGraph, vertexToPkgId, pkgIdToVertex) = dependencyGraph index
+    reverseDepGraph = Graph.transposeG depGraph
+    noSuchPkgId = error "reverseDependencyClosure: package is not in the graph"
+
 -- | Given a package index where we assume we want to use all the packages
 -- (use 'dependencyClosure' if you need to get such a index subset) find out
 -- if the dependencies within it use consistent versions of each package.
-- 
GitLab