diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 44 |
1 files changed, 33 insertions, 11 deletions
diff --git a/src/Main.hs b/src/Main.hs index 3626abe4..6fc1a6cd 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -23,8 +23,12 @@ import Haddock.Utils import Paths_haddock import Control.Monad +#if __GLASGOW_HASKELL__ >= 609 +import Control.OldException +import qualified Control.Exception as NewException +#else import Control.Exception -import Control.Exception +#endif import Data.Dynamic import Data.Maybe import Data.IORef @@ -37,8 +41,13 @@ import GHC import GHC.Paths import DynFlags import Bag -import Util (handleDyn) import ErrUtils +#if __GLASGOW_HASKELL__ >= 609 +import Panic (handleGhcException) +import Util +#else +import Util hiding (handle) +#endif -------------------------------------------------------------------------------- @@ -65,28 +74,41 @@ handleNormalExceptions inner = handleHaddockExceptions inner = - handleDyn (\(e::HaddockException) -> do - putStrLn $ "haddock: " ++ (show e) - exitFailure - ) inner +#if __GLASGOW_HASKELL__ >= 609 + NewException.catches inner [NewException.Handler handler] +#else + handleDyn handler inner +#endif + where + handler (e::HaddockException) = do + putStrLn $ "haddock: " ++ (show e) + exitFailure handleGhcExceptions inner = -- compilation errors: messages with locations attached - handleDyn (\dyn -> do +#if __GLASGOW_HASKELL__ >= 609 + handleErrMsg (\e -> do +#else + handleDyn (\e -> do +#endif putStrLn "haddock: Compilation error(s):" - printBagOfErrors defaultDynFlags (unitBag dyn) + printBagOfErrors defaultDynFlags (unitBag e) exitFailure ) $ -- error messages propagated as exceptions - handleDyn (\dyn -> do +#if __GLASGOW_HASKELL__ >= 609 + handleGhcException (\e -> do +#else + handleDyn (\e -> do +#endif hFlush stdout - case dyn of + case e of PhaseFailed _ code -> exitWith code Interrupted -> exitFailure _ -> do - print (dyn :: GhcException) + print (e :: GhcException) exitFailure ) inner |