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