[commit: Cabal] master: Make the existing dep resolvers to use the DependencyResolver interface (c5647dd)

[Ian Lynagh]

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

On branch  : master

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

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

commit c5647dd8f2a382b2b949a3f91e85fac4bde2910a
Author: Duncan Coutts <duncan at haskell.org>
Date:   Fri May 9 15:15:14 2008 +0000

    Make the existing dep resolvers to use the DependencyResolver interface
    That is the standard naive dep resolver and the bogus one that has to
    make up a plan assuming that all dependencies are installed.

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

 cabal-install/Hackage/Dependency.hs |   80 ++++++++++++++++++++---------------
 1 files changed, 46 insertions(+), 34 deletions(-)

diff --git a/cabal-install/Hackage/Dependency.hs b/cabal-install/Hackage/Dependency.hs
index a147bc7..d81a5bd 100644
--- a/cabal-install/Hackage/Dependency.hs
+++ b/cabal-install/Hackage/Dependency.hs
@@ -23,7 +23,8 @@ import Distribution.InstalledPackageInfo (InstalledPackageInfo)
 import qualified Hackage.InstallPlan as InstallPlan
 import Hackage.InstallPlan (InstallPlan)
 import Hackage.Types
-         ( UnresolvedDependency(..), AvailablePackage(..) )
+         ( UnresolvedDependency(..), AvailablePackage(..)
+         , ConfiguredPackage(..) )
 import Distribution.Package
          ( PackageIdentifier(..), Dependency(..)
          , Package(..), PackageFixedDeps(..) )
@@ -43,7 +44,7 @@ import Distribution.Text
 import Control.Monad (mplus)
 import Data.List (maximumBy)
 import Data.Maybe (fromMaybe, catMaybes)
-import Data.Monoid (Monoid(mappend))
+import Data.Monoid (Monoid(mempty, mappend))
 import Control.Exception (assert)
 
 resolveDependencies :: OS
@@ -54,25 +55,14 @@ resolveDependencies :: OS
                     -> [UnresolvedDependency]
                     -> Either [Dependency] (InstallPlan a)
 resolveDependencies os arch comp (Just installed) available deps =
-  assert (null $ PackageIndex.brokenPackages installed')
-  packagesToInstall os arch comp installed'
-    [ resolveDependency os arch comp installed' available dep flags
-    | UnresolvedDependency dep flags <- deps]
-  where installed' = hideBrokenPackages installed
-resolveDependencies os arch comp Nothing available deps =
-  packagesToInstall os arch comp undefined
-    (resolveDependenciesBogusly available deps)
+  either Right Left $
+  dependencyResolver naiveResolver
+    os arch comp installed available deps
 
--- | We're using a compiler where we cannot track installed packages so just
--- pretend everything is installed and hope for the best. Yay!
-resolveDependenciesBogusly :: PackageIndex AvailablePackage
-                           -> [UnresolvedDependency]
-                           -> [ResolvedDependency]
-resolveDependenciesBogusly available = map resolveFromAvailable
-  where resolveFromAvailable (UnresolvedDependency dep flags) =
-          case latestAvailableSatisfying available dep of
-            Nothing  -> UnavailableDependency dep
-            Just pkg -> AvailableDependency dep pkg flags []
+resolveDependencies os arch comp Nothing available deps =
+  either Right Left $
+  dependencyResolver bogusResolver
+    os arch comp mempty available deps
 
 hideBrokenPackages :: PackageFixedDeps p => PackageIndex p -> PackageIndex p
 hideBrokenPackages index =
@@ -113,6 +103,34 @@ failingResolver :: DependencyResolver a
 failingResolver _ _ _ _ _ deps = Right
   [ dep | UnresolvedDependency dep _ <- deps ]
 
+-- | This resolver thinks that every package is already installed.
+--
+bogusResolver :: DependencyResolver a
+bogusResolver os arch comp _ available deps =
+  case unzipEithers (map resolveFromAvailable deps) of
+    (ok, [])      -> Left ok
+    (_ , missing) -> Right missing
+  where
+    resolveFromAvailable (UnresolvedDependency dep flags) =
+      case latestAvailableSatisfying available dep of
+        Nothing  -> Right dep
+        Just apkg@(AvailablePackage _ pkg _) ->
+          case finalizePackageDescription flags none os arch comp [] pkg of
+            Right (_, flags') -> Left $ InstallPlan.Configured $
+                                   ConfiguredPackage apkg flags' []
+            --TODO: we actually have to delete the deps of pkg, otherwise
+            -- the install plan verifier will say we're missing deps.
+            _ -> error "bogusResolver: impossible happened"
+          where
+            none :: Maybe (PackageIndex PackageIdentifier)
+            none = Nothing
+
+naiveResolver :: DependencyResolver a
+naiveResolver os arch comp installed available deps =
+  packagesToInstall installed
+    [ resolveDependency os arch comp installed available dep flags
+    | UnresolvedDependency dep flags <- deps]
+
 resolveDependency :: OS
                   -> Arch
                   -> CompilerId
@@ -176,13 +194,12 @@ getDependencies os arch comp installed available pkg flags
                   in Just (flatten available `mappend` flatten installed))
                 os arch comp [] pkg
 
-packagesToInstall :: OS -> Arch -> CompilerId
-                  -> PackageIndex InstalledPackageInfo
+packagesToInstall :: PackageIndex InstalledPackageInfo
                   -> [ResolvedDependency]
-                  -> Either [Dependency] (InstallPlan a)
+                  -> Either [InstallPlan.PlanPackage a] [Dependency]
                      -- ^ Either a list of missing dependencies, or a graph
                      -- of packages to install, with their options.
-packagesToInstall os arch comp allInstalled deps0 =
+packagesToInstall allInstalled deps0 =
   case unzipEithers (map getAvailable deps0) of
     ([], ok)     ->
       let selectedAvailable :: [InstallPlan.ConfiguredPackage]
@@ -198,16 +215,11 @@ packagesToInstall os arch comp allInstalled deps0 =
                             $ 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
+
+       in Left $ map InstallPlan.Configured selectedAvailable
+              ++ map InstallPlan.PreExisting selectedInstalled
+
+    (missing, _) -> Right $ concat missing
 
   where
     getAvailable :: ResolvedDependency