module GHC.Event.Internal
(
Backend
, backend
, delete
, poll
, modifyFd
, modifyFdOnce
, Event
, evtRead
, evtWrite
, evtClose
, eventIs
, Timeout(..)
, throwErrnoIfMinus1NoRetry
) where
import Data.Bits ((.|.), (.&.))
import Data.List (foldl', intercalate)
import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..))
import Foreign.C.Error (eINTR, getErrno, throwErrno)
import System.Posix.Types (Fd)
import GHC.Base
import GHC.Num (Num(..))
import GHC.Show (Show(..))
import GHC.List (filter, null)
newtype Event = Event Int
deriving (Eq)
evtNothing :: Event
evtNothing = Event 0
evtRead :: Event
evtRead = Event 1
evtWrite :: Event
evtWrite = Event 2
evtClose :: Event
evtClose = Event 4
eventIs :: Event -> Event -> Bool
eventIs (Event a) (Event b) = a .&. b /= 0
instance Show Event where
show e = '[' : (intercalate "," . filter (not . null) $
[evtRead `so` "evtRead",
evtWrite `so` "evtWrite",
evtClose `so` "evtClose"]) ++ "]"
where ev `so` disp | e `eventIs` ev = disp
| otherwise = ""
instance Monoid Event where
mempty = evtNothing
mappend = evtCombine
mconcat = evtConcat
evtCombine :: Event -> Event -> Event
evtCombine (Event a) (Event b) = Event (a .|. b)
evtConcat :: [Event] -> Event
evtConcat = foldl' evtCombine evtNothing
data Timeout = Timeout !Double
| Forever
deriving (Show)
data Backend = forall a. Backend {
_beState :: !a
, _bePoll :: a
-> Maybe Timeout
-> (Fd -> Event -> IO ())
-> IO Int
, _beModifyFd :: a
-> Fd
-> Event
-> Event
-> IO Bool
, _beModifyFdOnce :: a
-> Fd
-> Event
-> IO Bool
, _beDelete :: a -> IO ()
}
backend :: (a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int)
-> (a -> Fd -> Event -> Event -> IO Bool)
-> (a -> Fd -> Event -> IO Bool)
-> (a -> IO ())
-> a
-> Backend
backend bPoll bModifyFd bModifyFdOnce bDelete state =
Backend state bPoll bModifyFd bModifyFdOnce bDelete
poll :: Backend -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
poll (Backend bState bPoll _ _ _) = bPoll bState
modifyFd :: Backend -> Fd -> Event -> Event -> IO Bool
modifyFd (Backend bState _ bModifyFd _ _) = bModifyFd bState
modifyFdOnce :: Backend -> Fd -> Event -> IO Bool
modifyFdOnce (Backend bState _ _ bModifyFdOnce _) = bModifyFdOnce bState
delete :: Backend -> IO ()
delete (Backend bState _ _ _ bDelete) = bDelete bState
throwErrnoIfMinus1NoRetry :: (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1NoRetry loc f = do
res <- f
if res == 1
then do
err <- getErrno
if err == eINTR then return 0 else throwErrno loc
else return res