aboutsummaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
authorIsaac Dupree <id@isaac.cedarswampstudios.org>2009-08-23 23:14:26 +0000
committerIsaac Dupree <id@isaac.cedarswampstudios.org>2009-08-23 23:14:26 +0000
commit08bb108b7f682686f15291dfbe73e1f5e11c1761 (patch)
tree904f654747ce6e624b1481f70a6683b5c6ae1d7e /src/Main.hs
parentd3d25c5d0729c0b64d746e24a855236f6e6a5663 (diff)
Main.hs: OldException->Exception: which eliminates warnings
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs27
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)