Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/111e9bd0c63fdee65fa3626221c9bafc48061451 >--------------------------------------------------------------- commit 111e9bd0c63fdee65fa3626221c9bafc48061451 Author: Duncan Coutts <[email protected]> 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@. - - * setupWrapper \'build\' is called with no options. - - * setupWrapper \'install\' is called with the \'--user\' flag if 'configUserInstall' is @True@. +-- | 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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
