Complain more loudly if any of the hsc2hs phases fail
authorDuncan Coutts <duncan.coutts@worc.ox.ac.uk>
Mon, 3 Jul 2006 23:43:56 +0000 (23:43 +0000)
committerDuncan Coutts <duncan.coutts@worc.ox.ac.uk>
Mon, 3 Jul 2006 23:43:56 +0000 (23:43 +0000)
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

index 4b39e4a..a36bc40 100644 (file)
@@ -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")