[commit: Cabal] master: Add PackageInstalledConstraint to the PackageConstraint type (fef4556)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/fef45569284e9a6e019507da8e1330c413c30849

>---------------------------------------------------------------

commit fef45569284e9a6e019507da8e1330c413c30849
Author: Duncan Coutts <duncan at haskell.org>
Date:   Mon Dec 15 22:45:38 2008 +0000

    Add PackageInstalledConstraint to the PackageConstraint type
    This should be useful for things like preventing upgrading
    the base package for ghc.

>---------------------------------------------------------------

 .../Distribution/Client/Dependency/TopDown.hs      |   37 +++++++++++++++++++-
 .../Distribution/Client/Dependency/Types.hs        |    1 +
 2 files changed, 37 insertions(+), 1 deletions(-)

diff --git a/cabal-install/Distribution/Client/Dependency/TopDown.hs b/cabal-install/Distribution/Client/Dependency/TopDown.hs
index 90c6b79..84e0bd3 100644
--- a/cabal-install/Distribution/Client/Dependency/TopDown.hs
+++ b/cabal-install/Distribution/Client/Dependency/TopDown.hs
@@ -41,7 +41,7 @@ import Distribution.PackageDescription
 import Distribution.PackageDescription.Configuration
          ( finalizePackageDescription, flattenPackageDescription )
 import Distribution.Version
-         ( VersionRange, withinRange )
+         ( VersionRange(AnyVersion), withinRange )
 import Distribution.Compiler
          ( CompilerId )
 import Distribution.System
@@ -276,6 +276,16 @@ addTopLevelConstraints (PackageVersionConstraint pkg ver:deps) cs =
     ConflictsWith conflicts ->
       Fail (TopLevelVersionConstraintConflict pkg ver conflicts)
 
+addTopLevelConstraints (PackageInstalledConstraint pkg:deps) cs =
+  case addTopLevelInstalledConstraint pkg cs of
+    Satisfiable cs' _       -> addTopLevelConstraints deps cs'
+
+    Unsatisfiable           ->
+      Fail (TopLevelInstallConstraintUnsatisfiable pkg)
+
+    ConflictsWith conflicts ->
+      Fail (TopLevelInstallConstraintConflict pkg conflicts)
+
 configurePackage :: Platform -> CompilerId -> ConfigurePackage
 configurePackage (Platform arch os) comp available spkg = case spkg of
   InstalledOnly         ipkg      -> Right (InstalledOnly ipkg)
@@ -529,6 +539,17 @@ addTopLevelVersionConstraint pkg ver constraints =
     taggedDep = TaggedDependency NoInstalledConstraint dep
     reason    = ExcludedByTopLevelDependency dep
 
+addTopLevelInstalledConstraint :: PackageName
+                               -> Constraints
+                               -> Satisfiable Constraints
+                                    [PackageIdentifier] ExclusionReason
+addTopLevelInstalledConstraint pkg constraints =
+  Constraints.constrain taggedDep reason constraints
+  where
+    dep       = Dependency pkg AnyVersion
+    taggedDep = TaggedDependency InstalledConstraint dep
+    reason    = ExcludedByTopLevelDependency dep
+
 -- ------------------------------------------------------------
 -- * Reasons for constraints
 -- ------------------------------------------------------------
@@ -590,6 +611,11 @@ data Failure
        [(PackageIdentifier, [ExclusionReason])]
    | TopLevelVersionConstraintUnsatisfiable
        PackageName VersionRange
+   | TopLevelInstallConstraintConflict
+       PackageName
+       [(PackageIdentifier, [ExclusionReason])]
+   | TopLevelInstallConstraintUnsatisfiable
+       PackageName
 
 showLog :: Log -> String
 showLog (Select selected discarded) = case (selectedMsg, discardedMsg) of
@@ -653,6 +679,15 @@ showFailure (TopLevelVersionConstraintUnsatisfiable name ver) =
      "There is no available version of " ++ display name
       ++ " that satisfies " ++ display ver
 
+showFailure (TopLevelInstallConstraintConflict name conflicts) =
+     "constraints conflict: "
+  ++ "top level constraint " ++ display name ++ "-installed however\n"
+  ++ unlines [ showExclusionReason (packageId pkg') reason
+             | (pkg', reasons) <- conflicts, reason <- reasons ]
+
+showFailure (TopLevelInstallConstraintUnsatisfiable name) =
+     "There is no installed version of " ++ display name
+
 -- ------------------------------------------------------------
 -- * Utils
 -- ------------------------------------------------------------
diff --git a/cabal-install/Distribution/Client/Dependency/Types.hs b/cabal-install/Distribution/Client/Dependency/Types.hs
index 6fa1405..ad1385a 100644
--- a/cabal-install/Distribution/Client/Dependency/Types.hs
+++ b/cabal-install/Distribution/Client/Dependency/Types.hs
@@ -66,6 +66,7 @@ type DependencyResolver = Platform
 --
 data PackageConstraint
    = PackageVersionConstraint   PackageName VersionRange
+   | PackageInstalledConstraint PackageName
    | PackageFlagsConstraint     PackageName FlagAssignment
 
 -- | A per-package preference on the version. It is a soft constraint that the