From 334bc6d828327776ecb7c33b8e77e3e57f0d0d72 Mon Sep 17 00:00:00 2001
From: Duncan Coutts <duncan.coutts@worc.ox.ac.uk>
Date: Mon, 3 Jul 2006 23:43:56 +0000
Subject: [PATCH] Complain more loudly if any of the hsc2hs phases fail
 previously hsc2hs just exits with a non-zero exit code, now
 if any of the compilation, linking or runing phases fail
 then we get a message saying so and the failing command is
 printed.

---
 utils/hsc2hs/Main.hs |   40 +++++++++++++++++-----------------------
 1 file changed, 17 insertions(+), 23 deletions(-)

diff --git a/utils/hsc2hs/Main.hs b/utils/hsc2hs/Main.hs
index 4b39e4a..a36bc40 100644
--- a/utils/hsc2hs/Main.hs
+++ b/utils/hsc2hs/Main.hs
@@ -611,34 +611,23 @@ output flags name toks = do
 
 
     
-    compilerStatus <- rawSystemL beVerbose compiler
+    rawSystemL ("compiling " ++ cProgName) beVerbose compiler
 	(  ["-c"]
         ++ [f | CompFlag f <- flags]
         ++ [cProgName]
         ++ ["-o", oProgName]
 	)
-
-    case compilerStatus of
-        e@(ExitFailure _) -> exitWith e
-        _                 -> return ()
     removeFile cProgName
     
-    linkerStatus <- rawSystemL beVerbose linker
+    rawSystemL ("linking " ++ oProgName) beVerbose linker
         (  [f | LinkFlag f <- flags]
         ++ [oProgName]
         ++ ["-o", progName]
 	)
-
-    case linkerStatus of
-        e@(ExitFailure _) -> exitWith e
-        _                 -> return ()
     removeFile oProgName
     
-    progStatus <- rawSystemWithStdOutL beVerbose execProgName [] outName
+    rawSystemWithStdOutL ("running " ++ execProgName) beVerbose execProgName [] outName
     removeFile progName
-    case progStatus of
-        e@(ExitFailure _) -> exitWith e
-        _                 -> return ()
     
     when needsH $ writeFile outHName $
         "#ifndef "++includeGuard++"\n" ++
@@ -661,29 +650,34 @@ output flags name toks = do
 	-- NB. outHFile not outHName; works better when processed
 	-- by gcc or mkdependC.
 
-rawSystemL :: Bool -> FilePath -> [String] -> IO ExitCode
-rawSystemL flg prog args = do
+rawSystemL :: String -> Bool -> FilePath -> [String] -> IO ()
+rawSystemL action flg prog args = do
   let cmdLine = prog++" "++unwords args
   when flg $ hPutStrLn stderr ("Executing: " ++ cmdLine)
 #ifndef HAVE_rawSystem
-  system cmdLine
+  exitStatus <- system cmdLine
 #else
-  rawSystem prog args
+  exitStatus <- rawSystem prog args
 #endif
+  case exitStatus of
+    ExitFailure _ -> die $ action ++ " failed\ncommand was: " ++ cmdLine ++ "\n"
+    _             -> return ()
 
-rawSystemWithStdOutL :: Bool -> FilePath -> [String] -> FilePath -> IO ExitCode
-rawSystemWithStdOutL flg prog args outFile = do
+rawSystemWithStdOutL :: String -> Bool -> FilePath -> [String] -> FilePath -> IO ()
+rawSystemWithStdOutL action flg prog args outFile = do
   let cmdLine = prog++" "++unwords args++" >"++outFile
   when flg (hPutStrLn stderr ("Executing: " ++ cmdLine))
 #ifndef HAVE_runProcess
-  system cmdLine
+  exitStatus <- system cmdLine
 #else
   hOut <- openFile outFile WriteMode
   process <- runProcess prog args Nothing Nothing Nothing (Just hOut) Nothing
-  res <- waitForProcess process
+  exitStatus <- waitForProcess process
   hClose hOut
-  return res
 #endif
+  case exitStatus of
+    ExitFailure _ -> die $ action ++ " failed\ncommand was: " ++ cmdLine ++ "\n"
+    _             -> return ()
 
 onlyOne :: String -> IO a
 onlyOne what = die ("Only one "++what++" may be specified\n")
-- 
1.7.10.4