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