Permalink
Browse files

Fix compilation errors in the kqueue backend

  • Loading branch information...
1 parent 14ee3da commit f6e6cc815e13e4141ef4ee23b0aef90ef3ad3e54 @tibbe tibbe committed Jan 6, 2010
Showing with 19 additions and 13 deletions.
  1. +19 −13 src/System/Event/KQueue.hsc
View
32 src/System/Event/KQueue.hsc
@@ -4,11 +4,12 @@ module System.Event.KQueue where
import Control.Monad
import Data.Bits
+import Data.Monoid (Monoid(..))
import Foreign.C.Error
import Foreign.C.Types
+import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
-import Foreign.Marshal.Alloc
import Prelude hiding (filter)
import System.Posix.Types (Fd(..))
@@ -158,13 +159,13 @@ data EventQueue = EventQueue {
instance E.Backend EventQueue where
new = new
poll = poll
- set q fd evs = set q fd (combineFilters $ map fromEvent evs) flagAdd
+ set q fd evs = set q fd (fromEvent evs) flagAdd
wakeup = wakeup
new :: IO EventQueue
new = do
eq <- liftM4 EventQueue kqueue A.empty (A.new 64) E.createWakeup
- set eq (E.wakeupReadFd . eqWakeup $ eq) [E.Read]
+ set eq (E.wakeupReadFd . eqWakeup $ eq) filterRead flagAdd
return eq
set :: EventQueue -> Fd -> Filter -> Flag -> IO ()
@@ -173,7 +174,7 @@ set q fd fltr flg =
poll :: EventQueue
-> Timeout
- -> (Fd -> [E.Event] -> IO ())
+ -> (Fd -> E.Event -> IO ())
-> IO E.Result
poll q tout f = do
changesLen <- A.length (changes q)
@@ -191,19 +192,24 @@ poll q tout f = do
when (res == eventsLen) $ do
A.ensureCapacity (events q) (2 * eventsLen)
- A.mapM_ (events q) $ \e -> do
- let fd = fromIntegral (ident e)
- filt = filter e
- evs = if filt == filterRead then [E.Read]
- else if filt == filterWrite then [E.Write]
- else []
- f fd evs
+ A.mapM_ (events q) $ \e ->
+ f (fromIntegral . ident $ e) (toEvent . filter $ e)
return E.Activity
wakeup :: EventQueue -> E.WakeupMessage -> IO ()
wakeup ep = E.writeWakeupMessage (eqWakeup ep)
fromEvent :: E.Event -> Filter
-fromEvent E.Read = filterRead
-fromEvent E.Write = filterWrite
+fromEvent e = Filter (remap E.evtRead (#const EVFILT_READ) .|.
+ remap E.evtWrite (#const EVFILT_WRITE))
+ where remap evt to
+ | e `E.eventIs` evt = to
+ | otherwise = 0
+
+toEvent :: Filter -> E.Event
+toEvent (Filter f) = remap (#const EVFILT_READ) E.evtRead `mappend`
+ remap (#const EVFILT_WRITE) E.evtWrite
+ where remap evt to
+ | f .&. evt /= 0 = to
+ | otherwise = mempty

0 comments on commit f6e6cc8

Please sign in to comment.