diff options
| -rw-r--r-- | src/Haddock/Interface.hs | 46 | ||||
| -rw-r--r-- | src/Main.hs | 8 |
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) |