All,
If you want to play with the new dependency resolver stuff then here is a
bunch of patches.
Dependency resolvers are now expected to produce a valid InstallPlan. There
is new error checking code to tell you all the ways in which the InstallPlan
your dep resolver produced, is invalid.
The current dep resolver can sometimes produce valid install plans but can
easily be persuaded into making invalid ones, especially if you have many
broken packages installed.
So there's still some work to be done to make the dep resolvers more
pluggable and to try to patch up the current dep resolver a bit.
Duncan
Sun May 4 20:45:30 BST 2008 Duncan Coutts <[EMAIL PROTECTED]>
* Add new utils, duplicates, duplicatesBy and mergeBy
Sun May 4 21:17:42 BST 2008 Duncan Coutts <[EMAIL PROTECTED]>
* Use the mergeBy from the Utils module
Sun May 4 21:18:57 BST 2008 Duncan Coutts <[EMAIL PROTECTED]>
* 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.
Mon May 5 10:05:13 BST 2008 Duncan Coutts <[EMAIL PROTECTED]>
* Packages are only invalid if they have more than zero problems.
Mon May 5 10:17:43 BST 2008 Duncan Coutts <[EMAIL PROTECTED]>
* Switch from DepGraph to InstallPlan
The dependency resolver has had to be extended in a slightly hacky
way to gather the extra information needed by an install plan. In
particular it requires the flags to use to configure each package,
the actual versions of dependencies to use and all of the
installed packages and their closure of dependencies.
However the current resolver is fairly naive and so can be easily
persuaded into producing an invalid install plan, in which case
you'll get a detailed list of reasons as to why it is invalid.
New patches:
[Add new utils, duplicates, duplicatesBy and mergeBy
Duncan Coutts <[EMAIL PROTECTED]>**20080504194530] {
hunk ./Hackage/Utils.hs 9
+import Data.List
+ ( sortBy, groupBy )
hunk ./Hackage/Utils.hs 28
+-- | Generic merging utility. For sorted input lists this is a full outer join.
+--
+-- * The result list never contains @(Nothing, Nothing)@.
+--
+mergeBy :: (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
+mergeBy cmp = merge
+ where
+ merge [] ys = [ OnlyInRight y | y <- ys]
+ merge xs [] = [ OnlyInLeft x | x <- xs]
+ merge (x:xs) (y:ys) =
+ case x `cmp` y of
+ GT -> OnlyInRight y : merge (x:xs) ys
+ EQ -> InBoth x y : merge xs ys
+ LT -> OnlyInLeft x : merge xs (y:ys)
+
+data MergeResult a b = OnlyInLeft a | InBoth a b | OnlyInRight b
+
+duplicates :: Ord a => [a] -> [[a]]
+duplicates = duplicatesBy compare
+
+duplicatesBy :: (a -> a -> Ordering) -> [a] -> [[a]]
+duplicatesBy cmp = filter moreThanOne . groupBy eq . sortBy cmp
+ where
+ eq a b = case cmp a b of
+ EQ -> True
+ _ -> False
+ moreThanOne (_:_:_) = True
+ moreThanOne _ = False
+
}
[Use the mergeBy from the Utils module
Duncan Coutts <[EMAIL PROTECTED]>**20080504201742] {
hunk ./Hackage/List.hs 45
+import Hackage.Utils (mergeBy, MergeResult(..))
+
hunk ./Hackage/List.hs 170
- map (\(is, as) -> (maybe [] snd is
- ,maybe [] snd as))
+ map collect
hunk ./Hackage/List.hs 174
+ where
+ collect (OnlyInLeft (_,is) ) = (is, [])
+ collect ( InBoth (_,is) (_,as)) = (is, as)
+ collect (OnlyInRight (_,as)) = ([], as)
hunk ./Hackage/List.hs 184
--- | Generic merging utility. For sorted input lists this is a full outer join.
---
--- * The result list never contains @(Nothing, Nothing)@.
---
-mergeBy :: (a -> b -> Ordering) -> [a] -> [b] -> [(Maybe a, Maybe b)]
-mergeBy cmp = merge
- where
- merge [] ys = [ (Nothing, Just y) | y <- ys]
- merge xs [] = [ (Just x, Nothing) | x <- xs]
- merge (x:xs) (y:ys) =
- case x `cmp` y of
- GT -> (Nothing, Just y) : merge (x:xs) ys
- EQ -> (Just x, Just y) : merge xs ys
- LT -> (Just x, Nothing) : merge xs (y:ys)
-
}
[Improve InstallPlan error checking and reporting
Duncan Coutts <[EMAIL PROTECTED]>**20080504201857
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.
] {
hunk ./Hackage/InstallPlan.hs 29
- complete,
+ closed,
hunk ./Hackage/InstallPlan.hs 32
- validConfiguredPackage,
+ configuredPackageValid,
+
+ -- ** Details on invalid plans
+ PlanProblem(..),
+ showPlanProblem,
+ PackageProblem(..),
+ showPackageProblem,
+ problems,
+ configuredPackageProblems
hunk ./Hackage/InstallPlan.hs 44
- ( AvailablePackage(packageDescription), UnresolvedDependency )
+ ( AvailablePackage(packageDescription) )
hunk ./Hackage/InstallPlan.hs 46
- ( PackageIdentifier(..), Package(..), PackageFixedDeps(..) )
+ ( PackageIdentifier(..), Package(..), PackageFixedDeps(..)
+ , packageName, Dependency(..) )
+import Distribution.Version
+ ( Version, withinRange )
hunk ./Hackage/InstallPlan.hs 55
- , Flag(MkFlag, flagName), FlagAssignment )
+ , Flag(flagName), FlagName(..), FlagAssignment )
hunk ./Hackage/InstallPlan.hs 61
-import Distribution.Simple.Utils
- ( comparing, equating )
hunk ./Hackage/InstallPlan.hs 67
+import Hackage.Utils
+ ( duplicates, duplicatesBy, mergeBy, MergeResult(..) )
+import Distribution.Simple.Utils
+ ( comparing, intercalate )
hunk ./Hackage/InstallPlan.hs 73
- ( sort, sortBy, groupBy )
-import Data.Maybe
- ( isJust )
-import qualified Data.Graph as Graph
- ( SCC(..), stronglyConnCompR )
+ ( sort, sortBy )
hunk ./Hackage/InstallPlan.hs 103
--- 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.
hunk ./Hackage/InstallPlan.hs 109
--- 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
hunk ./Hackage/InstallPlan.hs 116
--- final configure process will be independent of the environment.
+-- final configure process will be independent of the environment.
hunk ./Hackage/InstallPlan.hs 157
-toList :: InstallPlan buildResult -> [PlanPackage buildResult]
-toList = PackageIndex.allPackages . planIndex
-
hunk ./Hackage/InstallPlan.hs 161
--- 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
-
hunk ./Hackage/InstallPlan.hs 163
-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
hunk ./Hackage/InstallPlan.hs 214
--- packages that depended on it.
---
+-- packages that depended on it as having failed.
hunk ./Hackage/InstallPlan.hs 216
--- * The package must exist in the graph.
+-- * The package must exist in the graph and be in the configured state.
hunk ./Hackage/InstallPlan.hs 218
-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
hunk ./Hackage/InstallPlan.hs 227
- 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
hunk ./Hackage/InstallPlan.hs 235
- index0 = planIndex plan
hunk ./Hackage/InstallPlan.hs 236
- markDepsAsFailed pkgid index =
- case PackageIndex.lookupPackageId index pkgid of
+ markDepsAsFailed pkgid' index' =
+ case PackageIndex.lookupPackageId index' pkgid' of
hunk ./Hackage/InstallPlan.hs 239
- 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"
}
[Packages are only invalid if they have more than zero problems.
Duncan Coutts <[EMAIL PROTECTED]>**20080505090513] {
hunk ./Hackage/InstallPlan.hs 294
- [ PackageInvalid pkg (configuredPackageProblems os arch comp pkg)
- | Configured pkg <- PackageIndex.allPackages index ]
+ [ PackageInvalid pkg packageProblems
+ | Configured pkg <- PackageIndex.allPackages index
+ , let packageProblems = configuredPackageProblems os arch comp pkg
+ , not (null packageProblems) ]
}
[Switch from DepGraph to InstallPlan
Duncan Coutts <[EMAIL PROTECTED]>**20080505091743
The dependency resolver has had to be extended in a slightly hacky
way to gather the extra information needed by an install plan. In
particular it requires the flags to use to configure each package,
the actual versions of dependencies to use and all of the
installed packages and their closure of dependencies.
However the current resolver is fairly naive and so can be easily
persuaded into producing an invalid install plan, in which case
you'll get a detailed list of reasons as to why it is invalid.
] {
hunk ./Hackage/DepGraph.hs 1
------------------------------------------------------------------------------
--- |
--- Module : Hackage.DepGraph
--- Copyright : (c) Duncan Coutts 2008
--- License : BSD-like
---
--- Maintainer : [EMAIL PROTECTED]
--- Stability : provisional
--- Portability : portable
---
--- Package dependency graph
---
------------------------------------------------------------------------------
-module Hackage.DepGraph (
- DepGraph, ResolvedPackage(..),
- fromList, toList,
- empty,
- ready,
- removeCompleted,
- removeFailed
- ) where
-
-import Hackage.Types
-import Distribution.Package
- ( PackageIdentifier, Package(..), PackageFixedDeps(..) )
-import Distribution.PackageDescription
- ( FlagAssignment )
-import Distribution.Text
- ( display )
-import Distribution.Simple.Utils
- ( intercalate, equating )
-
-import Data.List
- ( partition, intersect, nubBy )
-import Control.Exception
- ( assert )
-
-data ResolvedPackage = ResolvedPackage AvailablePackage FlagAssignment [PackageIdentifier]
- deriving Show
-
-instance Package ResolvedPackage where
- packageId (ResolvedPackage p _ _) = packageId p
-
-instance PackageFixedDeps ResolvedPackage where
- depends (ResolvedPackage _ _ d) = d
-
--- | A package dependency graph
---
--- * Invariant: the graph is acyclic
---
-newtype DepGraph = DepGraph [ResolvedPackage]
-
--- | Build a dependency graph from a set of resolved packages.
---
--- * The dependencies must not by cyclic.
---
-fromList :: [ResolvedPackage] -> DepGraph
-fromList = DepGraph . nubBy (equating packageId)
-
-toList :: DepGraph -> [ResolvedPackage]
-toList (DepGraph g) = g
-
--- | Is the graph empty?
-empty :: DepGraph -> Bool
-empty (DepGraph g) = null g
-
-
--- | The next package, meaning a package which has no dependencies.
---
--- * The graph must be non-empty.
---
-ready :: DepGraph -> ResolvedPackage
-ready (DepGraph pkgs) =
- case [ pkg | pkg@(ResolvedPackage _ _ []) <- pkgs ] of
- [] -> error $ "DepGraph.head: internal error: no nodes with 0-outdegree\n"
- ++ unlines (map show pkgs)
- (pkg:_) -> pkg
-
-
--- | Remove a package from the graph, getting back an updated graph.
---
--- * The package must exist in the graph.
--- * The package must have had no dependent packages.
---
-removeCompleted :: PackageIdentifier -> DepGraph -> DepGraph
-removeCompleted pkgid (DepGraph pkgs) =
- case partition isCompleted pkgs of
- ([_pkg], pkgs') -> DepGraph [ ResolvedPackage pkg fs (filter (/=pkgid) deps)
- | ResolvedPackage pkg fs deps <- pkgs' ]
- _ -> error $ "DepGraph.removeCompleted: no such package "
- ++ display pkgid
- ++ "\nin DepGraph: "
- ++ intercalate ", "
- (map (display . packageId) pkgs)
-
- where isCompleted = (==pkgid) . packageId
-
--- | Remove a package and all the packages that depend on it from the graph.
---
--- You get back an updated graph and a list of packages that were removed
--- (the given package will be first in that list).
---
--- * The package must exist in the graph.
---
-removeFailed :: PackageIdentifier -> DepGraph -> (DepGraph, [ResolvedPackage])
-removeFailed pkgid (DepGraph pkgs0) =
- case partition ((==pkgid) . packageId) pkgs0 of
- ([pkg], pkgs') -> case remove [pkg] [pkgid] pkgs' of
- result -> assert (packageId p == pkgid) result
- where (_,p:_) = result
- ((_:_),_) -> error $ "DepGraph.removeFailed: internal error multiple instances of "
- ++ display pkgid
- _ -> error $ "DepGraph.removeFailed: no such package "
- ++ display pkgid
-
- where
- remove rmpkgs pkgids pkgs =
- case partition (not . null . intersect pkgids . depends) pkgs of
- ([], _) -> (DepGraph pkgs, rmpkgs)
- (rmpkgs', pkgs') -> remove (rmpkgs ++ rmpkgs') pkgids' pkgs'
- where pkgids' = map packageId rmpkgs'
rmfile ./Hackage/DepGraph.hs
hunk ./Hackage/Dependency.hs 23
-import qualified Hackage.DepGraph as DepGraph
+import qualified Hackage.InstallPlan as InstallPlan
+import Hackage.InstallPlan (InstallPlan)
hunk ./Hackage/Dependency.hs 37
-import Distribution.Simple.Utils (comparing)
+import Distribution.Simple.Utils (comparing, intercalate)
+import Distribution.Text
+ ( display )
hunk ./Hackage/Dependency.hs 52
- -> Either [Dependency] DepGraph.DepGraph
+ -> Either [Dependency] (InstallPlan a)
hunk ./Hackage/Dependency.hs 54
- packagesToInstall
+ packagesToInstall os arch comp installed
hunk ./Hackage/Dependency.hs 57
-resolveDependencies _ _ _ Nothing available deps =
- packagesToInstall (resolveDependenciesBogusly available deps)
+resolveDependencies os arch comp Nothing available deps =
+ packagesToInstall os arch comp undefined
+ (resolveDependenciesBogusly available deps)
hunk ./Hackage/Dependency.hs 72
+{-
+type DependencyResolver a = OS
+ -> Arch
+ -> CompilerId
+ -> PackageIndex InstalledPackageInfo
+ -> PackageIndex AvailablePackage
+ -> [UnresolvedDependency]
+ -> InstallPlan.InstallPlan a
+
+-- | This is an example resolver that produces valid plans but plans where we
+-- say that every package failed.
+--
+failingResolver :: DependencyResolver a
+failingResolver os arch compiler _ _ deps =
+ InstallPlan.new os arch compiler $
+ PackageIndex.fromList (map InstallPlan.Unresolved deps)
+-}
+
hunk ./Hackage/Dependency.hs 104
- let deps = getDependencies os arch comp installed available (packageDescription pkg) flags
- resolved = map (\d -> resolveDependency os arch comp installed available d []) deps
- return $ AvailableDependency dep pkg flags resolved
+ (deps, flags') <- getDependencies os arch comp installed available
+ (packageDescription pkg) flags
+ return $ AvailableDependency dep pkg flags'
+ [ resolveDependency os arch comp installed available dep' []
+ | dep' <- deps ]
hunk ./Hackage/Dependency.hs 134
- -> [Dependency]
+ -> Maybe ([Dependency], FlagAssignment)
hunk ./Hackage/Dependency.hs 140
- Left missing -> missing
- Right (desc,_) -> buildDepends desc
+ Left _missing -> Nothing
+ Right (desc,flags') -> Just (buildDepends desc, flags')
hunk ./Hackage/Dependency.hs 153
-packagesToInstall :: [ResolvedDependency]
- -> Either [Dependency] DepGraph.DepGraph
+packagesToInstall :: OS -> Arch -> CompilerId
+ -> PackageIndex InstalledPackageInfo
+ -> [ResolvedDependency]
+ -> Either [Dependency] (InstallPlan a)
hunk ./Hackage/Dependency.hs 159
-packagesToInstall deps0 = case unzipEithers (map getDeps deps0) of
- ([], ok) -> Right (DepGraph.fromList (concatMap snd ok))
- (missing, _) -> Left (concat missing)
+packagesToInstall os arch comp allInstalled deps0 =
+ case unzipEithers (map getAvailable deps0) of
+ ([], ok) ->
+ let selectedAvailable :: [InstallPlan.ConfiguredPackage]
+ selectedAvailable = concatMap snd ok
+
+ selectedInstalled :: [InstalledPackageInfo]
+ selectedInstalled = either PackageIndex.allPackages
+ (\borked -> error $ unlines
+ [ "Package " ++ display (packageId pkg)
+ ++ " depends on the following packages which are missing from the plan "
+ ++ intercalate ", " (map display missingDeps)
+ | (pkg, missingDeps) <- borked ])
+ $ PackageIndex.dependencyClosure
+ allInstalled
+ (getInstalled deps0)
+ index = PackageIndex.fromList
+ $ map InstallPlan.Configured selectedAvailable
+ ++ map InstallPlan.PreExisting selectedInstalled
+ in case InstallPlan.new os arch comp index of
+ Left plan -> Right plan
+ Right problems -> error $ unlines $
+ "internal error: could not construct a valid install plan."
+ : "The proposed (invalid) plan contained the following problems:"
+ : map InstallPlan.showPlanProblem problems
+ (missing, _) -> Left $ concat missing
hunk ./Hackage/Dependency.hs 187
- getDeps :: ResolvedDependency
- -> Either [Dependency]
- (Maybe PackageIdentifier, [DepGraph.ResolvedPackage])
- getDeps (InstalledDependency _ _ ) = Right (Nothing, [])
- getDeps (AvailableDependency _ pkg flags deps) =
- case unzipEithers (map getDeps deps) of
- ([], ok) -> let resolved :: [DepGraph.ResolvedPackage]
- resolved = DepGraph.ResolvedPackage pkg flags
- [ pkgid | (Just pkgid, _) <- ok ]
+ getAvailable :: ResolvedDependency
+ -> Either [Dependency]
+ (PackageIdentifier, [InstallPlan.ConfiguredPackage])
+ getAvailable (InstalledDependency _ pkgid )
+ = Right (pkgid, [])
+ getAvailable (AvailableDependency _ pkg flags deps) =
+ case unzipEithers (map getAvailable deps) of
+ ([], ok) -> let resolved = InstallPlan.ConfiguredPackage pkg flags
+ [ pkgid | (pkgid, _) <- ok ]
hunk ./Hackage/Dependency.hs 197
- in Right (Just $ packageId pkg, resolved)
+ in Right (packageId pkg, resolved)
hunk ./Hackage/Dependency.hs 199
- getDeps (UnavailableDependency dep) = Left [dep]
+ getAvailable (UnavailableDependency dep) = Left [dep]
+
+ getInstalled :: [ResolvedDependency] -> [PackageIdentifier]
+ getInstalled [] = []
+ getInstalled (dep:deps) = case dep of
+ InstalledDependency _ pkgid -> pkgid : getInstalled deps
+ AvailableDependency _ _ _ deps' -> getInstalled (deps'++deps)
+ UnavailableDependency _ -> getInstalled deps
hunk ./Hackage/Fetch.hs 31
-import qualified Hackage.DepGraph as DepGraph
+import qualified Hackage.InstallPlan as InstallPlan
hunk ./Hackage/Fetch.hs 139
- Right pkgs -> do ps <- filterM (fmap not . isFetched)
- [ pkg | (DepGraph.ResolvedPackage pkg _ _) <- DepGraph.toList pkgs ]
- mapM_ (fetchPackage verbosity) ps
+ Right pkgs -> do
+ ps <- filterM (fmap not . isFetched)
+ [ pkg | (InstallPlan.Configured
+ (InstallPlan.ConfiguredPackage pkg _ _))
+ <- InstallPlan.toList pkgs ]
+ mapM_ (fetchPackage verbosity) ps
hunk ./Hackage/Install.hs 29
-import qualified Hackage.DepGraph as DepGraph
+import qualified Hackage.InstallPlan as InstallPlan
+import Hackage.InstallPlan (InstallPlan)
hunk ./Hackage/Install.hs 161
- Right pkgs -> do
+ Right installPlan -> do
hunk ./Hackage/Install.hs 163
- then printDryRun verbosity pkgs >> return []
- else installPackages verbosity scriptOptions miscOptions configFlags pkgs
+ then printDryRun verbosity installPlan >> return []
+ else executeInstallPlan verbosity scriptOptions miscOptions
+ configFlags installPlan >> return []
hunk ./Hackage/Install.hs 200
- Right pkgs
- | DepGraph.empty pkgs -> notice verbosity
+ Right installPlan
+ | InstallPlan.done installPlan -> notice verbosity
hunk ./Hackage/Install.hs 204
- | dryRun miscOptions -> do
- printDryRun verbosity pkgs
- return []
- | otherwise -> installPackages verbosity scriptOptions miscOptions configFlags pkgs
+ | dryRun miscOptions -> printDryRun verbosity installPlan >> return []
+ | otherwise -> executeInstallPlan verbosity scriptOptions miscOptions
+ configFlags installPlan >> return []
hunk ./Hackage/Install.hs 208
-printDryRun :: Verbosity -> DepGraph.DepGraph -> IO ()
+printDryRun :: Verbosity -> InstallPlan BuildResult -> IO ()
hunk ./Hackage/Install.hs 210
- | DepGraph.empty pkgs = notice verbosity "No packages to be installed."
+ | InstallPlan.done pkgs = notice verbosity "No packages to be installed."
hunk ./Hackage/Install.hs 216
- | DepGraph.empty ps = []
+ | InstallPlan.done ps = []
hunk ./Hackage/Install.hs 218
- let (DepGraph.ResolvedPackage pkgInfo _ _) = DepGraph.ready ps
+ let (InstallPlan.ConfiguredPackage pkgInfo _ _) = InstallPlan.next ps
hunk ./Hackage/Install.hs 220
- in (pkgId : order (DepGraph.removeCompleted pkgId ps))
+ in (pkgId : order (InstallPlan.completed pkgId ps))
hunk ./Hackage/Install.hs 222
-installPackages :: Verbosity
- -> SetupScriptOptions
- -> InstallMisc
- -> Cabal.ConfigFlags -- ^Options which will be passed to every package.
- -> DepGraph.DepGraph
- -> IO [(PackageIdentifier, BuildResult)]
-installPackages verbosity scriptOptions miscOptions configFlags = installPackagesErrs []
+executeInstallPlan :: Verbosity
+ -> SetupScriptOptions
+ -> InstallMisc
+ -> Cabal.ConfigFlags -- ^Options which will be passed to every package.
+ -> InstallPlan BuildResult
+ -> IO (InstallPlan BuildResult)
+executeInstallPlan verbosity scriptOptions miscOptions configFlags = execute
hunk ./Hackage/Install.hs 230
- installPackagesErrs :: [(PackageIdentifier, BuildResult)]
- -> DepGraph.DepGraph
- -> IO [(PackageIdentifier, BuildResult)]
- installPackagesErrs done remaining
- | DepGraph.empty remaining = return (reverse done)
- | otherwise = case DepGraph.ready remaining of
- DepGraph.ResolvedPackage pkg flags _depids -> do--TODO build against exactly these deps
+ execute :: InstallPlan BuildResult -> IO (InstallPlan BuildResult)
+ execute plan
+ | InstallPlan.done plan = return plan
+ | otherwise = case InstallPlan.next plan of
+ InstallPlan.ConfiguredPackage pkg flags _depids -> do--TODO build against exactly these deps
hunk ./Hackage/Install.hs 238
- BuildOk ->
- let remaining' = DepGraph.removeCompleted pkgid remaining
- in installPackagesErrs ((pkgid, buildResult):done) remaining'
- _ ->
- let (remaining', _:failed) = DepGraph.removeFailed pkgid remaining
- -- So this first pkgid failed for whatever reason (buildResult)
- -- all the other packages that depended on this pkgid which we
- -- now cannot build (failed :: [ResolvedPackage]) we mark as
- -- failing due to DependentFailed which kind of means it was
- -- not their fault.
- done' = (pkgid, buildResult)
- : [ (packageId pkg', DependentFailed pkgid)
- | pkg' <- failed ]
- in installPackagesErrs (done'++done) remaining'
+ BuildOk -> execute $ InstallPlan.completed pkgid plan
+ _ -> execute $ InstallPlan.failed pkgid buildResult depResult plan
+ where depResult = DependentFailed pkgid
+ -- So this first pkgid failed for whatever reason (buildResult) all
+ -- the other packages that depended on this pkgid which we now
+ -- cannot build we mark as failing due to DependentFailed which
+ -- kind of means it was not their fault.
hunk ./cabal-install.cabal 42
- Hackage.DepGraph
}
Context:
[Update for flipped order of args for PackageIndex.insert
Duncan Coutts <[EMAIL PROTECTED]>**20080504193722]
[Don't echo when prompting for the hackage upload password.
Duncan Coutts <[EMAIL PROTECTED]>**20080501214456
Fixes ticket #268. And use newtypes for the username and password,
just to be more sure we're not mixing them up with other strings.
]
[Remove the resolveDependenciesLocal, implement it via resolveDependencies
Duncan Coutts <[EMAIL PROTECTED]>**20080430193351
The local variant was for the case that we were starting from a package
description rather than a dependency to a named package. In the local
case we not only need to resolve the dependencies of the package but also
to find a flag assignment for the local package. This case crops up in
the resolver normally when we try to satisfy a dependency, we have to
pick a flag assignment for the dependency and resolve its dependencies.
It is annoying to have both entry points, especially as we want the
resolver to be plugable. So instead we define the local package as an
available package, then by resolving a single dependency on exactly the
name and version of the local package then we can get an install plan for
the local package. It also requires generalising installPkg to deal with
the local case.
]
[Generalise and rename PkgInfo to include local packages
Duncan Coutts <[EMAIL PROTECTED]>**20080430180922
Renamed to AvailablePackage since that what it is really.
Now instead of just representing packages from a remote hackage repo
it includes an alternative for a local unpacked package. In future
we should add more alternatives, eg for other local packages (ie not
just the one that's unpacked in the current dir) and for remote
packages in source control like darcs, git etc.
]
[Convert the Install module to use the new SetupWrapper
Duncan Coutts <[EMAIL PROTECTED]>**20080430115021
And refactor slightly to batch some of the misc parameters
together in a record rather than passing them all separately.
]
[Add a new --cabal-lib-version flag to the install command
Duncan Coutts <[EMAIL PROTECTED]>**20080430114709
It's used to select which version of the Cabal lib to use when
configuring, building and installing packages. It's mainly so that
we can use cabal-install to help us test that packages build ok with
both old and new versions of the Cabal library. In particular we'd
like to check every package on hackage to make sure that new Cabal
versions are not breaking packages that worked with older versions.
]
[Convert Main to use the new SetupWrapper module
Duncan Coutts <[EMAIL PROTECTED]>**20080430114604]
[Fix setupWrapper bug, when no compiler was configured
Duncan Coutts <[EMAIL PROTECTED]>**20080430114448]
[Add replacement SetupWrapper module
Duncan Coutts <[EMAIL PROTECTED]>**20080430103412
Clearer code and a wider interface to give more control.
]
[Simplify the way we derive configure, install and upgrade commands
Duncan Coutts <[EMAIL PROTECTED]>**20080430085201
so we do not accidentally inherit the default flags for the underlying
configure command when we in fact want the empty flags. I am beginning
to suspect that having any defaults at all was a mistake.
]
[Make the default SavedConfig contain empty rather than default ConfigFlags
Duncan Coutts <[EMAIL PROTECTED]>**20080430084938
We do not want to pass a load of default command line flags. We only want
to pass flags where we're overriding the defaults.
Also it's because old Cabal versions do not understand new flags.
]
[Rearange install plan checking code
Duncan Coutts <[EMAIL PROTECTED]>**20080424224159
Make it usable for callers that want to check
properties before constructing an InstallPlan.
]
[Update for checkPackage change
Duncan Coutts <[EMAIL PROTECTED]>**20080423153817]
[Update for FlagAssignment changes
Duncan Coutts <[EMAIL PROTECTED]>**20080420191543]
[Add new InstallPlan type
Duncan Coutts <[EMAIL PROTECTED]>**20080414171914
This is joint work with Kolmodin.
An InstallPlan records what we want to install and records the outcome
of installing packages. It has a fairly strict internal invariant which
should guarantee that each package can be configured sucessfully.
]
[Simplify install --only implementation
Duncan Coutts <[EMAIL PROTECTED]>**20080414143457
The install --only doesn't do any planning or build
reporting so make it completely separate so we do
not have to make up fake build plans or results.
]
[Change resolveDependencies to take OS and Arch as parameters
Duncan Coutts <[EMAIL PROTECTED]>**20080414000419
Rather than using global 'constants' for the current os and arch.
]
[Make ResolvedDependency an internal detail of dependency calculation
Duncan Coutts <[EMAIL PROTECTED]>**20080413234119
Externally we currently use a DepGraph, though we'll move to a InstallPlan.
This is a step towards making it easier to swap in different package
dependency resolution algorithms. Because we're hiding ResolvedDependency
we have to disable the extended Hackage.Info stuff for the moment.
]
[Relax version constraint on HTTP, seems to work with 3001.1
Duncan Coutts <[EMAIL PROTECTED]>**20080413223940]
[Update for change to finalizePackageDescription
Duncan Coutts <[EMAIL PROTECTED]>**20080413223910]
[Half-done build reporting stuff
**20080412234057]
[Add missing modules in other-modules, fixes sdist
Spencer Janssen <[EMAIL PROTECTED]>**20080330193710]
[TAG 0.4.6
Duncan Coutts <[EMAIL PROTECTED]>**20080329195601]
Patch bundle hash:
a8279940ebb1e7255551943edc04a57a907d1719
_______________________________________________
cabal-devel mailing list
cabal-devel@haskell.org
http://www.haskell.org/mailman/listinfo/cabal-devel
