[commit: Cabal] master: Move printing of build failures into a separate function (491c72d)

[Paolo Capriotti]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/491c72d561e0ce7e491ef205dc7b6d14419f0ac6

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

commit 491c72d561e0ce7e491ef205dc7b6d14419f0ac6
Author: Duncan Coutts <duncan at haskell.org>
Date:   Sat May 10 12:21:41 2008 +0000

    Move printing of build failures into a separate function

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

 cabal-install/Hackage/Install.hs |   58 +++++++++++++++++++------------------
 1 files changed, 30 insertions(+), 28 deletions(-)

diff --git a/cabal-install/Hackage/Install.hs b/cabal-install/Hackage/Install.hs
index 4250d70..3a245b5 100644
--- a/cabal-install/Hackage/Install.hs
+++ b/cabal-install/Hackage/Install.hs
@@ -107,36 +107,15 @@ install verbosity packageDB repos comp conf configFlags installFlags deps = do
         printDryRun verbosity installPlan
 
       unless dryRun $ do
-        executeInstallPlan installPlan $ \cpkg ->
-          installConfiguredPackage configFlags cpkg $ \configFlags' apkg ->
-            installAvailablePackage verbosity apkg $
-              installUnpackedPackage verbosity (setupScriptOptions installed)
-                                     miscOptions configFlags'
-        return ()
-
-  let buildResults :: [(PackageIdentifier, BuildResult)]
-      buildResults = [] --FIXME: get build results from executeInstallPlan
-  case filter (buildFailed . snd) buildResults of
-    []     -> return () --TODO: return the build results
-    failed -> die $ "Error: some packages failed to install:\n"
-      ++ unlines
-         [ display pkgid ++ case reason of
-           DependentFailed pkgid' -> " depends on " ++ display pkgid'
-                                  ++ " which failed to install."
-           UnpackFailed    e -> " failed while unpacking the package."
-                             ++ " The exception was:\n  " ++ show e
-           ConfigureFailed e -> " failed during the configure step."
-                             ++ " The exception was:\n  " ++ show e
-           BuildFailed     e -> " failed during the building phase."
-                             ++ " The exception was:\n  " ++ show e
-           InstallFailed   e -> " failed during the final install step."
-                             ++ " The exception was:\n  " ++ show e
-           _ -> ""
-         | (pkgid, reason) <- failed ]
+        installPlan' <-
+          executeInstallPlan installPlan $ \cpkg ->
+            installConfiguredPackage configFlags cpkg $ \configFlags' apkg ->
+              installAvailablePackage verbosity apkg $
+                installUnpackedPackage verbosity (setupScriptOptions installed)
+                                       miscOptions configFlags'
+        printBuildFailures installPlan'
 
   where
-    buildFailed BuildOk = False
-    buildFailed _       = True
     setupScriptOptions index = SetupScriptOptions {
       useCabalVersion  = maybe AnyVersion ThisVersion (libVersion miscOptions),
       useCompiler      = Just comp,
@@ -207,6 +186,29 @@ printDryRun verbosity plan = case unfoldr next plan of
       (pkg:_) -> Just (pkgid, InstallPlan.completed pkgid plan')
         where pkgid = packageId pkg
 
+printBuildFailures :: InstallPlan BuildResult -> IO ()
+printBuildFailures plan =
+  case [ (pkg, reason)
+       | InstallPlan.Failed pkg reason <- InstallPlan.toList plan ] of
+    []     -> return ()
+    failed -> die . unlines
+            $ "Error: some packages failed to install:"
+            : [ display (packageId pkg) ++ printFailureReason reason
+              | (pkg, reason) <- failed ]
+  where
+    printFailureReason reason = case reason of
+      DependentFailed pkgid -> " depends on " ++ display pkgid
+                            ++ " which failed to install."
+      UnpackFailed    e -> " failed while unpacking the package."
+                        ++ " The exception was:\n  " ++ show e
+      ConfigureFailed e -> " failed during the configure step."
+                        ++ " The exception was:\n  " ++ show e
+      BuildFailed     e -> " failed during the building phase."
+                        ++ " The exception was:\n  " ++ show e
+      InstallFailed   e -> " failed during the final install step."
+                        ++ " The exception was:\n  " ++ show e
+      _ -> ""
+
 executeInstallPlan :: Monad m
                    => InstallPlan BuildResult
                    -> (ConfiguredPackage -> m BuildResult)