[commit: base] master: Add GHC.Event.getSystemEventManager :: IO (Maybe EventManager) (cc5431e)

[Ian Lynagh]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/cc5431edd61fccbf082db6df10d502bb85e86078

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

commit cc5431edd61fccbf082db6df10d502bb85e86078
Author: Bas van Dijk <v.dijk.bas at gmail.com>
Date:   Mon Apr 4 20:22:09 2011 +0200

    Add GHC.Event.getSystemEventManager :: IO (Maybe EventManager)

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

 GHC/Event.hs        |    2 ++
 GHC/Event/Thread.hs |   19 +++++++++++++------
 2 files changed, 15 insertions(+), 6 deletions(-)

diff --git a/GHC/Event.hs b/GHC/Event.hs
index 6bb975e..7920895 100644
--- a/GHC/Event.hs
+++ b/GHC/Event.hs
@@ -8,6 +8,7 @@ module GHC.Event
 
       -- * Creation
     , new
+    , getSystemEventManager
 
       -- * Running
     , loop
@@ -37,3 +38,4 @@ module GHC.Event
     ) where
 
 import GHC.Event.Manager
+import GHC.Event.Thread (getSystemEventManager)
diff --git a/GHC/Event/Thread.hs b/GHC/Event/Thread.hs
index dbfb14f..42bf541 100644
--- a/GHC/Event/Thread.hs
+++ b/GHC/Event/Thread.hs
@@ -1,8 +1,8 @@
 {-# LANGUAGE BangPatterns, ForeignFunctionInterface, NoImplicitPrelude #-}
 
 module GHC.Event.Thread
-    (
-      ensureIOManagerIsRunning
+    ( getSystemEventManager
+    , ensureIOManagerIsRunning
     , threadWaitRead
     , threadWaitWrite
     , closeFdWith
@@ -36,7 +36,7 @@ import System.Posix.Types (Fd)
 -- run /earlier/ than specified.
 threadDelay :: Int -> IO ()
 threadDelay usecs = mask_ $ do
-  Just mgr <- readIORef eventManager
+  Just mgr <- getSystemEventManager
   m <- newEmptyMVar
   reg <- registerTimeout mgr usecs (putMVar m ())
   takeMVar m `onException` M.unregisterTimeout mgr reg
@@ -47,7 +47,7 @@ threadDelay usecs = mask_ $ do
 registerDelay :: Int -> IO (TVar Bool)
 registerDelay usecs = do
   t <- atomically $ newTVar False
-  Just mgr <- readIORef eventManager
+  Just mgr <- getSystemEventManager
   _ <- registerTimeout mgr usecs . atomically $ writeTVar t True
   return t
 
@@ -80,19 +80,26 @@ closeFdWith :: (Fd -> IO ())        -- ^ Action that performs the close.
             -> Fd                   -- ^ File descriptor to close.
             -> IO ()
 closeFdWith close fd = do
-  Just mgr <- readIORef eventManager
+  Just mgr <- getSystemEventManager
   M.closeFd mgr close fd
 
 threadWait :: Event -> Fd -> IO ()
 threadWait evt fd = mask_ $ do
   m <- newEmptyMVar
-  Just mgr <- readIORef eventManager
+  Just mgr <- getSystemEventManager
   reg <- registerFd mgr (\reg e -> unregisterFd_ mgr reg >> putMVar m e) fd evt
   evt' <- takeMVar m `onException` unregisterFd_ mgr reg
   if evt' `eventIs` evtClose
     then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing
     else return ()
 
+-- | Retrieve the system event manager.
+--
+-- This function always returns 'Just' the system event manager when using the
+-- threaded RTS and 'Nothing' otherwise.
+getSystemEventManager :: IO (Maybe EventManager)
+getSystemEventManager = readIORef eventManager
+
 foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore"
     getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a)