[commit: Cabal] master: Restructure the package installing code (0cf7fab)

[Ian Lynagh]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/0cf7faba64bb989d97aacd024fb41c64fa1c800e

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

commit 0cf7faba64bb989d97aacd024fb41c64fa1c800e
Author: Duncan Coutts <duncan at haskell.org>
Date:   Thu May 8 09:26:49 2008 +0000

    Restructure the package installing code
    Previously each layer called the next layer down and therefore the
    top layer had to take all of the params that the bottom layer needed
    even though they were mostly or wholly unmodified on the way down.
    Now each layer takes the next layer as a parameter so we do not need
    to take the params that are not used directly by the current layer.
    The overall stack is then built by applying each layer to the next.

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

 cabal-install/Hackage/Install.hs |  101 ++++++++++++++++----------------------
 1 files changed, 42 insertions(+), 59 deletions(-)

diff --git a/cabal-install/Hackage/Install.hs b/cabal-install/Hackage/Install.hs
index 5a5a575..8308e0f 100644
--- a/cabal-install/Hackage/Install.hs
+++ b/cabal-install/Hackage/Install.hs
@@ -53,7 +53,7 @@ import Distribution.Simple.Utils
 import Distribution.Package
          ( PackageIdentifier(..), Package(..), Dependency(..) )
 import Distribution.PackageDescription as PackageDescription
-         ( GenericPackageDescription(packageDescription), FlagAssignment )
+         ( GenericPackageDescription(packageDescription) )
 import Distribution.PackageDescription.Parse (readPackageDescription)
 import Distribution.InstalledPackageInfo
          ( InstalledPackageInfo )
@@ -106,9 +106,11 @@ install verbosity packageDB repos comp conf configFlags installFlags deps = do
         printDryRun verbosity installPlan
 
       unless (dryRun miscOptions) $ do
-        let installer = installPkg verbosity (setupScriptOptions installed)
-                                   miscOptions configFlags
-        executeInstallPlan installer installPlan
+        executeInstallPlan installPlan $ \cpkg ->
+          installConfiguredPackage configFlags cpkg $ \configFlags' apkg ->
+            installAvailablePackage verbosity apkg $
+              installUnpackedPackage verbosity (setupScriptOptions installed)
+                                     miscOptions configFlags'
         return ()
 
   let buildResults :: [(PackageIdentifier, BuildResult)]
@@ -206,14 +208,15 @@ printDryRun verbosity pkgs
                     pkgId = packageId pkgInfo
                 in (pkgId : order (InstallPlan.completed pkgId ps))
 
-executeInstallPlan :: (AvailablePackage -> FlagAssignment -> IO BuildResult)
-                   -> InstallPlan BuildResult
-                   -> IO (InstallPlan BuildResult)
-executeInstallPlan installer plan
+executeInstallPlan :: Monad m
+                   => InstallPlan BuildResult
+                   -> (ConfiguredPackage -> m BuildResult)
+                   -> m (InstallPlan BuildResult)
+executeInstallPlan plan installPkg
   | InstallPlan.done plan = return plan
   | otherwise = do
-    let ConfiguredPackage pkg flags _deps = InstallPlan.next plan
-    buildResult <- installer pkg flags
+    let pkg = InstallPlan.next plan
+    buildResult <- installPkg pkg
     let pkgid = packageId pkg
         updatePlan = case buildResult of
           BuildOk -> InstallPlan.completed pkgid
@@ -223,48 +226,34 @@ executeInstallPlan installer plan
             -- 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.
-    executeInstallPlan installer (updatePlan plan)
+    executeInstallPlan (updatePlan plan) installPkg
 
-{-|
-  Download, build and install a given package with some given flags.
-
-  The process is divided up in a few steps:
-
-    * The package is downloaded to {config-dir}\/packages\/{pkg-id} (if not already there).
-
-    * The fetched tarball is then moved to a temporary directory (\/tmp on linux) and unpacked.
-
-    * setupWrapper (equivalent to cabal-setup) is called with the options
-      \'configure\' and the user specified options, \'--user\'
-      if the 'configUser' flag is @True@ and install directory flags depending on 
-      @configUserInstallDirs@ or @configGlobalInstallDirs at .
-
-    * setupWrapper \'build\' is called with no options.
-
-    * setupWrapper \'install\' is called with the \'--user\' flag if 'configUserInstall' is @True at .
+-- | Call an installer for an 'AvailablePackage' but override the configure
+-- flags with the ones given by the 'ConfiguredPackage'. In particular the 
+-- 'ConfiguredPackage' specifies an exact 'FlagAssignment' and exactly
+-- versioned package dependencies. So we ignore any previous partial flag
+-- assignment or dependency constraints and use the new ones.
+--
+installConfiguredPackage ::  Cabal.ConfigFlags -> ConfiguredPackage
+                         -> (Cabal.ConfigFlags -> AvailablePackage  -> a)
+                         -> a
+installConfiguredPackage configFlags (ConfiguredPackage pkg flags deps)
+  installPkg = installPkg configFlags {
+    Cabal.configConfigurationsFlags = flags,
+    Cabal.configConstraints = [ Dependency name (ThisVersion version)
+                              | PackageIdentifier name version  <- deps ]
+  } pkg
 
-    * The installation finishes by deleting the unpacked tarball.
--} 
-installPkg :: Verbosity
-           -> SetupScriptOptions
-           -> InstallMisc
-           -> Cabal.ConfigFlags -- ^Options which will be parse to every package.
-           -> AvailablePackage  -- TODO: change to ConfiguredPackage
-           -> FlagAssignment
-           -> IO BuildResult
-installPkg verbosity scriptOptions miscOptions configFlags
-           pkg@(AvailablePackage{
-                  packageSource = LocalUnpackedPackage
-                }) flags = do
-  let configFlags' = configFlags {
-          Cabal.configConfigurationsFlags =
-          Cabal.configConfigurationsFlags configFlags ++ flags
-        }
-  installUnpackedPkg verbosity scriptOptions miscOptions
-                     (Available.packageDescription pkg) configFlags' Nothing
+installAvailablePackage
+  :: Verbosity -> AvailablePackage
+  -> (GenericPackageDescription -> Maybe FilePath -> IO BuildResult)
+  -> IO BuildResult
+installAvailablePackage _ (AvailablePackage _ pkg LocalUnpackedPackage)
+  installPkg = installPkg pkg Nothing
 
-installPkg verbosity scriptOptions miscOptions configFlags pkg flags = do
-  pkgPath <- fetchPackage verbosity pkg
+installAvailablePackage verbosity apkg@(AvailablePackage _ pkg _)
+  installPkg = do
+  pkgPath <- fetchPackage verbosity apkg
   tmp <- getTemporaryDirectory
   let pkgid = packageId pkg
       tmpDirPath = tmp </> ("TMP" ++ display pkgid)
@@ -277,22 +266,16 @@ installPkg verbosity scriptOptions miscOptions configFlags pkg flags = do
     exists <- doesFileExist descFilePath
     when (not exists) $
       die $ "Package .cabal file not found: " ++ show descFilePath
-    let configFlags' = configFlags {
-          Cabal.configConfigurationsFlags =
-          Cabal.configConfigurationsFlags configFlags ++ flags
-        }
-    installUnpackedPkg verbosity scriptOptions miscOptions
-                       (Available.packageDescription pkg) configFlags' (Just path)
+    installPkg pkg (Just path)
 
-installUnpackedPkg :: Verbosity
+installUnpackedPackage :: Verbosity
                    -> SetupScriptOptions
                    -> InstallMisc
+                   -> Cabal.ConfigFlags
                    -> GenericPackageDescription
-               --  -> TODO: add flag assignment, or use ConfiguredPackage
-                   -> Cabal.ConfigFlags -- ^ Arguments for this package
                    -> Maybe FilePath -- ^ Directory to change to before starting the installation.
                    -> IO BuildResult
-installUnpackedPkg verbosity scriptOptions miscOptions pkg configFlags mpath
+installUnpackedPackage verbosity scriptOptions miscOptions configFlags pkg mpath
     = onFailure ConfigureFailed $ do
         setup configureCommand configFlags
         onFailure BuildFailed $ do