Permalink
Browse files

Beat the epoll code into shape somewhat.

  • Loading branch information...
bos committed Jan 6, 2010
1 parent ca70603 commit 8871e70d9f62e59309c8f425bf0c980f8c0c00cb
Showing with 24 additions and 57 deletions.
  1. +24 −57 src/System/Event/EPoll.hsc
View
@@ -6,9 +6,8 @@ module System.Event.EPoll where
import Control.Monad (liftM, liftM3, when)
import Data.Bits ((.|.))
-import Foreign.C.Error (throwErrnoIfMinus1)
+import Foreign.C.Error (throwErrnoIfMinus1, throwErrnoIfMinus1_)
import Foreign.C.Types (CInt, CUInt)
-import Foreign.Marshal.Error (void)
import Foreign.Marshal.Utils (with)
import Foreign.Ptr (Ptr)
import Foreign.Storable (Storable(..))
@@ -18,18 +17,12 @@ import qualified System.Event.Array as A
import qualified System.Event.Internal as E
import System.Event.Internal (Timeout(..))
--- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
+newtype EPollFd = EPollFd CInt
-newtype EPollFd = EPollFd
- { unEPollFd :: Fd
- }
-
--- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-
-data Event = Event
- { eventTypes :: EventType
+data Event = Event {
+ eventTypes :: EventType
, eventFd :: Fd
- }
+ } deriving (Show)
instance Storable Event where
sizeOf _ = #size struct epoll_event
@@ -44,23 +37,17 @@ instance Storable Event where
#{poke struct epoll_event, events} ptr (unEventType $ eventTypes e)
#{poke struct epoll_event, data} ptr (eventFd e)
--- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-
-newtype ControlOp = ControlOp
- { unControlOp :: CInt
- }
+newtype ControlOp = ControlOp CInt
#{enum ControlOp, ControlOp
, controlOpAdd = EPOLL_CTL_ADD
, controlOpModify = EPOLL_CTL_MOD
, controlOpDelete = EPOLL_CTL_DEL
}
--- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-
-newtype EventType = EventType
- { unEventType :: CUInt
- }
+newtype EventType = EventType {
+ unEventType :: CUInt
+ } deriving (Show)
#{enum EventType, EventType
, eventTypeReadyForRead = EPOLLIN
@@ -76,8 +63,6 @@ newtype EventType = EventType
combineEventTypes :: [EventType] -> EventType
combineEventTypes = EventType . foldr ((.|.) . unEventType) 0
--- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-
foreign import ccall unsafe "sys/epoll.h epoll_create"
c_epoll_create :: CInt -> IO CInt
@@ -87,44 +72,29 @@ foreign import ccall unsafe "sys/epoll.h epoll_ctl"
foreign import ccall unsafe "sys/epoll.h epoll_wait"
c_epoll_wait :: CInt -> Ptr Event -> CInt -> CInt -> IO CInt
--- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-
epollCreate :: IO EPollFd
epollCreate =
- EPollFd `fmap` throwErrnoIfMinus1 "epollCreate" (liftM Fd $ c_epoll_create size)
+ fmap EPollFd .
+ throwErrnoIfMinus1 "epollCreate" $
+ c_epoll_create size
where
-- From manpage EPOLL_CREATE(2): "Since Linux 2.6.8, the size argument is
-- unused. (The kernel dynamically sizes the required data structures
-- without needing this initial hint.)" We pass 256 because libev does.
size = 256 :: CInt
-epollControl :: EPollFd -> ControlOp -> CInt -> Ptr Event -> IO ()
-epollControl epfd op fd event =
- void $
- throwErrnoIfMinus1
- "epollControl"
- (c_epoll_ctl
- (fromIntegral $ unEPollFd epfd)
- (unControlOp op)
- (fromIntegral fd)
- event)
+epollControl :: EPollFd -> ControlOp -> Fd -> Ptr Event -> IO ()
+epollControl (EPollFd epfd) (ControlOp op) (Fd fd) event =
+ throwErrnoIfMinus1_ "epollControl" $ c_epoll_ctl epfd op fd event
epollWait :: EPollFd -> Ptr Event -> Int -> Int -> IO Int
-epollWait epfd events maxNumEvents maxNumMilliseconds =
- fmap fromIntegral $
- throwErrnoIfMinus1
- "epollWait"
- (c_epoll_wait
- (fromIntegral $ unEPollFd epfd)
- events
- (fromIntegral maxNumEvents)
- (fromIntegral maxNumMilliseconds)
- )
-
--- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-
-data EPoll = EPoll
- { epollEpfd :: !EPollFd
+epollWait (EPollFd epfd) events numEvents timeout =
+ fmap fromIntegral .
+ throwErrnoIfMinus1 "epollWait" $
+ c_epoll_wait epfd events (fromIntegral numEvents) (fromIntegral timeout)
+
+data EPoll = EPoll {
+ epollFd :: !EPollFd
, epollEvents :: !(A.Array Event)
, epollWakeup :: !E.Wakeup
}
@@ -143,7 +113,7 @@ new = do
set :: EPoll -> Fd -> [E.Event] -> IO ()
set ep fd events =
- with e $ epollControl (epollEpfd ep) controlOpAdd (fromIntegral fd)
+ with e $ epollControl (epollFd ep) controlOpAdd fd
where
e = Event ets fd
ets = combineEventTypes (map fromEvent events)
@@ -153,7 +123,7 @@ poll :: EPoll -- ^ state
-> (Fd -> [E.Event] -> IO ()) -- ^ I/O callback
-> IO E.Result
poll ep timeout f = do
- let epfd = epollEpfd ep
+ let epfd = epollFd ep
let events = epollEvents ep
n <- A.unsafeLoad events $ \es cap ->
@@ -172,13 +142,10 @@ poll ep timeout f = do
wakeup :: EPoll -> E.WakeupMessage -> IO ()
wakeup ep = E.writeWakeupMessage (epollWakeup ep)
--- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-
fromEvent :: E.Event -> EventType
fromEvent E.Read = eventTypeReadyForRead
fromEvent E.Write = eventTypeReadyForWrite
-
fromTimeout :: Timeout -> Int
fromTimeout Forever = -1
fromTimeout (Timeout ms) = fromIntegral ms

0 comments on commit 8871e70

Please sign in to comment.