module System.Linux.EpollM (
Epoll,
runEpoll,
runEpoll_,
runEpollSmall_,
runEpollMed_,
runEpollBig_,
add,
add_,
modify,
delete,
wait,
wait_,
device,
dispatchLoop,
dispatchLoop_,
defaultDispatchLoop,
defaultDispatchLoop_,
fork,
fork_,
E.EventType,
E.Size,
E.toSize,
E.Duration,
E.toDuration,
E.Descriptor,
E.Device,
E.Event (eventFd, eventType, eventRef, eventDesc),
(E.=~),
E.create,
E.close,
E.inEvent,
E.outEvent,
E.peerCloseEvent,
E.urgentEvent,
E.errorEvent,
E.hangupEvent,
E.edgeTriggeredEvent,
E.oneShotEvent
) where
import Data.Maybe (fromJust)
import Control.Concurrent
import Control.Monad.Reader
import Control.Exception (bracket)
import System.Posix.Types (Fd)
import qualified System.Linux.Epoll as E
newtype Epoll a = Epoll {
runDev :: ReaderT E.Device IO a
} deriving (Monad, MonadIO, MonadReader E.Device)
runEpoll :: E.Device -> Epoll a -> IO a
runEpoll d e = runReaderT (runDev e) d
runEpoll_ :: E.Size -> Epoll a -> IO a
runEpoll_ s e = bracket (E.create s) E.close (flip runEpoll e)
runEpollSmall_ :: Epoll a -> IO a
runEpollSmall_ = runEpollN_ 8
runEpollMed_ :: Epoll a -> IO a
runEpollMed_ = runEpollN_ 256
runEpollBig_ :: Epoll a -> IO a
runEpollBig_ = runEpollN_ 8192
add :: a -> [E.EventType] -> Fd -> Epoll (E.Descriptor a)
add d e f = do
dev <- ask
des <- liftIO $ E.add dev d e f
return des
add_ :: [E.EventType] -> Fd -> Epoll (E.Descriptor ())
add_ = add ()
modify :: [E.EventType] -> E.Descriptor a -> Epoll ()
modify e d = do
dev <- ask
liftIO $ E.modify dev e d
delete :: E.Descriptor a -> Epoll ()
delete d = do
dev <- ask
liftIO $ E.delete dev d
wait :: E.Duration -> Epoll [E.Event a]
wait d = do
dev <- ask
liftIO $ E.wait d dev
wait_ :: Epoll [E.Event a]
wait_ = wait (fromJust $ E.toDuration 500)
runEpollN_ :: Int -> Epoll a -> IO a
runEpollN_ = runEpoll_ . fromJust . E.toSize
device :: Epoll E.Device
device = ask
dispatchLoop :: E.Duration -> (E.Event a -> Epoll ()) -> Epoll ()
dispatchLoop dur f = forever $ wait dur >>= mapM_ f
defaultDispatchLoop :: (E.Event a -> Epoll ()) -> Epoll ()
defaultDispatchLoop = dispatchLoop (fromJust $ E.toDuration 500)
dispatchLoop_ :: E.Duration -> (E.Event a -> Epoll ()) -> Epoll ThreadId
dispatchLoop_ dur f = fork $ forever $ wait dur >>= mapM_ f
defaultDispatchLoop_ :: (E.Event a -> Epoll ()) -> Epoll ThreadId
defaultDispatchLoop_ = dispatchLoop_ (fromJust $ E.toDuration 500)
fork :: Epoll () -> Epoll ThreadId
fork (Epoll r) = Epoll $ mapReaderT forkIO r
fork_ :: Epoll () -> Epoll ()
fork_ e = fork e >> return ()