module System.Linux.Epoll.EventLoop (
Data,
Callback,
EventLoop,
CallbackFn,
EventMap,
createEventLoop,
stopEventLoop,
addCallback,
removeCallback,
reEnableCallback,
closeEvents
) where
import Util
import Control.Monad
import Control.Concurrent
import Control.Concurrent.MVar
import Data.Maybe
import System.Posix.Types (Fd)
import System.Linux.Epoll.Base
import System.Posix.IO (setFdOption, FdOption (NonBlockingRead))
type CallbackFn = Device -> Event Data -> IO ()
type EventMap = [(EventType, CallbackFn)]
type Garbage = MVar [Descriptor Data]
data Data = Data {
cbMap :: EventMap,
cbDirty :: MVar Bool
}
data Callback = Callback {
cbData :: Data,
cbDesc :: Descriptor Data
}
data EventLoop = EventLoop {
elDevice :: Device,
elLoop :: ThreadId,
elGarbage :: Garbage
}
createEventLoop :: Size -> IO EventLoop
createEventLoop s = do
dev <- create s
bin <- newMVar []
lop <- forkIO $ runLoop dev bin
return $ EventLoop dev lop bin
stopEventLoop :: EventLoop -> IO ()
stopEventLoop el = do
killThread (elLoop el)
close (elDevice el)
addCallback :: EventLoop -> Fd -> EventMap -> IO Callback
addCallback el fd emp = do
dirty <- newMVar False
let ety = map fst emp
dat = Data emp dirty
setFdOption fd NonBlockingRead True
desc <- add (elDevice el) dat ety fd
return $ Callback dat desc
removeCallback :: EventLoop -> Callback -> IO ()
removeCallback el cb = do
doClose (elDevice el) (elGarbage el) (cbDesc cb) (cbData cb)
return ()
reEnableCallback :: Device -> Data -> Descriptor Data -> IO ()
reEnableCallback dev dat des =
withMVar (cbDirty dat) $ \dirty ->
unless dirty $
modify dev (map fst (cbMap dat)) des
runLoop :: Device -> Garbage -> IO ()
runLoop dev bin = do
let dur = fromJust . toDuration $ 500
forever $ wait dur dev >>= mapM_ dispatch >> gc bin >> yield
where
dispatch e = case eventType e of
t | t =~ closeEvents -> handleClose dev bin e
| otherwise -> handleEvent dev e
gc b = modifyMVar b (\v -> return ([], v)) >>= mapM freeDesc
handleClose :: Device -> Garbage -> Event Data -> IO ()
handleClose dev bin e = do
isDirty <- doClose dev bin (eventDesc e) (eventRef e)
unless isDirty $ handleEvent dev (e { eventType = closeEvents })
doClose :: Device -> Garbage -> Descriptor Data -> Data -> IO Bool
doClose dev bin des dat =
modifyMVar (cbDirty dat) $ \dirty -> do
unless dirty $ do
delete dev des
modifyMVar_ bin $ return . (des:)
return (True, dirty)
handleEvent :: Device -> Event Data -> IO ()
handleEvent dev e = do
let fs = lookupCB (cbMap . eventRef $ e) (eventType e)
forM_ fs $ \f -> forkIO_ $ f dev e
lookupCB :: EventMap -> EventType -> [CallbackFn]
lookupCB emap ety = map snd $ filter ((=~ ety) . fst) emap
closeEvents :: EventType
closeEvents = combineEvents [peerCloseEvent, errorEvent, hangupEvent]