From: Bas van Dijk <v.dijk.bas@gmail.com>
Date: Mon, 4 Apr 2011 18:22:09 +0000 (+0200)
Subject: Add GHC.Event.getSystemEventManager :: IO (Maybe EventManager)
X-Git-Url: http://git.megacz.com/?p=ghc-base.git;a=commitdiff_plain;h=cc5431edd61fccbf082db6df10d502bb85e86078

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

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)