Commit 68e5cfc7 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Improve InstallPlan error checking and reporting

Instead of just reporting that a plan is invalid, produce a
detailed list of reasons why it is invalid.
This should be useful for people debugging dependency resolvers.
Also rename the complete property to closed, since the property
is about the set being closed under the dependency relation.
Also re-use the PackageIndex functions for checking the validity
conditions rather than re-implementing the checks locally.
parent 0eb9631c
......@@ -26,42 +26,51 @@ module Hackage.InstallPlan (
-- * Checking valididy of plans
valid,
complete,
closed,
consistent,
acyclic,
validConfiguredPackage,
configuredPackageValid,
-- ** Details on invalid plans
PlanProblem(..),
showPlanProblem,
PackageProblem(..),
showPackageProblem,
problems,
configuredPackageProblems
) where
import Hackage.Types
( AvailablePackage(packageDescription), UnresolvedDependency )
( AvailablePackage(packageDescription) )
import Distribution.Package
( PackageIdentifier(..), Package(..), PackageFixedDeps(..) )
( PackageIdentifier(..), Package(..), PackageFixedDeps(..)
, packageName, Dependency(..) )
import Distribution.Version
( Version, withinRange )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
import Distribution.PackageDescription
( GenericPackageDescription(genPackageFlags)
, PackageDescription(buildDepends)
, Flag(MkFlag, flagName), FlagAssignment )
, Flag(flagName), FlagName(..), FlagAssignment )
import Distribution.PackageDescription.Configuration
( finalizePackageDescription )
import Distribution.Simple.PackageIndex
( PackageIndex )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Utils
( comparing, equating )
import Distribution.Text
( display )
import Distribution.System
( OS, Arch )
import Distribution.Compiler
( CompilerId(..) )
import Hackage.Utils
( duplicates, duplicatesBy, mergeBy, MergeResult(..) )
import Distribution.Simple.Utils
( comparing, intercalate )
import Data.List
( sort, sortBy, groupBy )
import Data.Maybe
( isJust )
import qualified Data.Graph as Graph
( SCC(..), stronglyConnCompR )
( sort, sortBy )
import Control.Exception
( assert )
......@@ -91,20 +100,20 @@ import Control.Exception
-- available ones or perhaps always prefer the latest available version whether
-- installed or not.
--
-- The goal is to calculate an installation plan that is acyclic, consistent
-- and complete.
-- The goal is to calculate an installation plan that is closed, acyclic and
-- consistent and where every configured package is valid.
--
-- An installation plan is a set of packages that are going to be used
-- together. It will consist of a mixture of installed packages and available
-- packages along with their exact version dependencies. An installation plan
-- is complete if for every package in the set, all of its dependencies are
-- is closed if for every package in the set, all of its dependencies are
-- also in the set. It is consistent if for every package in the set, all
-- dependencies which target that package have the same version.
-- | A 'ConfiguredPackage' is a not-yet-installed package along with the
-- total configuration information. The configuration information is total in
-- the sense that it provides all the configuration information and so the
-- final configure process will be independent of the environment.
-- final configure process will be independent of the environment.
--
data ConfiguredPackage = ConfiguredPackage
AvailablePackage -- ^ package info, including repo
......@@ -145,84 +154,20 @@ data InstallPlan buildResult = InstallPlan {
}
deriving Show
toList :: InstallPlan buildResult -> [PlanPackage buildResult]
toList = PackageIndex.allPackages . planIndex
invariant :: InstallPlan a -> Bool
invariant plan =
valid (planOS plan) (planArch plan) (planCompiler plan) (planIndex plan)
-- A valid installation plan is a set of packages that is 'acyclic', 'complete'
-- and 'consistent'.
--
valid :: OS -> Arch -> CompilerId -> PackageIndex (PlanPackage a) -> Bool
valid os arch comp index =
acyclic index
&& complete index
&& consistent index
&& all (validConfiguredPackage os arch comp)
[ pkg | Configured pkg <- PackageIndex.allPackages index ]
-- | The graph of packages (nodes) and dependencies (edges) must be acyclic.
--
acyclic :: PackageIndex (PlanPackage a) -> Bool
acyclic index =
null [ vs
| Graph.CyclicSCC vs <- Graph.stronglyConnCompR
[ (pkg, packageId pkg, depends pkg)
| pkg <- PackageIndex.allPackages index ] ]
-- | An installation plan is complete if for every package in the set, all of
-- its dependencies are also in the set.
--
complete :: PackageIndex (PlanPackage a) -> Bool
complete index =
all (isJust . PackageIndex.lookupPackageId index)
(concatMap depends (PackageIndex.allPackages index))
-- An installation plan is consistent if for every package in the set, all
-- dependencies which target that package have the same version.
consistent :: PackageIndex (PlanPackage a) -> Bool
consistent index =
all same
. map (map snd)
. groupBy (equating fst)
. sortBy (comparing fst)
$ [ (name, [version])
| pkg <- PackageIndex.allPackages index
, PackageIdentifier name version <- depends pkg ]
where
same :: Eq a => [a] -> Bool
same xs = and (zipWith (==) xs (tail xs))
validConfiguredPackage :: OS -> Arch -> CompilerId -> ConfiguredPackage -> Bool
validConfiguredPackage os arch comp (ConfiguredPackage pkginfo flags deps) =
flagsTotal (packageDescription pkginfo)
&& depsValid (packageDescription pkginfo)
where
flagsTotal :: GenericPackageDescription -> Bool
flagsTotal pkg =
sort [ name | (name,_) <- flags ]
== sort [ name | MkFlag { flagName = name } <- genPackageFlags pkg ]
depsValid :: GenericPackageDescription -> Bool
depsValid pkg =
--TODO: use something lower level than finalizePackageDescription
case finalizePackageDescription flags (Nothing :: Maybe (PackageIndex PackageIdentifier)) os arch comp [] pkg of
Right (pkg', _) -> flip all (buildDepends pkg') $ \dep ->
case PackageIndex.lookupDependency index' dep of
[_] -> True
_ -> False
_ -> False
where index' = PackageIndex.fromList deps
-- | Build an installation plan from a valid set of resolved packages.
--
new :: OS -> Arch -> CompilerId -> PackageIndex (PlanPackage a) -> InstallPlan a
new os arch compiler pkgs
| not (valid os arch compiler pkgs) = error "InstallPlan.new: invalid plan"
| otherwise = InstallPlan pkgs os arch compiler
new :: OS -> Arch -> CompilerId -> PackageIndex (PlanPackage a)
-> Either (InstallPlan a) [PlanProblem a]
new os arch compiler index = case problems os arch compiler index of
[] -> Left (InstallPlan index os arch compiler)
ps -> Right ps
toList :: InstallPlan buildResult -> [PlanPackage buildResult]
toList = PackageIndex.allPackages . planIndex
-- | Is the plan completed?
--
......@@ -266,26 +211,210 @@ completed pkgid plan =
where index = planIndex plan
-- | Marks a package in the graph as having failed. It also marks all the
-- packages that depended on it.
-- packages that depended on it as having failed.
--
-- * The package must exist in the graph and be in the configured state.
--
-- * The package must exist in the graph.
--
failed :: PackageIdentifier -> buildResult -> buildResult
-> InstallPlan buildResult -> InstallPlan buildResult
failed pkgid0 buildResult dependentBuildResult plan =
case PackageIndex.lookupPackageId index0 pkgid0 of
failed :: PackageIdentifier -- ^ The id of the package that failed to install
-> buildResult -- ^ The build result to use for the failed package
-> buildResult -- ^ The build result to use for its dependencies
-> InstallPlan buildResult
-> InstallPlan buildResult
failed pkgid buildResult dependentBuildResult
plan@(InstallPlan { planIndex = index }) =
case PackageIndex.lookupPackageId index pkgid of
Just (Configured cp) ->
let index = PackageIndex.insert index0 (Failed cp buildResult)
in plan { planIndex = markDepsAsFailed pkgid0 index }
_ -> error ""
plan {
planIndex = markDepsAsFailed pkgid
. PackageIndex.insert (Failed cp buildResult)
$ index
}
Just _ -> error $ "InstallPlan.failed: not configured " ++ display pkgid
Nothing -> error $ "InstallPlan.failed: no such package " ++ display pkgid
where
index0 = planIndex plan
--markDepsAsFailed :: PackageIdentifier -> PackageIndex br -> PackageIndex br
markDepsAsFailed pkgid index =
case PackageIndex.lookupPackageId index pkgid of
markDepsAsFailed pkgid' index' =
case PackageIndex.lookupPackageId index' pkgid' of
Just (Configured cp) ->
let index1 = PackageIndex.insert index (Failed cp dependentBuildResult)
deps = depends cp
in foldr markDepsAsFailed index1 deps
_ -> index
let index'' = PackageIndex.insert (Failed cp dependentBuildResult) index'
deps = depends cp
in foldr markDepsAsFailed index'' deps
_ -> index'
-- ------------------------------------------------------------
-- * Checking valididy of plans
-- ------------------------------------------------------------
-- | A valid installation plan is a set of packages that is 'acyclic',
-- 'closed' and 'consistent'. Also, every 'ConfiguredPackage' in the
-- plan has to have a valid configuration (see 'configuredPackageValid').
--
-- * if the result is @False@ use 'problems' to get a detailed list.
--
valid :: OS -> Arch -> CompilerId -> PackageIndex (PlanPackage a) -> Bool
valid os arch comp index = null (problems os arch comp index)
data PlanProblem a =
PackageInvalid ConfiguredPackage [PackageProblem]
| PackageMissingDeps (PlanPackage a) [PackageIdentifier]
| PackageCycle [PlanPackage a]
| PackageInconsistency String [(PackageIdentifier, Version)]
showPlanProblem :: PlanProblem a -> String
showPlanProblem (PackageInvalid pkg packageProblems) =
"Package " ++ display (packageId pkg)
++ " has an invalid configuration, in particular:\n"
++ unlines [ " " ++ showPackageProblem problem
| problem <- packageProblems ]
showPlanProblem (PackageMissingDeps pkg missingDeps) =
"Package " ++ display (packageId pkg)
++ " depends on the following packages which are missing from the plan "
++ intercalate ", " (map display missingDeps)
showPlanProblem (PackageCycle cycleGroup) =
"The following packages are involved in a dependency cycle "
++ intercalate ", " (map (display.packageId) cycleGroup)
showPlanProblem (PackageInconsistency name inconsistencies) =
"Package " ++ name
++ " is required by several packages,"
++ " but they require inconsistent versions:\n"
++ unlines [ " package " ++ display pkg ++ " requires "
++ display (PackageIdentifier name ver)
| (pkg, ver) <- inconsistencies ]
-- | For an invalid plan, produce a detailed list of problems as human readable
-- error messages. This is mainly intended for debugging purposes.
-- Use 'showPlanProblem' for a human readable explanation.
--
problems :: OS -> Arch -> CompilerId
-> PackageIndex (PlanPackage a) -> [PlanProblem a]
problems os arch comp index =
[ PackageInvalid pkg (configuredPackageProblems os arch comp pkg)
| Configured pkg <- PackageIndex.allPackages index ]
++ [ PackageMissingDeps pkg missingDeps
| (pkg, missingDeps) <- PackageIndex.brokenPackages index ]
++ [ PackageCycle cycleGroup
| cycleGroup <- PackageIndex.dependencyCycles index ]
++ [ PackageInconsistency name inconsistencies
| (name, inconsistencies) <- PackageIndex.dependencyInconsistencies index ]
-- | The graph of packages (nodes) and dependencies (edges) must be acyclic.
--
-- * if the result is @False@ use 'PackageIndex.dependencyCycles' to find out
-- which packages are involved in dependency cycles.
--
acyclic :: PackageIndex (PlanPackage a) -> Bool
acyclic = null . PackageIndex.dependencyCycles
-- | An installation plan is closed if for every package in the set, all of
-- its dependencies are also in the set. That is, the set is closed under the
-- dependency relation.
--
-- * if the result is @False@ use 'PackageIndex.brokenPackages' to find out
-- which packages depend on packages not in the index.
--
closed :: PackageIndex (PlanPackage a) -> Bool
closed = null . PackageIndex.brokenPackages
-- | An installation plan is consistent if all dependencies that target a
-- single package name, target the same version.
--
-- This is slightly subtle. It is not the same as requiring that there be at
-- most one version of any package in the set. It only requires that of
-- packages which have more than one other package depending on them. We could
-- actually make the condition even more precise and say that different
-- versions are ok so long as they are not both in the transative closure of
-- any other package (or equivalently that their inverse closures do not
-- intersect). The point is we do not want to have any packages depending
-- directly or indirectly on two different versions of the same package. The
-- current definition is just a safe aproximation of that.
--
-- * if the result is @False@ use 'PackageIndex.dependencyInconsistencies' to
-- find out which packages are.
--
consistent :: PackageIndex (PlanPackage a) -> Bool
consistent = null . PackageIndex.dependencyInconsistencies
configuredPackageValid :: OS -> Arch -> CompilerId -> ConfiguredPackage -> Bool
configuredPackageValid os arch comp pkg =
null (configuredPackageProblems os arch comp pkg)
data PackageProblem = DuplicateFlag FlagName
| MissingFlag FlagName
| ExtraFlag FlagName
| DuplicateDeps [PackageIdentifier]
| MissingDep Dependency
| ExtraDep PackageIdentifier
| InvalidDep Dependency PackageIdentifier
showPackageProblem :: PackageProblem -> String
showPackageProblem (DuplicateFlag (FlagName flag)) =
"duplicate flag in the flag assignment: " ++ flag
showPackageProblem (MissingFlag (FlagName flag)) =
"missing an assignment for the flag: " ++ flag
showPackageProblem (ExtraFlag (FlagName flag)) =
"extra flag given that is not used by the package: " ++ flag
showPackageProblem (DuplicateDeps pkgids) =
"duplicate packages specified as selected dependencies: "
++ intercalate ", " (map display pkgids)
showPackageProblem (MissingDep dep) =
"the package has a dependency " ++ display dep
++ " but no package has been selected to satisfy it."
showPackageProblem (ExtraDep pkgid) =
"the package configuration specifies " ++ display pkgid
++ " but (with the given flag assignment) the package does not actually"
++ " depend on any version of that package."
showPackageProblem (InvalidDep dep pkgid) =
"the package depends on " ++ display dep
++ " but the configuration specifies " ++ display pkgid
++ " which does not satisfy the dependency."
configuredPackageProblems :: OS -> Arch -> CompilerId
-> ConfiguredPackage -> [PackageProblem]
configuredPackageProblems os arch comp
(ConfiguredPackage pkg specifiedFlags specifiedDeps) =
[ DuplicateFlag flag | ((flag,_):_) <- duplicates specifiedFlags ]
++ [ MissingFlag flag | OnlyInLeft flag <- mergedFlags ]
++ [ ExtraFlag flag | OnlyInRight flag <- mergedFlags ]
++ [ DuplicateDeps pkgs
| pkgs <- duplicatesBy (comparing packageName) specifiedDeps ]
++ [ MissingDep dep | OnlyInLeft dep <- mergedDeps ]
++ [ ExtraDep pkgid | OnlyInRight pkgid <- mergedDeps ]
++ [ InvalidDep dep pkgid | InBoth dep pkgid <- mergedDeps
, not (packageSatisfiesDependency pkgid dep) ]
where
mergedFlags = mergeBy compare
(sort $ map flagName (genPackageFlags (packageDescription pkg)))
(sort $ map fst specifiedFlags)
mergedDeps = mergeBy
(\dep pkgid -> dependencyName dep `compare` packageName pkgid)
(sortBy (comparing dependencyName) requiredDeps)
(sortBy (comparing packageName) specifiedDeps)
packageSatisfiesDependency
(PackageIdentifier name version)
(Dependency name' versionRange) = assert (name == name') $
version `withinRange` versionRange
dependencyName (Dependency name _) = name
requiredDeps :: [Dependency]
requiredDeps =
--TODO: use something lower level than finalizePackageDescription
case finalizePackageDescription specifiedFlags
(Nothing :: Maybe (PackageIndex PackageIdentifier)) os arch comp []
(packageDescription pkg) of
Right (resolvedPkg, _) -> buildDepends resolvedPkg
Left _ -> error "configuredPackageInvalidDeps internal error"
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment