Add tests from testsuite/tests/h98

[ghc-base.git] / GHC / IO.hs

diff --git a/GHC/IO.hs b/GHC/IO.hs
index c57abdc..ad98a5e 100644 (file)
--- a/GHC/IO.hs
+++ b/GHC/IO.hs
@@ -1,5 +1,10 @@
+{-# LANGUAGE NoImplicitPrelude
+           , BangPatterns
+           , RankNTypes
+           , MagicHash
+           , UnboxedTuples
+  #-}
 {-# OPTIONS_GHC -funbox-strict-fields #-}
-{-# LANGUAGE NoImplicitPrelude, BangPatterns, RankNTypes #-}
 {-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
 -- |
@@ -31,7 +36,7 @@ module GHC.IO (
     mask, mask_, uninterruptibleMask, uninterruptibleMask_, 
     MaskingState(..), getMaskingState,
     block, unblock, blocked, unsafeUnmask,
-    onException, finally, evaluate
+    onException, bracket, finally, evaluate
   ) where
 
 import GHC.Base
@@ -254,7 +259,7 @@ catchException :: Exception e => IO a -> (e -> IO a) -> IO a
 catchException (IO io) handler = IO $ catch# io handler'
     where handler' e = case fromException e of
                        Just e' -> unIO (handler e')
-                       Nothing -> raise# e
+                       Nothing -> raiseIO# e
 
 catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a
 catchAny (IO io) handler = IO $ catch# io handler'
@@ -337,6 +342,7 @@ getMaskingState  = IO $ \s ->
                              1# -> MaskedUninterruptible
                              _  -> MaskedInterruptible #)
 
+{-# DEPRECATED blocked "use Control.Exception.getMaskingState instead" #-}
 -- | returns True if asynchronous exceptions are blocked in the
 -- current thread.
 blocked :: IO Bool
@@ -344,7 +350,7 @@ blocked = fmap (/= Unmasked) getMaskingState
 
 onException :: IO a -> IO b -> IO a
 onException io what = io `catchException` \e -> do _ <- what
-                                                   throw (e :: SomeException)
+                                                   throwIO (e :: SomeException)
 
 -- | Executes an IO computation with asynchronous
 -- exceptions /masked/.  That is, any thread which attempts to raise
@@ -426,6 +432,18 @@ uninterruptibleMask io = do
     MaskedInterruptible   -> blockUninterruptible $ io block
     MaskedUninterruptible -> io id
 
+bracket
+        :: IO a         -- ^ computation to run first (\"acquire resource\")
+        -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
+        -> (a -> IO c)  -- ^ computation to run in-between
+        -> IO c         -- returns the value from the in-between computation
+bracket before after thing =
+  mask $ \restore -> do
+    a <- before
+    r <- restore (thing a) `onException` after a
+    _ <- after a
+    return r
+
 finally :: IO a         -- ^ computation to run first
         -> IO b         -- ^ computation to run afterward (even if an exception
                         -- was raised)