aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Waern <david.waern@gmail.com>2009-02-25 20:04:38 +0000
committerDavid Waern <david.waern@gmail.com>2009-02-25 20:04:38 +0000
commitcc54e035026b266df4fd0ed6ef023cac203936ad (patch)
treeb4816a87d8f6a5c569dc39cf0c37f0cb76e9b515
parent47bd922bea18b5f786dadedf08633320f3573211 (diff)
Fix bad error handling with newer GHCs
When support for GHC 6.10 was added, an error handler was installed only around the typechecking phase. This had the effect that errors thrown during dependency chasing were caught in the top-level exception handler and not printed with enough detail. With this patch we wrap the error handler around all our usage of the Ghc monad.
-rw-r--r--src/Haddock/Interface.hs46
-rw-r--r--src/Main.hs8
2 files changed, 27 insertions, 27 deletions
diff --git a/src/Haddock/Interface.hs b/src/Haddock/Interface.hs
index d33d322d..2e4c3072 100644
--- a/src/Haddock/Interface.hs
+++ b/src/Haddock/Interface.hs
@@ -160,32 +160,26 @@ ppModInfo (HaddockModInfo a b c d) = show (fmap pretty a) ++ show b ++ show c ++
#if __GLASGOW_HASKELL__ >= 609
processModule :: ModSummary -> [Flag] -> ModuleMap -> InstIfaceMap -> Ghc (Maybe Interface)
-processModule modsum flags modMap instIfaceMap =
-
- let handleSrcErrors action = flip handleSourceError action $ \err -> do
- printExceptionAndWarnings err
- throwE ("Failed to check module: " ++ moduleString (ms_mod modsum))
-
- in handleSrcErrors $ do
- tc_mod <- loadModule =<< typecheckModule =<< parseModule modsum
- if not $ isBootSummary modsum
- then do
- let filename = msHsFilePath modsum
- let dynflags = ms_hspp_opts modsum
- let Just renamed_src = renamedSource tc_mod
- let ghcMod = mkGhcModule (ms_mod modsum,
- filename,
- (parsedSource tc_mod,
- renamed_src,
- typecheckedSource tc_mod,
- moduleInfo tc_mod))
- dynflags
- let (interface, msg) = runWriter $ createInterface ghcMod flags modMap instIfaceMap
- liftIO $ mapM_ putStrLn msg
- liftIO $ evaluate interface
- return (Just interface)
- else
- return Nothing
+processModule modsum flags modMap instIfaceMap = do
+ tc_mod <- loadModule =<< typecheckModule =<< parseModule modsum
+ if not $ isBootSummary modsum
+ then do
+ let filename = msHsFilePath modsum
+ let dynflags = ms_hspp_opts modsum
+ let Just renamed_src = renamedSource tc_mod
+ let ghcMod = mkGhcModule (ms_mod modsum,
+ filename,
+ (parsedSource tc_mod,
+ renamed_src,
+ typecheckedSource tc_mod,
+ moduleInfo tc_mod))
+ dynflags
+ let (interface, msg) = runWriter $ createInterface ghcMod flags modMap instIfaceMap
+ liftIO $ mapM_ putStrLn msg
+ liftIO $ evaluate interface
+ return (Just interface)
+ else
+ return Nothing
#else
processModule :: Session -> ModSummary -> [Flag] -> ModuleMap -> InstIfaceMap -> IO (Maybe Interface)
processModule session modsum flags modMap instIfaceMap = do
diff --git a/src/Main.hs b/src/Main.hs
index 328fce4d..05b71223 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -160,8 +160,14 @@ main = handleTopExceptions $ do
#endif
#if __GLASGOW_HASKELL__ >= 609
+ -- We have one global error handler for all GHC source errors. Other kinds
+ -- of exceptions will be propagated to the top-level error handler.
+ let handleSrcErrors action = flip handleSourceError action $ \err -> do
+ printExceptionAndWarnings err
+ liftIO exitFailure
+
-- initialize GHC
- startGhc libDir (ghcFlags flags) $ \dynflags -> do
+ startGhc libDir (ghcFlags flags) $ \dynflags -> handleSrcErrors $ do
-- get packages supplied with --read-interface
packages <- readInterfaceFiles nameCacheFromGhc (ifacePairs flags)