aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-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)