EpollM.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- |
-- Module      : System.Linux.EpollM
-- Copyright   : (c) 2009 Toralf Wittner
-- License     : LGPL
-- Maintainer  : toralf.wittner@gmail.com
-- Stability   : experimental
-- Portability : non-portable
--
-- Monadic epoll interface. Similar to System.Linux.Epoll.Base but uses
-- 'ReaderT' to hold a 'Device' instead of passing it to many functions.

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) 

-- | Run Epoll monad.
runEpoll :: E.Device -> Epoll a -> IO a
runEpoll d e = runReaderT (runDev e) d

-- | Run Epoll monad. Like 'runEpoll' but creates and closes
-- 'Device' implcitely.
runEpoll_ :: E.Size -> Epoll a -> IO a
runEpoll_ s e = bracket (E.create s) E.close (flip runEpoll e)

-- | Like 'runEpoll_' but with an implicit 'Size' value of 8.
runEpollSmall_ :: Epoll a -> IO a
runEpollSmall_ = runEpollN_ 8

-- | Like 'runEpoll_' but with an implicit 'Size' value of 256.
runEpollMed_ :: Epoll a -> IO a
runEpollMed_ = runEpollN_ 256

-- | Like 'runEpoll_' but with an implicit 'Size' value of 8192.
runEpollBig_ :: Epoll a -> IO a
runEpollBig_ = runEpollN_ 8192

-- | Adds the given file descriptor with the specified event types to epoll.
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

-- | Like 'add' but without accepting custom data.
add_ :: [E.EventType] -> Fd -> Epoll (E.Descriptor ())
add_ = add () 

-- | Modify the event type set of the given descriptor.
modify :: [E.EventType] -> E.Descriptor a -> Epoll ()
modify e d = do
    dev <- ask
    liftIO $ E.modify dev e d

-- | Deletes the descriptor from epoll.
delete :: E.Descriptor a -> Epoll ()
delete d = do
    dev <- ask
    liftIO $ E.delete dev d

-- | Waits up to the given duration for events on all descriptors.
wait :: E.Duration -> Epoll [E.Event a]
wait d = do
    dev <- ask
    liftIO $ E.wait d dev

-- | Like 'wait' but uses a 'Duration' of 500ms.
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

-- | Waits for events and calls the given function for each.
dispatchLoop :: E.Duration -> (E.Event a -> Epoll ()) -> Epoll ()
dispatchLoop dur f = forever $ wait dur >>= mapM_ f

-- | Like 'dispatchLoop' but with predefined 'Duration' of 500ms.
defaultDispatchLoop :: (E.Event a -> Epoll ()) -> Epoll ()
defaultDispatchLoop = dispatchLoop (fromJust $ E.toDuration 500)

-- | Like 'dispatchLoop' but forks itself into another thread
dispatchLoop_ :: E.Duration -> (E.Event a -> Epoll ()) -> Epoll ThreadId
dispatchLoop_ dur f = fork $ forever $ wait dur >>= mapM_ f

-- | Like 'defaultDispatchLoop' but forks itself into another thread
defaultDispatchLoop_ :: (E.Event a -> Epoll ()) -> Epoll ThreadId
defaultDispatchLoop_ = dispatchLoop_ (fromJust $ E.toDuration 500)

-- | Uses 'forkIO' to spark an epoll computation into another thread.
fork :: Epoll () -> Epoll ThreadId
fork (Epoll r) = Epoll $ mapReaderT forkIO r

-- | Like 'fork' but swallows the ThreadId.
fork_ :: Epoll () -> Epoll ()
fork_ e = fork e >> return ()