diff --git a/cabal-install/Hackage/Install.hs b/cabal-install/Hackage/Install.hs
index fd2e45d6c09bef04e25e8d3764620537b2e55fbe..fbe592d98cd9a64d6fc0a434e20dbee8edb9e004 100644
--- a/cabal-install/Hackage/Install.hs
+++ b/cabal-install/Hackage/Install.hs
@@ -15,7 +15,7 @@ module Hackage.Install
) where
import Data.Monoid (Monoid(mconcat))
-import Control.Exception (bracket_, try)
+import Control.Exception as Exception (bracket_, handle)
import Control.Monad (when)
import System.Directory (getTemporaryDirectory, createDirectoryIfMissing
,removeDirectoryRecursive, doesFileExist)
@@ -38,10 +38,17 @@ import Distribution.Simple.SetupWrapper (setupWrapper)
import qualified Distribution.Simple.Setup as Cabal
import Distribution.Simple.Utils (defaultPackageDesc)
import Distribution.Package (showPackageId, PackageIdentifier(..))
+import Distribution.PackageDescription (GenericPackageDescription(packageDescription))
import Distribution.PackageDescription.Parse (readPackageDescription)
+import Distribution.Simple.PackageIndex (Package(..))
import Distribution.Simple.Utils as Utils (notice, info, debug, die)
import Distribution.Verbosity (Verbosity)
+data BuildResult = DependentFailed PackageIdentifier
+ | ConfigureFailed
+ | BuildFailed
+ | InstallFailed
+ | BuildOk
-- |Installs the packages needed to satisfy a list of dependencies.
install :: Verbosity
@@ -52,9 +59,25 @@ install :: Verbosity
-> Cabal.ConfigFlags
-> [UnresolvedDependency]
-> IO ()
-install verbosity packageDB repos comp conf configFlags deps
- | null deps = installLocalPackage verbosity packageDB repos comp conf configFlags
- | otherwise = installRepoPackages verbosity packageDB repos comp conf configFlags deps
+install verbosity packageDB repos comp conf configFlags deps = do
+ buildResults <- if null deps
+ then installLocalPackage verbosity packageDB repos comp conf configFlags
+ else installRepoPackages verbosity packageDB repos comp conf configFlags deps
+ case filter (buildFailed . snd) buildResults of
+ [] -> return () --TODO: return the build results
+ failed -> die $ "Error: some packages failed to install:\n"
+ ++ unlines
+ [ showPackageId pkgid ++ case reason of
+ DependentFailed pkgid' -> " depends on " ++ showPackageId pkgid'
+ ++ " which failed to install."
+ ConfigureFailed -> " failed during the configure step."
+ BuildFailed -> " failed during the building phase."
+ InstallFailed -> " failed during the final install step."
+ _ -> ""
+ | (pkgid, reason) <- failed ]
+
+ where buildFailed BuildOk = False
+ buildFailed _ = True
-- | Install the unpacked package in the current directory, and all its dependencies.
installLocalPackage :: Verbosity
@@ -63,7 +86,7 @@ installLocalPackage :: Verbosity
-> Compiler
-> ProgramConfiguration
-> Cabal.ConfigFlags
- -> IO ()
+ -> IO [(PackageIdentifier, BuildResult)]
installLocalPackage verbosity packageDB repos comp conf configFlags =
do cabalFile <- defaultPackageDesc verbosity
desc <- readPackageDescription verbosity cabalFile
@@ -71,10 +94,12 @@ installLocalPackage verbosity packageDB repos comp conf configFlags =
available <- fmap mconcat (mapM (IndexUtils.readRepoIndex verbosity) repos)
let resolvedDeps = resolveDependenciesLocal comp installed available desc
(Cabal.configConfigurationsFlags configFlags)
- case packagesToInstall resolvedDeps of
+ buildResults <- case packagesToInstall resolvedDeps of
Left missing -> die $ "Unresolved dependencies: " ++ showDependencies missing
Right pkgs -> installPackages verbosity configFlags pkgs
- installUnpackedPkg verbosity configFlags Nothing
+ --TODO: don't run if buildResult failed
+ buildResult <- installUnpackedPkg verbosity configFlags Nothing
+ return ((packageId (packageDescription desc), buildResult) : buildResults)
installRepoPackages :: Verbosity
-> PackageDB
@@ -83,7 +108,7 @@ installRepoPackages :: Verbosity
-> ProgramConfiguration
-> Cabal.ConfigFlags
-> [UnresolvedDependency]
- -> IO ()
+ -> IO [(PackageIdentifier, BuildResult)]
installRepoPackages verbosity packageDB repos comp conf configFlags deps =
do Just installed <- getInstalledPackages verbosity comp packageDB conf
available <- fmap mconcat (mapM (IndexUtils.readRepoIndex verbosity) repos)
@@ -94,34 +119,39 @@ installRepoPackages verbosity packageDB repos comp conf configFlags deps =
Right pkgs
| DepGraph.empty pkgs -> notice verbosity
"All requested packages already installed. Nothing to do."
+ >> return []
| otherwise -> installPackages verbosity configFlags pkgs
installPackages :: Verbosity
-> Cabal.ConfigFlags -- ^Options which will be passed to every package.
-> DepGraph.DepGraph
- -> IO ()
-installPackages verbosity configFlags pkgs = do
- errorPackages <- installPackagesErrs [] pkgs
- case errorPackages of
- [] -> return ()
- errpkgs -> let errorMsg = concat $ "Error: some packages failed to install:"
- : ["\n " ++ showPackageId (pkgInfoId pkg)
- | pkg <- errpkgs]
- in die errorMsg
+ -> IO [(PackageIdentifier, BuildResult)]
+installPackages verbosity configFlags = installPackagesErrs []
where
- installPackagesErrs failed remaining
- | DepGraph.empty remaining = return failed
+ installPackagesErrs :: [(PackageIdentifier, BuildResult)]
+ -> DepGraph.DepGraph
+ -> IO [(PackageIdentifier, BuildResult)]
+ installPackagesErrs done remaining
+ | DepGraph.empty remaining = return (reverse done)
| otherwise = case DepGraph.ready remaining of
DepGraph.ResolvedPackage pkg flags _depids -> do--TODO build against exactly these deps
- maybeInstalled <- try (installPkg verbosity configFlags pkg flags)
- case maybeInstalled of
- Left _ ->
- let (remaining', failed') = DepGraph.removeFailed (pkgInfoId pkg) remaining
- failed'' = [ pkg' | DepGraph.ResolvedPackage pkg' _ _ <- failed' ]
- in installPackagesErrs (failed++failed'') remaining'
- Right _ ->
- let remaining' = DepGraph.removeCompleted (pkgInfoId pkg) remaining
- in installPackagesErrs failed remaining'
+ let pkgid = packageId pkg
+ buildResult <- installPkg verbosity configFlags pkg flags
+ case buildResult of
+ BuildOk ->
+ let remaining' = DepGraph.removeCompleted pkgid remaining
+ in installPackagesErrs ((pkgid, buildResult):done) remaining'
+ _ ->
+ let (remaining', _:failed) = DepGraph.removeFailed pkgid remaining
+ -- So this first pkgid failed for whatever reason (buildResult)
+ -- all the other packages that depended on this pkgid which we
+ -- now cannot build (failed :: [ResolvedPackage]) we mark as
+ -- failing due to DependentFailed which kind of means it was
+ -- not their fault.
+ done' = (pkgid, buildResult)
+ : [ (packageId pkg', DependentFailed pkgid)
+ | pkg' <- failed ]
+ in installPackagesErrs (done'++done) remaining'
{-|
Download, build and install a given package with some given flags.
@@ -147,7 +177,7 @@ installPkg :: Verbosity
-> Cabal.ConfigFlags -- ^Options which will be parse to every package.
-> PkgInfo
-> FlagAssignment
- -> IO ()
+ -> IO BuildResult
installPkg verbosity configFlags pkg flags
= do pkgPath <- fetchPackage verbosity pkg
tmp <- getTemporaryDirectory
@@ -169,11 +199,15 @@ installPkg verbosity configFlags pkg flags
installUnpackedPkg :: Verbosity
-> Cabal.ConfigFlags -- ^ Arguments for this package
-> Maybe FilePath -- ^ Directory to change to before starting the installation.
- -> IO ()
+ -> IO BuildResult
installUnpackedPkg verbosity configFlags mpath
- = do setup ("configure" : configureOptions)
- setup ["build"]
- setup ["install"]
+ = onFailure ConfigureFailed $ do
+ setup ("configure" : configureOptions)
+ onFailure BuildFailed $ do
+ setup ["build"]
+ onFailure InstallFailed $ do
+ setup ["install"]
+ return BuildOk
where
configureCommand = Cabal.configureCommand defaultProgramConfiguration
configureOptions = commandShowOptions configureCommand configFlags
@@ -181,3 +215,4 @@ installUnpackedPkg verbosity configFlags mpath
= do debug verbosity $
"setupWrapper in " ++ show mpath ++ " :\n " ++ show cmds
setupWrapper cmds mpath
+ onFailure result = Exception.handle (\_ -> return result)