diff --git a/Cabal/Distribution/Simple/Utils.hs b/Cabal/Distribution/Simple/Utils.hs index 82a17638a49809bdd89736590d157779d20e6f0a..f1fb555e5e63b5e8c03a72699779b22fb04ffc18 100644 --- a/Cabal/Distribution/Simple/Utils.hs +++ b/Cabal/Distribution/Simple/Utils.hs @@ -50,7 +50,7 @@ module Distribution.Simple.Utils ( -- * logging and errors die, dieWithLocation, - topHandler, + topHandler, topHandlerWith, warn, notice, setupMessage, info, debug, debugNoWrap, chattyTry, @@ -238,14 +238,14 @@ dieWithLocation filename lineno msg = die :: String -> IO a die msg = ioError (userError msg) -topHandler :: IO a -> IO a -topHandler prog = catchIO prog handle +topHandlerWith :: (Exception.IOException -> IO a) -> IO a -> IO a +topHandlerWith cont prog = catchIO prog handle where handle ioe = do hFlush stdout pname <- getProgName hPutStr stderr (mesage pname) - exitWith (ExitFailure 1) + cont ioe where mesage pname = wrapText (pname ++ ": " ++ file ++ detail) file = case ioeGetFileName ioe of @@ -256,6 +256,9 @@ topHandler prog = catchIO prog handle _ -> "" detail = ioeGetErrorString ioe +topHandler :: IO a -> IO a +topHandler prog = topHandlerWith (const $ exitWith (ExitFailure 1)) prog + -- | Non fatal conditions that may be indicative of an error or problem. -- -- We display these at the 'normal' verbosity level.