{-# LANGUAGE ScopedTypeVariables #-} -- | These graph traversal functions mirror the ones in Cabal, but work with -- the more complete (and fine-grained) set of dependencies provided by -- PackageFixedDeps rather than only the library dependencies provided by -- PackageInstalled. module Distribution.Client.SolverPlanIndex ( -- * Graph traversal functions brokenPackages , dependencyCycles , dependencyGraph , dependencyInconsistencies ) where import Prelude () import Distribution.Client.Compat.Prelude -- import Prelude hiding (lookup) import qualified Data.Map as Map import qualified Data.Graph as Graph import Data.Array ((!)) import Data.Map (Map) -- import Data.Maybe (isNothing) import Data.Either (rights) import Distribution.Package ( PackageName, PackageIdentifier(..), UnitId(..) , Package(..), packageName, packageVersion ) import Distribution.Version ( Version ) import qualified Distribution.Solver.Types.ComponentDeps as CD import Distribution.Solver.Types.PackageFixedDeps import Distribution.Solver.Types.Settings import Distribution.Simple.PackageIndex ( PackageIndex, allPackages, insert, lookupUnitId ) import Distribution.Package ( HasUnitId(..), PackageId ) -- | All packages that have dependencies that are not in the index. -- -- Returns such packages along with the dependencies that they're missing. -- brokenPackages :: (PackageFixedDeps pkg) => PackageIndex pkg -> [(pkg, [UnitId])] brokenPackages index = [ (pkg, missing) | pkg <- allPackages index , let missing = [ pkg' | pkg' <- CD.flatDeps (depends pkg) , isNothing (lookupUnitId index pkg') ] , not (null missing) ] -- | Compute all roots of the install plan, and verify that the transitive -- plans from those roots are all consistent. -- -- NOTE: This does not check for dependency cycles. Moreover, dependency cycles -- may be absent from the subplans even if the larger plan contains a dependency -- cycle. Such cycles may or may not be an issue; either way, we don't check -- for them here. dependencyInconsistencies :: forall pkg. (PackageFixedDeps pkg, HasUnitId pkg) => IndependentGoals -> PackageIndex pkg -> [(PackageName, [(PackageIdentifier, Version)])] dependencyInconsistencies indepGoals index = concatMap dependencyInconsistencies' subplans where subplans :: [PackageIndex pkg] subplans = rights $ map (dependencyClosure index) (rootSets indepGoals index) -- | Compute the root sets of a plan -- -- A root set is a set of packages whose dependency closure must be consistent. -- This is the set of all top-level library roots (taken together normally, or -- as singletons sets if we are considering them as independent goals), along -- with all setup dependencies of all packages. rootSets :: (PackageFixedDeps pkg, HasUnitId pkg) => IndependentGoals -> PackageIndex pkg -> [[UnitId]] rootSets (IndependentGoals indepGoals) index = if indepGoals then map (:[]) libRoots else [libRoots] ++ setupRoots index where libRoots = libraryRoots index -- | Compute the library roots of a plan -- -- The library roots are the set of packages with no reverse dependencies -- (no reverse library dependencies but also no reverse setup dependencies). libraryRoots :: (PackageFixedDeps pkg, HasUnitId pkg) => PackageIndex pkg -> [UnitId] libraryRoots index = map toPkgId roots where (graph, toPkgId, _) = dependencyGraph index indegree = Graph.indegree graph roots = filter isRoot (Graph.vertices graph) isRoot v = indegree ! v == 0 -- | The setup dependencies of each package in the plan setupRoots :: PackageFixedDeps pkg => PackageIndex pkg -> [[UnitId]] setupRoots = filter (not . null) . map (CD.setupDeps . depends) . allPackages -- | 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. -- Return all cases where multiple packages depend on different versions of -- some other package. -- -- Each element in the result is a package name along with the packages that -- depend on it and the versions they require. These are guaranteed to be -- distinct. -- dependencyInconsistencies' :: forall pkg. (PackageFixedDeps pkg, HasUnitId pkg) => PackageIndex pkg -> [(PackageName, [(PackageIdentifier, Version)])] dependencyInconsistencies' index = [ (name, [ (pid,packageVersion dep) | (dep,pids) <- uses, pid <- pids]) | (name, ipid_map) <- Map.toList inverseIndex , let uses = Map.elems ipid_map , reallyIsInconsistent (map fst uses) ] where -- For each package name (of a dependency, somewhere) -- and each installed ID of that that package -- the associated package instance -- and a list of reverse dependencies (as source IDs) inverseIndex :: Map PackageName (Map UnitId (pkg, [PackageId])) inverseIndex = Map.fromListWith (Map.unionWith (\(a,b) (_,b') -> (a,b++b'))) [ (packageName dep, Map.fromList [(ipid,(dep,[packageId pkg]))]) | -- For each package @pkg@ pkg <- allPackages index -- Find out which @ipid@ @pkg@ depends on , ipid <- CD.nonSetupDeps (depends pkg) -- And look up those @ipid@ (i.e., @ipid@ is the ID of @dep@) , Just dep <- [lookupUnitId index ipid] ] -- If, in a single install plan, we depend on more than one version of a -- package, then this is ONLY okay in the (rather special) case that we -- depend on precisely two versions of that package, and one of them -- depends on the other. This is necessary for example for the base where -- we have base-3 depending on base-4. reallyIsInconsistent :: [pkg] -> Bool reallyIsInconsistent [] = False reallyIsInconsistent [_p] = False reallyIsInconsistent [p1, p2] = let pid1 = installedUnitId p1 pid2 = installedUnitId p2 in pid1 `notElem` CD.nonSetupDeps (depends p2) && pid2 `notElem` CD.nonSetupDeps (depends p1) reallyIsInconsistent _ = True -- | Find if there are any cycles in the dependency graph. If there are no -- cycles the result is @[]@. -- -- This actually computes the strongly connected components. So it gives us a -- list of groups of packages where within each group they all depend on each -- other, directly or indirectly. -- dependencyCycles :: (PackageFixedDeps pkg, HasUnitId pkg) => PackageIndex pkg -> [[pkg]] dependencyCycles index = [ vs | Graph.CyclicSCC vs <- Graph.stronglyConnComp adjacencyList ] where adjacencyList = [ (pkg, installedUnitId pkg, CD.flatDeps (depends pkg)) | pkg <- allPackages index ] -- | Tries to take the transitive closure of the package dependencies. -- -- If the transitive closure is complete then it returns that subset of the -- index. Otherwise it returns the broken packages as in 'brokenPackages'. -- -- * Note that if the result is @Right []@ it is because at least one of -- the original given 'PackageIdentifier's do not occur in the index. dependencyClosure :: (PackageFixedDeps pkg, HasUnitId pkg) => PackageIndex pkg -> [UnitId] -> Either [(pkg, [UnitId])] (PackageIndex pkg) dependencyClosure index pkgids0 = case closure mempty [] pkgids0 of (completed, []) -> Right completed (completed, _) -> Left (brokenPackages completed) where closure completed failed [] = (completed, failed) closure completed failed (pkgid:pkgids) = case lookupUnitId index pkgid of Nothing -> closure completed (pkgid:failed) pkgids Just pkg -> case lookupUnitId completed (installedUnitId pkg) of Just _ -> closure completed failed pkgids Nothing -> closure completed' failed pkgids' where completed' = insert pkg completed pkgids' = CD.nonSetupDeps (depends pkg) ++ pkgids -- | Builds a graph of the package dependencies. -- -- Dependencies on other packages that are not in the index are discarded. -- You can check if there are any such dependencies with 'brokenPackages'. -- dependencyGraph :: (PackageFixedDeps pkg, HasUnitId pkg) => PackageIndex pkg -> (Graph.Graph, Graph.Vertex -> UnitId, UnitId -> Maybe Graph.Vertex) dependencyGraph index = (graph, vertexToPkg, idToVertex) where (graph, vertexToPkg', idToVertex) = Graph.graphFromEdges edges vertexToPkg v = case vertexToPkg' v of ((), pkgid, _targets) -> pkgid pkgs = allPackages index edges = map edgesFrom pkgs resolve pid = pid edgesFrom pkg = ( () , resolve (installedUnitId pkg) , CD.flatDeps (depends pkg) )