[commit: base] master: Added the unregistration command to the return value of threadWait*STM functions. (0ed5c8b)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/0ed5c8b7687037e5815eab4701f0ac1ea117e046

>---------------------------------------------------------------

commit 0ed5c8b7687037e5815eab4701f0ac1ea117e046
Author: Andreas Voellmy <andreas.voellmy at gmail.com>
Date:   Wed Oct 17 11:02:12 2012 -0400

    Added the unregistration command to the return value of threadWait*STM functions.
    
    This allows the calling thread to unregister interest in the file, e.g. in the case
    of an exception in the thread.

>---------------------------------------------------------------

 GHC/Event/Thread.hs |   41 +++++++++++++++++++++++++++++------------
 1 files changed, 29 insertions(+), 12 deletions(-)

diff --git a/GHC/Event/Thread.hs b/GHC/Event/Thread.hs
index 7df531f..1f19756 100644
--- a/GHC/Event/Thread.hs
+++ b/GHC/Event/Thread.hs
@@ -98,25 +98,42 @@ threadWait evt fd = mask_ $ do
     else return ()
 
 
-threadWaitSTM :: Event -> Fd -> IO (STM ())
+threadWaitSTM :: Event -> Fd -> IO (STM (), IO ())
 threadWaitSTM evt fd = mask_ $ do
   m <- newTVarIO Nothing
   Just mgr <- getSystemEventManager 
-  registerFd mgr (\reg e -> unregisterFd_ mgr reg >> atomically (writeTVar m (Just e))) fd evt
-  return (do mevt <- readTVar m
-             case mevt of
-               Nothing -> retry
-               Just evt -> 
-                 if evt `eventIs` evtClose
-                 then throwSTM $ errnoToIOError "threadWait" eBADF Nothing Nothing
-                 else return ()
-         )
-
-threadWaitReadSTM :: Fd -> IO (STM ())
+  reg <- registerFd mgr (\reg e -> unregisterFd_ mgr reg >> atomically (writeTVar m (Just e))) fd evt
+  let waitAction =
+        do mevt <- readTVar m
+           case mevt of
+             Nothing -> retry
+             Just evt -> 
+               if evt `eventIs` evtClose
+               then throwSTM $ errnoToIOError "threadWaitSTM" eBADF Nothing Nothing
+               else return ()
+  return (waitAction, unregisterFd_ mgr reg >> return ())
+
+-- | Allows a thread to use an STM action to wait for a file descriptor to be readable.
+-- The STM action will retry until the file descriptor has data ready.
+-- The second element of the return value pair is an IO action that can be used
+-- to deregister interest in the file descriptor. 
+--
+-- The STM action will throw an 'IOError' if the file descriptor was closed
+-- while the STM action is being executed.  To safely close a file descriptor
+-- that has been used with 'threadWaitReadSTM', use 'closeFdWith'.
+threadWaitReadSTM :: Fd -> IO (STM (), IO ())
 threadWaitReadSTM = threadWaitSTM evtRead
 {-# INLINE threadWaitReadSTM #-}
 
-threadWaitWriteSTM :: Fd -> IO (STM ())
+-- | Allows a thread to use an STM action to wait until a file descriptor can accept a write.
+-- The STM action will retry while the file until the given file descriptor can accept a write.
+-- The second element of the return value pair is an IO action that can be used to deregister
+-- interest in the file descriptor. 
+--
+-- The STM action will throw an 'IOError' if the file descriptor was closed
+-- while the STM action is being executed.  To safely close a file descriptor
+-- that has been used with 'threadWaitWriteSTM', use 'closeFdWith'.
+threadWaitWriteSTM :: Fd -> IO (STM (), IO ())
 threadWaitWriteSTM = threadWaitSTM evtWrite
 {-# INLINE threadWaitWriteSTM #-}