module GHC.Event.Internal
(
Backend
, backend
, delete
, poll
, modifyFd
, Event
, evtRead
, evtWrite
, evtClose
, eventIs
, Timeout(..)
, throwErrnoIfMinus1NoRetry
) where
import Data.Bits ((.|.), (.&.))
import Data.List (foldl', intercalate)
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
-> Timeout
-> (Fd -> Event -> IO ())
-> IO ()
, _beModifyFd :: a
-> Fd
-> Event
-> Event
-> IO ()
, _beDelete :: a -> IO ()
}
backend :: (a -> Timeout -> (Fd -> Event -> IO ()) -> IO ())
-> (a -> Fd -> Event -> Event -> IO ())
-> (a -> IO ())
-> a
-> Backend
backend bPoll bModifyFd bDelete state = Backend state bPoll bModifyFd bDelete
poll :: Backend -> Timeout -> (Fd -> Event -> IO ()) -> IO ()
poll (Backend bState bPoll _ _) = bPoll bState
modifyFd :: Backend -> Fd -> Event -> Event -> IO ()
modifyFd (Backend bState _ bModifyFd _) = bModifyFd 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
RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4