[commit: base] : Refactor to handle activity on control files as special case. (049d996)

[Johan Tibell]

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

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/049d996df2e535665631c7a27633b2ba93b2882d

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

commit 049d996df2e535665631c7a27633b2ba93b2882d
Author: Andreas Voellmy <andreas.voellmy at gmail.com>
Date:   Fri Dec 21 13:30:52 2012 -0500

    Refactor to handle activity on control files as special case.
    
    This change makes the upcoming change to have the callback unregister the file easier.

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

 GHC/Event/Manager.hs |   27 ++++++++++++++++-----------
 1 files changed, 16 insertions(+), 11 deletions(-)

diff --git a/GHC/Event/Manager.hs b/GHC/Event/Manager.hs
index 0148d79..0dfc18a 100644
--- a/GHC/Event/Manager.hs
+++ b/GHC/Event/Manager.hs
@@ -128,9 +128,9 @@ callbackTableVar mgr fd = emFds mgr ! hashFd fd
 ------------------------------------------------------------------------
 -- Creation
 
-handleControlEvent :: EventManager -> FdKey -> Event -> IO ()
-handleControlEvent mgr reg _evt = do
-  msg <- readControlMessage (emControl mgr) (keyFd reg)
+handleControlEvent :: EventManager -> Fd -> Event -> IO ()
+handleControlEvent mgr fd _evt = do
+  msg <- readControlMessage (emControl mgr) fd
   case msg of
     CMsgWakeup      -> return ()
     CMsgDie         -> writeIORef (emState mgr) Finished
@@ -169,10 +169,13 @@ newWith be = do
                          , emUniqueSource = us
                          , emControl = ctrl
                          }
-  _ <- registerFd_ mgr (handleControlEvent mgr) (controlReadFd ctrl) evtRead
-  _ <- registerFd_ mgr (handleControlEvent mgr) (wakeupReadFd ctrl) evtRead
+  registerControlFd mgr (controlReadFd ctrl) evtRead
+  registerControlFd mgr (wakeupReadFd ctrl) evtRead
   return mgr
 
+registerControlFd :: EventManager -> Fd -> Event -> IO ()
+registerControlFd mgr fd evs = I.modifyFd (emBackend mgr) fd mempty evs
+
 -- | Asynchronously shuts down the event manager, if running.
 shutdown :: EventManager -> IO ()
 shutdown mgr = do
@@ -324,12 +327,14 @@ closeFd_ mgr oldMap fd = do
 
 -- | Call the callbacks corresponding to the given file descriptor.
 onFdEvent :: EventManager -> Fd -> Event -> IO ()
-onFdEvent mgr fd evs = do
-  fds <- readMVar (callbackTableVar mgr fd)
-  case IM.lookup (fromIntegral fd) fds of
-      Just cbs -> forM_ cbs $ \(FdData reg ev cb) ->
-                    when (evs `I.eventIs` ev) $ cb reg evs
-      Nothing  -> return ()
+onFdEvent mgr fd evs =
+  if fd == controlReadFd (emControl mgr) || fd == wakeupReadFd (emControl mgr)
+  then handleControlEvent mgr fd evs
+  else do fds <- readMVar (callbackTableVar mgr fd)
+          case IM.lookup (fromIntegral fd) fds of
+            Just cbs -> forM_ cbs $ \(FdData reg ev cb) ->
+                        when (evs `I.eventIs` ev) $ cb reg evs
+            Nothing  -> return ()
 
 nullToNothing :: [a] -> Maybe [a]
 nullToNothing []       = Nothing