{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies #-}
module Distribution.Client.SolverInstallPlan(
SolverInstallPlan(..),
SolverPlanPackage,
ResolverPackage(..),
new,
toList,
toMap,
remove,
showPlanIndex,
showInstallPlan,
valid,
closed,
consistent,
acyclic,
SolverPlanProblem(..),
showPlanProblem,
problems,
dependencyClosure,
reverseDependencyClosure,
topologicalOrder,
reverseTopologicalOrder,
) where
import Distribution.Client.Compat.Prelude hiding (toList)
import Prelude ()
import Distribution.Package
( PackageIdentifier(..), Package(..), PackageName
, HasUnitId(..), PackageId, packageVersion, packageName )
import Distribution.Types.Flag (nullFlagAssignment)
import qualified Distribution.Solver.Types.ComponentDeps as CD
import Distribution.Client.Types
( UnresolvedPkgLoc )
import Distribution.Version
( Version )
import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.ResolverPackage
import Distribution.Solver.Types.SolverId
import Distribution.Solver.Types.SolverPackage
import Distribution.Compat.Graph (Graph, IsNode(..))
import qualified Data.Foldable as Foldable
import qualified Data.Graph as OldGraph
import qualified Distribution.Compat.Graph as Graph
import qualified Data.Map as Map
import Data.Array ((!))
type SolverPlanPackage = ResolverPackage UnresolvedPkgLoc
type SolverPlanIndex = Graph SolverPlanPackage
data SolverInstallPlan = SolverInstallPlan {
SolverInstallPlan -> SolverPlanIndex
planIndex :: !SolverPlanIndex,
SolverInstallPlan -> IndependentGoals
planIndepGoals :: !IndependentGoals
}
deriving (Typeable, forall x. Rep SolverInstallPlan x -> SolverInstallPlan
forall x. SolverInstallPlan -> Rep SolverInstallPlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SolverInstallPlan x -> SolverInstallPlan
$cfrom :: forall x. SolverInstallPlan -> Rep SolverInstallPlan x
Generic)
instance Binary SolverInstallPlan
instance Structured SolverInstallPlan
showPlanIndex :: [SolverPlanPackage] -> String
showPlanIndex :: [ResolverPackage UnresolvedPkgLoc] -> FilePath
showPlanIndex = forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ResolverPackage UnresolvedPkgLoc -> FilePath
showPlanPackage
showInstallPlan :: SolverInstallPlan -> String
showInstallPlan :: SolverInstallPlan -> FilePath
showInstallPlan = [ResolverPackage UnresolvedPkgLoc] -> FilePath
showPlanIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
toList
showPlanPackage :: SolverPlanPackage -> String
showPlanPackage :: ResolverPackage UnresolvedPkgLoc -> FilePath
showPlanPackage (PreExisting InstSolverPackage
ipkg) = FilePath
"PreExisting " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId InstSolverPackage
ipkg)
forall a. [a] -> [a] -> [a]
++ FilePath
" (" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId InstSolverPackage
ipkg)
forall a. [a] -> [a] -> [a]
++ FilePath
")"
showPlanPackage (Configured SolverPackage UnresolvedPkgLoc
spkg) =
FilePath
"Configured " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId SolverPackage UnresolvedPkgLoc
spkg) forall a. [a] -> [a] -> [a]
++ FilePath
flags forall a. [a] -> [a] -> [a]
++ FilePath
comps
where
flags :: FilePath
flags
| FlagAssignment -> Bool
nullFlagAssignment FlagAssignment
fa = FilePath
""
| Bool
otherwise = FilePath
" " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall loc. SolverPackage loc -> FlagAssignment
solverPkgFlags SolverPackage UnresolvedPkgLoc
spkg)
where
fa :: FlagAssignment
fa = forall loc. SolverPackage loc -> FlagAssignment
solverPkgFlags SolverPackage UnresolvedPkgLoc
spkg
comps :: FilePath
comps | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Component
deps = FilePath
""
| Bool
otherwise = FilePath
" " forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> FilePath
prettyShow forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Set Component
deps)
where
deps :: Set CD.Component
deps :: Set Component
deps = forall a. ComponentDeps a -> Set Component
CD.components (forall loc. SolverPackage loc -> ComponentDeps [SolverId]
solverPkgLibDeps SolverPackage UnresolvedPkgLoc
spkg)
forall a. Semigroup a => a -> a -> a
<> forall a. ComponentDeps a -> Set Component
CD.components (forall loc. SolverPackage loc -> ComponentDeps [SolverId]
solverPkgExeDeps SolverPackage UnresolvedPkgLoc
spkg)
new :: IndependentGoals
-> SolverPlanIndex
-> Either [SolverPlanProblem] SolverInstallPlan
new :: IndependentGoals
-> SolverPlanIndex -> Either [SolverPlanProblem] SolverInstallPlan
new IndependentGoals
indepGoals SolverPlanIndex
index =
case IndependentGoals -> SolverPlanIndex -> [SolverPlanProblem]
problems IndependentGoals
indepGoals SolverPlanIndex
index of
[] -> forall a b. b -> Either a b
Right (SolverPlanIndex -> IndependentGoals -> SolverInstallPlan
SolverInstallPlan SolverPlanIndex
index IndependentGoals
indepGoals)
[SolverPlanProblem]
probs -> forall a b. a -> Either a b
Left [SolverPlanProblem]
probs
toList :: SolverInstallPlan -> [SolverPlanPackage]
toList :: SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
toList = forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolverInstallPlan -> SolverPlanIndex
planIndex
toMap :: SolverInstallPlan -> Map SolverId SolverPlanPackage
toMap :: SolverInstallPlan
-> Map SolverId (ResolverPackage UnresolvedPkgLoc)
toMap = forall a. Graph a -> Map (Key a) a
Graph.toMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolverInstallPlan -> SolverPlanIndex
planIndex
remove :: (SolverPlanPackage -> Bool)
-> SolverInstallPlan
-> Either [SolverPlanProblem]
(SolverInstallPlan)
remove :: (ResolverPackage UnresolvedPkgLoc -> Bool)
-> SolverInstallPlan
-> Either [SolverPlanProblem] SolverInstallPlan
remove ResolverPackage UnresolvedPkgLoc -> Bool
shouldRemove SolverInstallPlan
plan =
IndependentGoals
-> SolverPlanIndex -> Either [SolverPlanProblem] SolverInstallPlan
new (SolverInstallPlan -> IndependentGoals
planIndepGoals SolverInstallPlan
plan) SolverPlanIndex
newIndex
where
newIndex :: SolverPlanIndex
newIndex = forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverPackage UnresolvedPkgLoc -> Bool
shouldRemove) (SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
toList SolverInstallPlan
plan)
valid :: IndependentGoals
-> SolverPlanIndex
-> Bool
valid :: IndependentGoals -> SolverPlanIndex -> Bool
valid IndependentGoals
indepGoals SolverPlanIndex
index =
forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ IndependentGoals -> SolverPlanIndex -> [SolverPlanProblem]
problems IndependentGoals
indepGoals SolverPlanIndex
index
data SolverPlanProblem =
PackageMissingDeps SolverPlanPackage
[PackageIdentifier]
| PackageCycle [SolverPlanPackage]
| PackageInconsistency PackageName [(PackageIdentifier, Version)]
| PackageStateInvalid SolverPlanPackage SolverPlanPackage
showPlanProblem :: SolverPlanProblem -> String
showPlanProblem :: SolverPlanProblem -> FilePath
showPlanProblem (PackageMissingDeps ResolverPackage UnresolvedPkgLoc
pkg [PackageIdentifier]
missingDeps) =
FilePath
"Package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ResolverPackage UnresolvedPkgLoc
pkg)
forall a. [a] -> [a] -> [a]
++ FilePath
" depends on the following packages which are missing from the plan: "
forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> FilePath
prettyShow [PackageIdentifier]
missingDeps)
showPlanProblem (PackageCycle [ResolverPackage UnresolvedPkgLoc]
cycleGroup) =
FilePath
"The following packages are involved in a dependency cycle "
forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> FilePath
prettyShowforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall pkg. Package pkg => pkg -> PackageIdentifier
packageId) [ResolverPackage UnresolvedPkgLoc]
cycleGroup)
showPlanProblem (PackageInconsistency PackageName
name [(PackageIdentifier, Version)]
inconsistencies) =
FilePath
"Package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow PackageName
name
forall a. [a] -> [a] -> [a]
++ FilePath
" is required by several packages,"
forall a. [a] -> [a] -> [a]
++ FilePath
" but they require inconsistent versions:\n"
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unlines [ FilePath
" package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkg forall a. [a] -> [a] -> [a]
++ FilePath
" requires "
forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
name Version
ver)
| (PackageIdentifier
pkg, Version
ver) <- [(PackageIdentifier, Version)]
inconsistencies ]
showPlanProblem (PackageStateInvalid ResolverPackage UnresolvedPkgLoc
pkg ResolverPackage UnresolvedPkgLoc
pkg') =
FilePath
"Package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ResolverPackage UnresolvedPkgLoc
pkg)
forall a. [a] -> [a] -> [a]
++ FilePath
" is in the " forall a. [a] -> [a] -> [a]
++ forall {loc}. ResolverPackage loc -> FilePath
showPlanState ResolverPackage UnresolvedPkgLoc
pkg
forall a. [a] -> [a] -> [a]
++ FilePath
" state but it depends on package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ResolverPackage UnresolvedPkgLoc
pkg')
forall a. [a] -> [a] -> [a]
++ FilePath
" which is in the " forall a. [a] -> [a] -> [a]
++ forall {loc}. ResolverPackage loc -> FilePath
showPlanState ResolverPackage UnresolvedPkgLoc
pkg'
forall a. [a] -> [a] -> [a]
++ FilePath
" state"
where
showPlanState :: ResolverPackage loc -> FilePath
showPlanState (PreExisting InstSolverPackage
_) = FilePath
"pre-existing"
showPlanState (Configured SolverPackage loc
_) = FilePath
"configured"
problems :: IndependentGoals
-> SolverPlanIndex
-> [SolverPlanProblem]
problems :: IndependentGoals -> SolverPlanIndex -> [SolverPlanProblem]
problems IndependentGoals
indepGoals SolverPlanIndex
index =
[ ResolverPackage UnresolvedPkgLoc
-> [PackageIdentifier] -> SolverPlanProblem
PackageMissingDeps ResolverPackage UnresolvedPkgLoc
pkg
(forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall pkg. Package pkg => pkg -> PackageIdentifier
packageId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. IsNode a => Key a -> Graph a -> Maybe a
Graph.lookup SolverPlanIndex
index)
[SolverId]
missingDeps)
| (ResolverPackage UnresolvedPkgLoc
pkg, [SolverId]
missingDeps) <- forall a. Graph a -> [(a, [Key a])]
Graph.broken SolverPlanIndex
index ]
forall a. [a] -> [a] -> [a]
++ [ [ResolverPackage UnresolvedPkgLoc] -> SolverPlanProblem
PackageCycle [ResolverPackage UnresolvedPkgLoc]
cycleGroup
| [ResolverPackage UnresolvedPkgLoc]
cycleGroup <- forall a. Graph a -> [[a]]
Graph.cycles SolverPlanIndex
index ]
forall a. [a] -> [a] -> [a]
++ [ PackageName -> [(PackageIdentifier, Version)] -> SolverPlanProblem
PackageInconsistency PackageName
name [(PackageIdentifier, Version)]
inconsistencies
| (PackageName
name, [(PackageIdentifier, Version)]
inconsistencies) <-
IndependentGoals
-> SolverPlanIndex
-> [(PackageName, [(PackageIdentifier, Version)])]
dependencyInconsistencies IndependentGoals
indepGoals SolverPlanIndex
index ]
forall a. [a] -> [a] -> [a]
++ [ ResolverPackage UnresolvedPkgLoc
-> ResolverPackage UnresolvedPkgLoc -> SolverPlanProblem
PackageStateInvalid ResolverPackage UnresolvedPkgLoc
pkg ResolverPackage UnresolvedPkgLoc
pkg'
| ResolverPackage UnresolvedPkgLoc
pkg <- forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList SolverPlanIndex
index
, Just ResolverPackage UnresolvedPkgLoc
pkg' <- forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. IsNode a => Key a -> Graph a -> Maybe a
Graph.lookup SolverPlanIndex
index)
(forall a. IsNode a => a -> [Key a]
nodeNeighbors ResolverPackage UnresolvedPkgLoc
pkg)
, Bool -> Bool
not (ResolverPackage UnresolvedPkgLoc
-> ResolverPackage UnresolvedPkgLoc -> Bool
stateDependencyRelation ResolverPackage UnresolvedPkgLoc
pkg ResolverPackage UnresolvedPkgLoc
pkg') ]
dependencyInconsistencies :: IndependentGoals
-> SolverPlanIndex
-> [(PackageName, [(PackageIdentifier, Version)])]
dependencyInconsistencies :: IndependentGoals
-> SolverPlanIndex
-> [(PackageName, [(PackageIdentifier, Version)])]
dependencyInconsistencies IndependentGoals
indepGoals SolverPlanIndex
index =
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SolverPlanIndex -> [(PackageName, [(PackageIdentifier, Version)])]
dependencyInconsistencies' [SolverPlanIndex]
subplans
where
subplans :: [SolverPlanIndex]
subplans :: [SolverPlanIndex]
subplans =
forall a b. (a -> b) -> [a] -> [b]
map (SolverPlanIndex -> [SolverId] -> SolverPlanIndex
nonSetupClosure SolverPlanIndex
index)
(IndependentGoals -> SolverPlanIndex -> [[SolverId]]
rootSets IndependentGoals
indepGoals SolverPlanIndex
index)
nonSetupClosure :: SolverPlanIndex
-> [SolverId]
-> SolverPlanIndex
nonSetupClosure :: SolverPlanIndex -> [SolverId] -> SolverPlanIndex
nonSetupClosure SolverPlanIndex
index [SolverId]
pkgids0 = SolverPlanIndex -> [SolverId] -> SolverPlanIndex
closure forall a. IsNode a => Graph a
Graph.empty [SolverId]
pkgids0
where
closure :: Graph SolverPlanPackage -> [SolverId] -> SolverPlanIndex
closure :: SolverPlanIndex -> [SolverId] -> SolverPlanIndex
closure SolverPlanIndex
completed [] = SolverPlanIndex
completed
closure SolverPlanIndex
completed (SolverId
pkgid:[SolverId]
pkgids) =
case forall a. IsNode a => Key a -> Graph a -> Maybe a
Graph.lookup SolverId
pkgid SolverPlanIndex
index of
Maybe (ResolverPackage UnresolvedPkgLoc)
Nothing -> SolverPlanIndex -> [SolverId] -> SolverPlanIndex
closure SolverPlanIndex
completed [SolverId]
pkgids
Just ResolverPackage UnresolvedPkgLoc
pkg ->
case forall a. IsNode a => Key a -> Graph a -> Maybe a
Graph.lookup (forall a. IsNode a => a -> Key a
nodeKey ResolverPackage UnresolvedPkgLoc
pkg) SolverPlanIndex
completed of
Just ResolverPackage UnresolvedPkgLoc
_ -> SolverPlanIndex -> [SolverId] -> SolverPlanIndex
closure SolverPlanIndex
completed [SolverId]
pkgids
Maybe (ResolverPackage UnresolvedPkgLoc)
Nothing -> SolverPlanIndex -> [SolverId] -> SolverPlanIndex
closure SolverPlanIndex
completed' [SolverId]
pkgids'
where completed' :: SolverPlanIndex
completed' = forall a. IsNode a => a -> Graph a -> Graph a
Graph.insert ResolverPackage UnresolvedPkgLoc
pkg SolverPlanIndex
completed
pkgids' :: [SolverId]
pkgids' = forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps (forall loc. ResolverPackage loc -> ComponentDeps [SolverId]
resolverPackageLibDeps ResolverPackage UnresolvedPkgLoc
pkg) forall a. [a] -> [a] -> [a]
++ [SolverId]
pkgids
rootSets :: IndependentGoals -> SolverPlanIndex -> [[SolverId]]
rootSets :: IndependentGoals -> SolverPlanIndex -> [[SolverId]]
rootSets (IndependentGoals Bool
indepGoals) SolverPlanIndex
index =
if Bool
indepGoals then forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
:[]) [SolverId]
libRoots else [[SolverId]
libRoots]
forall a. [a] -> [a] -> [a]
++ SolverPlanIndex -> [[SolverId]]
setupRoots SolverPlanIndex
index
where
libRoots :: [SolverId]
libRoots :: [SolverId]
libRoots = SolverPlanIndex -> [SolverId]
libraryRoots SolverPlanIndex
index
libraryRoots :: SolverPlanIndex -> [SolverId]
libraryRoots :: SolverPlanIndex -> [SolverId]
libraryRoots SolverPlanIndex
index =
forall a b. (a -> b) -> [a] -> [b]
map (forall a. IsNode a => a -> Key a
nodeKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ResolverPackage UnresolvedPkgLoc
toPkgId) [Int]
roots
where
(Graph
graph, Int -> ResolverPackage UnresolvedPkgLoc
toPkgId, Key (ResolverPackage UnresolvedPkgLoc) -> Maybe Int
_) = forall a. Graph a -> (Graph, Int -> a, Key a -> Maybe Int)
Graph.toGraph SolverPlanIndex
index
indegree :: Array Int Int
indegree = Graph -> Array Int Int
OldGraph.indegree Graph
graph
roots :: [Int]
roots = forall a. (a -> Bool) -> [a] -> [a]
filter Int -> Bool
isRoot (Graph -> [Int]
OldGraph.vertices Graph
graph)
isRoot :: Int -> Bool
isRoot Int
v = Array Int Int
indegree forall i e. Ix i => Array i e -> i -> e
! Int
v forall a. Eq a => a -> a -> Bool
== Int
0
setupRoots :: SolverPlanIndex -> [[SolverId]]
setupRoots :: SolverPlanIndex -> [[SolverId]]
setupRoots = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Monoid a => ComponentDeps a -> a
CD.setupDeps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall loc. ResolverPackage loc -> ComponentDeps [SolverId]
resolverPackageLibDeps)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
dependencyInconsistencies' :: SolverPlanIndex
-> [(PackageName, [(PackageIdentifier, Version)])]
dependencyInconsistencies' :: SolverPlanIndex -> [(PackageName, [(PackageIdentifier, Version)])]
dependencyInconsistencies' SolverPlanIndex
index =
[ (PackageName
name, [ (PackageIdentifier
pid, forall pkg. Package pkg => pkg -> Version
packageVersion ResolverPackage UnresolvedPkgLoc
dep) | (ResolverPackage UnresolvedPkgLoc
dep,[PackageIdentifier]
pids) <- [(ResolverPackage UnresolvedPkgLoc, [PackageIdentifier])]
uses, PackageIdentifier
pid <- [PackageIdentifier]
pids])
| (PackageName
name, Map
SolverId (ResolverPackage UnresolvedPkgLoc, [PackageIdentifier])
ipid_map) <- forall k a. Map k a -> [(k, a)]
Map.toList Map
PackageName
(Map
SolverId (ResolverPackage UnresolvedPkgLoc, [PackageIdentifier]))
inverseIndex
, let uses :: [(ResolverPackage UnresolvedPkgLoc, [PackageIdentifier])]
uses = forall k a. Map k a -> [a]
Map.elems Map
SolverId (ResolverPackage UnresolvedPkgLoc, [PackageIdentifier])
ipid_map
, [ResolverPackage UnresolvedPkgLoc] -> Bool
reallyIsInconsistent (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(ResolverPackage UnresolvedPkgLoc, [PackageIdentifier])]
uses)
]
where
inverseIndex :: Map PackageName (Map SolverId (SolverPlanPackage, [PackageId]))
inverseIndex :: Map
PackageName
(Map
SolverId (ResolverPackage UnresolvedPkgLoc, [PackageIdentifier]))
inverseIndex = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (\(ResolverPackage UnresolvedPkgLoc
a,[PackageIdentifier]
b) (ResolverPackage UnresolvedPkgLoc
_,[PackageIdentifier]
b') -> (ResolverPackage UnresolvedPkgLoc
a,[PackageIdentifier]
bforall a. [a] -> [a] -> [a]
++[PackageIdentifier]
b')))
[ (forall pkg. Package pkg => pkg -> PackageName
packageName ResolverPackage UnresolvedPkgLoc
dep, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(SolverId
sid,(ResolverPackage UnresolvedPkgLoc
dep,[forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ResolverPackage UnresolvedPkgLoc
pkg]))])
|
ResolverPackage UnresolvedPkgLoc
pkg <- forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList SolverPlanIndex
index
, SolverId
sid <- forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps (forall loc. ResolverPackage loc -> ComponentDeps [SolverId]
resolverPackageLibDeps ResolverPackage UnresolvedPkgLoc
pkg)
, Just ResolverPackage UnresolvedPkgLoc
dep <- [forall a. IsNode a => Key a -> Graph a -> Maybe a
Graph.lookup SolverId
sid SolverPlanIndex
index]
]
reallyIsInconsistent :: [SolverPlanPackage] -> Bool
reallyIsInconsistent :: [ResolverPackage UnresolvedPkgLoc] -> Bool
reallyIsInconsistent [] = Bool
False
reallyIsInconsistent [ResolverPackage UnresolvedPkgLoc
_p] = Bool
False
reallyIsInconsistent [ResolverPackage UnresolvedPkgLoc
p1, ResolverPackage UnresolvedPkgLoc
p2] =
let pid1 :: Key (ResolverPackage UnresolvedPkgLoc)
pid1 = forall a. IsNode a => a -> Key a
nodeKey ResolverPackage UnresolvedPkgLoc
p1
pid2 :: Key (ResolverPackage UnresolvedPkgLoc)
pid2 = forall a. IsNode a => a -> Key a
nodeKey ResolverPackage UnresolvedPkgLoc
p2
in Key (ResolverPackage UnresolvedPkgLoc)
pid1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps (forall loc. ResolverPackage loc -> ComponentDeps [SolverId]
resolverPackageLibDeps ResolverPackage UnresolvedPkgLoc
p2)
Bool -> Bool -> Bool
&& Key (ResolverPackage UnresolvedPkgLoc)
pid2 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps (forall loc. ResolverPackage loc -> ComponentDeps [SolverId]
resolverPackageLibDeps ResolverPackage UnresolvedPkgLoc
p1)
reallyIsInconsistent [ResolverPackage UnresolvedPkgLoc]
_ = Bool
True
acyclic :: SolverPlanIndex -> Bool
acyclic :: SolverPlanIndex -> Bool
acyclic = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Graph a -> [[a]]
Graph.cycles
closed :: SolverPlanIndex -> Bool
closed :: SolverPlanIndex -> Bool
closed = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Graph a -> [(a, [Key a])]
Graph.broken
consistent :: SolverPlanIndex -> Bool
consistent :: SolverPlanIndex -> Bool
consistent = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndependentGoals
-> SolverPlanIndex
-> [(PackageName, [(PackageIdentifier, Version)])]
dependencyInconsistencies (Bool -> IndependentGoals
IndependentGoals Bool
False)
stateDependencyRelation :: SolverPlanPackage
-> SolverPlanPackage
-> Bool
stateDependencyRelation :: ResolverPackage UnresolvedPkgLoc
-> ResolverPackage UnresolvedPkgLoc -> Bool
stateDependencyRelation PreExisting{} PreExisting{} = Bool
True
stateDependencyRelation (Configured SolverPackage UnresolvedPkgLoc
_) PreExisting{} = Bool
True
stateDependencyRelation (Configured SolverPackage UnresolvedPkgLoc
_) (Configured SolverPackage UnresolvedPkgLoc
_) = Bool
True
stateDependencyRelation ResolverPackage UnresolvedPkgLoc
_ ResolverPackage UnresolvedPkgLoc
_ = Bool
False
dependencyClosure :: SolverInstallPlan
-> [SolverId]
-> [SolverPlanPackage]
dependencyClosure :: SolverInstallPlan
-> [SolverId] -> [ResolverPackage UnresolvedPkgLoc]
dependencyClosure SolverInstallPlan
plan = forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Graph a -> [Key a] -> Maybe [a]
Graph.closure (SolverInstallPlan -> SolverPlanIndex
planIndex SolverInstallPlan
plan)
reverseDependencyClosure :: SolverInstallPlan
-> [SolverId]
-> [SolverPlanPackage]
reverseDependencyClosure :: SolverInstallPlan
-> [SolverId] -> [ResolverPackage UnresolvedPkgLoc]
reverseDependencyClosure SolverInstallPlan
plan = forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Graph a -> [Key a] -> Maybe [a]
Graph.revClosure (SolverInstallPlan -> SolverPlanIndex
planIndex SolverInstallPlan
plan)
topologicalOrder :: SolverInstallPlan
-> [SolverPlanPackage]
topologicalOrder :: SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
topologicalOrder SolverInstallPlan
plan = forall a. Graph a -> [a]
Graph.topSort (SolverInstallPlan -> SolverPlanIndex
planIndex SolverInstallPlan
plan)
reverseTopologicalOrder :: SolverInstallPlan
-> [SolverPlanPackage]
reverseTopologicalOrder :: SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
reverseTopologicalOrder SolverInstallPlan
plan = forall a. Graph a -> [a]
Graph.revTopSort (SolverInstallPlan -> SolverPlanIndex
planIndex SolverInstallPlan
plan)