diff options
author | Isaac Dupree <id@isaac.cedarswampstudios.org> | 2009-08-23 23:14:26 +0000 |
---|---|---|
committer | Isaac Dupree <id@isaac.cedarswampstudios.org> | 2009-08-23 23:14:26 +0000 |
commit | 08bb108b7f682686f15291dfbe73e1f5e11c1761 (patch) | |
tree | 904f654747ce6e624b1481f70a6683b5c6ae1d7e /src | |
parent | d3d25c5d0729c0b64d746e24a855236f6e6a5663 (diff) |
Main.hs: OldException->Exception: which eliminates warnings
Diffstat (limited to 'src')
-rw-r--r-- | src/Main.hs | 27 |
1 files changed, 13 insertions, 14 deletions
diff --git a/src/Main.hs b/src/Main.hs index 1c6c9d39..ad3f918d 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -32,8 +32,7 @@ import Haddock.Utils import Haddock.GhcUtils import Control.Monad -import Control.OldException -import qualified Control.Exception as NewException +import Control.Exception import Data.Maybe import Data.IORef import qualified Data.Map as Map @@ -70,25 +69,25 @@ handleTopExceptions :: IO a -> IO a handleTopExceptions = handleNormalExceptions . handleHaddockExceptions . handleGhcExceptions - +-- | Either returns normally or throws an ExitCode exception; +-- all other exceptions are turned into exit exceptions. handleNormalExceptions :: IO a -> IO a handleNormalExceptions inner = - handle (\exception -> do - hFlush stdout - case exception of - AsyncException StackOverflow -> do + (inner `onException` hFlush stdout) + `catches` + [ Handler (\(code :: ExitCode) -> exitWith code) + , Handler (\(StackOverflow) -> do putStrLn "stack overflow: use -g +RTS -K<size> to increase it" - exitFailure - ExitException code -> exitWith code - _other -> do - putStrLn ("haddock: internal Haddock or GHC error: " ++ show exception) - exitFailure - ) inner + exitFailure) + , Handler (\(ex :: SomeException) -> do + putStrLn ("haddock: internal Haddock or GHC error: " ++ show ex) + exitFailure) + ] handleHaddockExceptions :: IO a -> IO a handleHaddockExceptions inner = - NewException.catches inner [NewException.Handler handler] + catches inner [Handler handler] where handler (e::HaddockException) = do putStrLn $ "haddock: " ++ (show e) |