Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Minor tidyups.

  • Loading branch information...
commit bf059b34446299870004a6d4ab94fb507e948a4b 1 parent 8871e70
@bos bos authored
Showing with 68 additions and 90 deletions.
  1. +3 −10 src/System/Event.hs
  2. +65 −80 src/System/Event/EPoll.hsc
View
13 src/System/Event.hs
@@ -27,7 +27,7 @@ module System.Event
------------------------------------------------------------------------
-- Imports
-import Control.Monad (sequence_)
+import Control.Monad (liftM3, sequence_)
import Data.IntMap as IM
import Data.IORef
import Data.Maybe (maybe)
@@ -73,21 +73,14 @@ data EventManager = forall a. Backend a => EventManager
-- | Create a new event manager.
new :: IO EventManager
-new = do
- be <- Backend.new
- cbs <- newIORef empty
- tms <- newIORef TT.empty
- return $ EventManager be cbs tms
+new = liftM3 EventManager Backend.new (newIORef empty) (newIORef TT.empty)
------------------------------------------------------------------------
-- Event loop
-- | Start handling events. This function never returns.
loop :: EventManager -> IO ()
-loop mgr@(EventManager be _ tt) = do
- now <- getCurrentTime
- go now
-
+loop mgr@(EventManager be _ tt) = go =<< getCurrentTime
where
go now = do
timeout <- mkTimeout now
View
145 src/System/Event/EPoll.hsc
@@ -4,10 +4,11 @@ module System.Event.EPoll where
#include <sys/epoll.h>
-import Control.Monad (liftM, liftM3, when)
+import Control.Monad (liftM3, when)
import Data.Bits ((.|.))
+import Data.Word (Word32)
import Foreign.C.Error (throwErrnoIfMinus1, throwErrnoIfMinus1_)
-import Foreign.C.Types (CInt, CUInt)
+import Foreign.C.Types (CInt)
import Foreign.Marshal.Utils (with)
import Foreign.Ptr (Ptr)
import Foreign.Storable (Storable(..))
@@ -17,82 +18,6 @@ import qualified System.Event.Array as A
import qualified System.Event.Internal as E
import System.Event.Internal (Timeout(..))
-newtype EPollFd = EPollFd CInt
-
-data Event = Event {
- eventTypes :: EventType
- , eventFd :: Fd
- } deriving (Show)
-
-instance Storable Event where
- sizeOf _ = #size struct epoll_event
- alignment _ = alignment (undefined :: CInt)
-
- peek ptr = do
- ets <- #{peek struct epoll_event, events} ptr
- ed <- #{peek struct epoll_event, data} ptr
- return $ Event (EventType ets) ed
-
- poke ptr e = do
- #{poke struct epoll_event, events} ptr (unEventType $ eventTypes e)
- #{poke struct epoll_event, data} ptr (eventFd e)
-
-newtype ControlOp = ControlOp CInt
-
-#{enum ControlOp, ControlOp
- , controlOpAdd = EPOLL_CTL_ADD
- , controlOpModify = EPOLL_CTL_MOD
- , controlOpDelete = EPOLL_CTL_DEL
- }
-
-newtype EventType = EventType {
- unEventType :: CUInt
- } deriving (Show)
-
-#{enum EventType, EventType
- , eventTypeReadyForRead = EPOLLIN
- , eventTypeReadyForWrite = EPOLLOUT
- , eventTypePeerClosedConnection = EPOLLRDHUP
- , eventTypeUrgentDataReadyForRead = EPOLLPRI
- , eventTypeError = EPOLLERR
- , eventTypeHangup = EPOLLHUP
- , eventTypeEdgeTriggered = EPOLLET
- , eventTypeOneShot = EPOLLONESHOT
- }
-
-combineEventTypes :: [EventType] -> EventType
-combineEventTypes = EventType . foldr ((.|.) . unEventType) 0
-
-foreign import ccall unsafe "sys/epoll.h epoll_create"
- c_epoll_create :: CInt -> IO CInt
-
-foreign import ccall unsafe "sys/epoll.h epoll_ctl"
- c_epoll_ctl :: CInt -> CInt -> CInt -> Ptr Event -> IO CInt
-
-foreign import ccall unsafe "sys/epoll.h epoll_wait"
- c_epoll_wait :: CInt -> Ptr Event -> CInt -> CInt -> IO CInt
-
-epollCreate :: IO EPollFd
-epollCreate =
- 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 -> 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 (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)
@@ -142,10 +67,70 @@ poll ep timeout f = do
wakeup :: EPoll -> E.WakeupMessage -> IO ()
wakeup ep = E.writeWakeupMessage (epollWakeup ep)
+newtype EPollFd = EPollFd CInt
+
+data Event = Event {
+ eventTypes :: EventType
+ , eventFd :: Fd
+ } deriving (Show)
+
+instance Storable Event where
+ sizeOf _ = #size struct epoll_event
+ alignment _ = alignment (undefined :: CInt)
+
+ peek ptr = do
+ ets <- #{peek struct epoll_event, events} ptr
+ ed <- #{peek struct epoll_event, data.fd} ptr
+ return $ Event (EventType ets) ed
+
+ poke ptr e = do
+ #{poke struct epoll_event, events} ptr (unEventType $ eventTypes e)
+ #{poke struct epoll_event, data.fd} ptr (eventFd e)
+
+newtype ControlOp = ControlOp CInt
+
+#{enum ControlOp, ControlOp
+ , controlOpAdd = EPOLL_CTL_ADD
+ , controlOpModify = EPOLL_CTL_MOD
+ , controlOpDelete = EPOLL_CTL_DEL
+ }
+
+newtype EventType = EventType {
+ unEventType :: Word32
+ } deriving (Show)
+
+combineEventTypes :: [EventType] -> EventType
+combineEventTypes = EventType . foldr ((.|.) . unEventType) 0
+
+epollCreate :: IO EPollFd
+epollCreate =
+ fmap EPollFd .
+ throwErrnoIfMinus1 "epollCreate" $
+ c_epoll_create 256 -- argument is ignored
+
+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 (EPollFd epfd) events numEvents timeout =
+ fmap fromIntegral .
+ throwErrnoIfMinus1 "epollWait" $
+ c_epoll_wait epfd events (fromIntegral numEvents) (fromIntegral timeout)
+
fromEvent :: E.Event -> EventType
-fromEvent E.Read = eventTypeReadyForRead
-fromEvent E.Write = eventTypeReadyForWrite
+fromEvent E.Read = EventType #const EPOLLIN
+fromEvent E.Write = EventType #const EPOLLOUT
fromTimeout :: Timeout -> Int
fromTimeout Forever = -1
fromTimeout (Timeout ms) = fromIntegral ms
+
+foreign import ccall unsafe "sys/epoll.h epoll_create"
+ c_epoll_create :: CInt -> IO CInt
+
+foreign import ccall unsafe "sys/epoll.h epoll_ctl"
+ c_epoll_ctl :: CInt -> CInt -> CInt -> Ptr Event -> IO CInt
+
+foreign import ccall unsafe "sys/epoll.h epoll_wait"
+ c_epoll_wait :: CInt -> Ptr Event -> CInt -> CInt -> IO CInt
Please sign in to comment.
Something went wrong with that request. Please try again.