Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/6835d7f6ed8fb850ae3286781621fac60c0bdb51 >--------------------------------------------------------------- commit 6835d7f6ed8fb850ae3286781621fac60c0bdb51 Author: Duncan Coutts <[email protected]> Date: Mon Jun 2 11:18:16 2008 +0000 Support top level dependency version constraints and error messages for when they're unsatisfiable or conflict >--------------------------------------------------------------- cabal-install/Hackage/Dependency/TopDown.hs | 51 ++++++++++++++++++++------- cabal-install/Hackage/Dependency/Types.hs | 6 +++- 2 files changed, 43 insertions(+), 14 deletions(-) diff --git a/cabal-install/Hackage/Dependency/TopDown.hs b/cabal-install/Hackage/Dependency/TopDown.hs index 7fc8cae..051d284 100644 --- a/cabal-install/Hackage/Dependency/TopDown.hs +++ b/cabal-install/Hackage/Dependency/TopDown.hs @@ -25,9 +25,7 @@ import Hackage.Types ( UnresolvedDependency(..), AvailablePackage(..) , ConfiguredPackage(..) ) import Hackage.Dependency.Types - ( DependencyResolver, Progress ) -import qualified Hackage.Dependency.Types as Progress - ( Progress(..), foldProgress ) + ( DependencyResolver, Progress(..), foldProgress ) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.PackageIndex (PackageIndex) @@ -53,7 +51,7 @@ import Distribution.Text import Data.List ( foldl', maximumBy, minimumBy, deleteBy, nub, sort ) import Data.Maybe - ( fromJust, catMaybes ) + ( fromJust ) import Data.Monoid ( Monoid(mempty) ) import Control.Monad @@ -86,13 +84,13 @@ data SearchSpace inherited pkg explore :: SearchSpace a SelectablePackage -> Progress Log Failure a -explore (Failure failure) = Progress.Fail failure -explore (ChoiceNode result []) = Progress.Done result +explore (Failure failure) = Fail failure +explore (ChoiceNode result []) = Done result explore (ChoiceNode _ choices) = case [ choice | [choice] <- choices ] of - ((pkg, node'):_) -> Progress.Step (Select pkg []) (explore node') + ((pkg, node'):_) -> Step (Select pkg []) (explore node') [] -> seq pkgs' -- avoid retaining defaultChoice - $ Progress.Step (Select pkg pkgs') (explore node') + $ Step (Select pkg pkgs') (explore node') where choice = minimumBy (comparing topSortNumber) choices (pkg, node') = maximumBy (comparing (packageId . fst)) choice @@ -191,9 +189,7 @@ topDownResolver :: DependencyResolver a topDownResolver = (((((mapMessages .).).).).) . topDownResolver' where mapMessages :: Progress Log Failure a -> Progress String String a - mapMessages = Progress.foldProgress (Progress.Step . showLog) - (Progress.Fail . showFailure) - Progress.Done + mapMessages = foldProgress (Step . showLog) (Fail . showFailure) Done -- | The native resolver with detailed structured logging and failure types. -- @@ -203,8 +199,9 @@ topDownResolver' :: OS -> Arch -> CompilerId -> [UnresolvedDependency] -> Progress Log Failure [PlanPackage a] topDownResolver' os arch comp installed available deps = - fmap (uncurry finalise) - $ search (configurePackage os arch comp) constraints initialPkgNames + fmap (uncurry finalise) + . (\cs -> search (configurePackage os arch comp) cs initialPkgNames) + =<< constrainTopLevelDeps deps constraints where --TODO add actual constraints using addTopLevelDependencyConstraint @@ -221,6 +218,15 @@ topDownResolver' os arch comp installed available deps = . PackageIndex.fromList . finaliseSelectedPackages selected +constrainTopLevelDeps :: [UnresolvedDependency] -> Constraints + -> Progress a Failure Constraints +constrainTopLevelDeps [] cs = Done cs +constrainTopLevelDeps (UnresolvedDependency dep _:deps) cs = + case addTopLevelDependencyConstraint dep cs of + Satisfiable cs' -> constrainTopLevelDeps deps cs' + Unsatisfiable -> Fail (TopLevelDependencyUnsatisfiable dep) + ConflictsWith conflicts -> Fail (TopLevelDependencyConflict dep conflicts) + configurePackage :: OS -> Arch -> CompilerId -> ConfigurePackage configurePackage os arch comp available spkg = case spkg of InstalledOnly ipkg -> Right (InstalledOnly ipkg) @@ -440,6 +446,10 @@ showExclusionReason pkgid ExcludedByConfigureFail = showExclusionReason pkgid (ExcludedByPackageDependency pkgid' dep) = display pkgid ++ " was excluded because " ++ display pkgid' ++ " requires " ++ display (untagDependency dep) +showExclusionReason pkgid (ExcludedByTopLevelDependency dep) = + display pkgid ++ " was excluded because of the top level dependency " ++ + display dep + -- ------------------------------------------------------------ -- * Logging progress and failures @@ -453,6 +463,11 @@ data Failure | DependencyConflict SelectedPackage TaggedDependency [(PackageIdentifier, [ExclusionReason])] + | TopLevelDependencyConflict + Dependency + [(PackageIdentifier, [ExclusionReason])] + | TopLevelDependencyUnsatisfiable + Dependency showLog :: Log -> String showLog (Select selected discarded) = @@ -493,6 +508,16 @@ showFailure (DependencyConflict pkg (TaggedDependency _ dep) conflicts) = ++ unlines [ showExclusionReason (packageId pkg') reason | (pkg', reasons) <- conflicts, reason <- reasons ] +showFailure (TopLevelDependencyConflict dep conflicts) = + "dependencies conflict: " + ++ "top level dependency " ++ display dep ++ " however\n" + ++ unlines [ showExclusionReason (packageId pkg') reason + | (pkg', reasons) <- conflicts, reason <- reasons ] + +showFailure (TopLevelDependencyUnsatisfiable (Dependency name ver)) = + "There is no available version of " ++ name + ++ " that satisfies " ++ display ver + -- ------------------------------------------------------------ -- * Utils -- ------------------------------------------------------------ diff --git a/cabal-install/Hackage/Dependency/Types.hs b/cabal-install/Hackage/Dependency/Types.hs index 3b1ef54..be7beb3 100644 --- a/cabal-install/Hackage/Dependency/Types.hs +++ b/cabal-install/Hackage/Dependency/Types.hs @@ -69,5 +69,9 @@ foldProgress step fail done = fold fold (Fail f) = fail f fold (Done r) = done r -instance Functor (Progress step failure) where +instance Functor (Progress step fail) where fmap f = foldProgress Step Fail (Done . f) + +instance Monad (Progress step fail) where + return a = Done a + p >>= f = foldProgress Step Fail f p _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
