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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/80ce52ccb26badb12341ebaa68b41855f23b3305

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

commit 80ce52ccb26badb12341ebaa68b41855f23b3305
Author: Duncan Coutts <[email protected]>
Date:   Mon Dec 15 22:10:34 2008 +0000

    Mostly renaming and trivial refactoring

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

 .../Distribution/Client/Dependency/Bogus.hs        |   24 ++++++++++------
 .../Distribution/Client/Dependency/TopDown.hs      |   29 +++++++++++---------
 2 files changed, 31 insertions(+), 22 deletions(-)

diff --git a/cabal-install/Distribution/Client/Dependency/Bogus.hs 
b/cabal-install/Distribution/Client/Dependency/Bogus.hs
index 69f9482..6fc5c0f 100644
--- a/cabal-install/Distribution/Client/Dependency/Bogus.hs
+++ b/cabal-install/Distribution/Client/Dependency/Bogus.hs
@@ -16,14 +16,15 @@ module Distribution.Client.Dependency.Bogus (
   ) where
 
 import Distribution.Client.Types
-         ( UnresolvedDependency(..), AvailablePackage(..), 
ConfiguredPackage(..) )
+         ( AvailablePackage(..), ConfiguredPackage(..) )
 import Distribution.Client.Dependency.Types
          ( DependencyResolver, Progress(..)
          , PackageConstraint(..) )
 import qualified Distribution.Client.InstallPlan as InstallPlan
 
 import Distribution.Package
-         ( PackageName, PackageIdentifier(..), Dependency(..), Package(..) )
+         ( PackageName, PackageIdentifier(..), Dependency(..)
+         , Package(..), packageVersion )
 import Distribution.PackageDescription
          ( GenericPackageDescription(..), CondTree(..), FlagAssignment )
 import Distribution.PackageDescription.Configuration
@@ -55,8 +56,8 @@ bogusResolver (Platform arch os) comp _ available _ 
constraints targets =
   resolveFromAvailable [] (combineConstraints constraints targets)
   where
     resolveFromAvailable chosen [] = Done chosen
-    resolveFromAvailable chosen (UnresolvedDependency dep flags : deps) =
-      case latestAvailableSatisfying available dep of
+    resolveFromAvailable chosen ((name, verConstraint, flags): deps) =
+      case latestAvailableSatisfying available name verConstraint of
         Nothing  -> Fail ("Unresolved dependency: " ++ display dep)
         Just apkg@(AvailablePackage _ pkg _) ->
           case finalizePackageDescription flags none os arch comp [] pkg of
@@ -69,6 +70,8 @@ bogusResolver (Platform arch os) comp _ available _ 
constraints targets =
           where
             none :: Maybe (PackageIndex PackageIdentifier)
             none = Nothing
+      where
+        dep = Dependency name verConstraint
 
 fudgeChosenPackage :: AvailablePackage -> FlagAssignment -> ConfiguredPackage
 fudgeChosenPackage (AvailablePackage pkgid pkg source) flags =
@@ -94,9 +97,9 @@ fudgeChosenPackage (AvailablePackage pkgid pkg source) flags =
 
 combineConstraints :: [PackageConstraint]
                    -> [PackageName]
-                   -> [UnresolvedDependency]
+                   -> [(PackageName, VersionRange, FlagAssignment)]
 combineConstraints constraints targets =
-  [ UnresolvedDependency (Dependency name ver) flags
+  [ (name, ver, flags)
   | name <- targets
   , let ver   = fromMaybe AnyVersion (Map.lookup name versionConstraints)
         flags = fromMaybe []         (Map.lookup name flagsConstraints) ]
@@ -111,9 +114,12 @@ combineConstraints constraints targets =
 
 -- | Gets the latest available package satisfying a dependency.
 latestAvailableSatisfying :: PackageIndex AvailablePackage
-                          -> Dependency
+                          -> PackageName -> VersionRange
                           -> Maybe AvailablePackage
-latestAvailableSatisfying index dep =
+latestAvailableSatisfying index name versionConstraint =
   case PackageIndex.lookupDependency index dep of
     []   -> Nothing
-    pkgs -> Just (maximumBy (comparing (pkgVersion . packageId)) pkgs)
+    pkgs -> Just (maximumBy best pkgs)
+  where
+    dep  = Dependency name versionConstraint
+    best = comparing packageVersion
diff --git a/cabal-install/Distribution/Client/Dependency/TopDown.hs 
b/cabal-install/Distribution/Client/Dependency/TopDown.hs
index 47c05d4..c51eeba 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
-         ( withinRange )
+         ( VersionRange, withinRange )
 import Distribution.Compiler
          ( CompilerId )
 import Distribution.System
@@ -237,16 +237,17 @@ topDownResolver' :: Platform -> CompilerId
                  -> [PackageConstraint]
                  -> [PackageName]
                  -> Progress Log Failure [PlanPackage]
-topDownResolver' platform comp installed available pref deps targets =
+topDownResolver' platform comp installed available
+                 userPreferences userConstraints targets =
       fmap (uncurry finalise)
-    . (\cs -> search configure pref cs initialPkgNames)
-  =<< constrainTopLevelDeps deps constraints
+    . (\cs -> search configure userPreferences cs initialPkgNames)
+  =<< constrainTopLevelDeps userConstraints constraints
 
   where
     configure   = configurePackage platform comp
     constraints = Constraints.empty
-                    (annotateInstalledPackages      topSortNumber installed')
-                    (annotateAvailablePackages deps topSortNumber available')
+      (annotateInstalledPackages                 topSortNumber installed')
+      (annotateAvailablePackages userConstraints topSortNumber available')
     (installed', available') = selectNeededSubset installed available
                                                   initialPkgNames
     topSortNumber = topologicalSortNumbering installed' available'
@@ -256,7 +257,7 @@ topDownResolver' platform comp installed available pref 
deps targets =
     finalise selected = PackageIndex.allPackages
                       . improvePlan installed'
                       . PackageIndex.fromList
-                      . finaliseSelectedPackages pref selected
+                      . finaliseSelectedPackages userPreferences selected
 
 constrainTopLevelDeps :: [PackageConstraint] -> Constraints
                       -> Progress a Failure Constraints
@@ -264,7 +265,7 @@ constrainTopLevelDeps []                                    
  cs = Done cs
 constrainTopLevelDeps (PackageFlagsConstraint   _   _  :deps) cs =
   constrainTopLevelDeps deps cs
 constrainTopLevelDeps (PackageVersionConstraint pkg ver:deps) cs =
-  case addTopLevelDependencyConstraint dep cs of
+  case addTopLevelVersionConstraint pkg ver cs of
     Satisfiable cs' _       -> constrainTopLevelDeps deps cs'
     Unsatisfiable           -> Fail (TopLevelDependencyUnsatisfiable dep)
     ConflictsWith conflicts -> Fail (TopLevelDependencyConflict dep conflicts)
@@ -513,14 +514,16 @@ addPackageDependencyConstraint pkgid dep constraints =
   where
     reason = ExcludedByPackageDependency pkgid dep
 
-addTopLevelDependencyConstraint :: Dependency -> Constraints
-                                -> Satisfiable Constraints
-                                     [PackageIdentifier] ExclusionReason
-addTopLevelDependencyConstraint dep constraints =
+addTopLevelVersionConstraint :: PackageName -> VersionRange
+                             -> Constraints
+                             -> Satisfiable Constraints
+                                  [PackageIdentifier] ExclusionReason
+addTopLevelVersionConstraint pkg ver constraints =
   Constraints.constrain taggedDep reason constraints
   where
+    dep       = Dependency pkg ver
     taggedDep = TaggedDependency NoInstalledConstraint dep
-    reason = ExcludedByTopLevelDependency dep
+    reason    = ExcludedByTopLevelDependency dep
 
 -- ------------------------------------------------------------
 -- * Reasons for constraints



_______________________________________________
Cvs-libraries mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-libraries

Reply via email to