{-# LANGUAGE Unsafe #-}{-# LANGUAGE ExistentialQuantification, NoImplicitPrelude #-}moduleGHC.Event.Internal(-- * Event back endBackend ,backend ,delete ,poll ,modifyFd ,modifyFdOnce -- * Event type,Event ,evtRead ,evtWrite ,evtClose ,eventIs -- * Lifetimes,Lifetime (..),EventLifetime ,eventLifetime ,elLifetime ,elEvent -- * Timeout type,Timeout (..)-- * Helpers,throwErrnoIfMinus1NoRetry )whereimportData.Bits ((.|.) ,(.&.) )importData.OldList (foldl' ,filter ,intercalate ,null )importForeign.C.Error (eINTR ,getErrno ,throwErrno )importSystem.Posix.Types (Fd )importGHC.Base importGHC.Word (Word64 )importGHC.Num (Num (..))importGHC.Show (Show (..))importData.Semigroup.Internal (stimesMonoid )-- | An I\/O event.newtypeEvent =Event IntderivingEq-- ^ @since 4.4.0.0evtNothing ::Event evtNothing :: Event
evtNothing =Int -> Event
Event 0{-# INLINEevtNothing #-}-- | Data is available to be read.evtRead ::Event evtRead :: Event
evtRead =Int -> Event
Event 1{-# INLINEevtRead #-}-- | The file descriptor is ready to accept a write.evtWrite ::Event evtWrite :: Event
evtWrite =Int -> Event
Event 2{-# INLINEevtWrite #-}-- | Another thread closed the file descriptor.evtClose ::Event evtClose :: Event
evtClose =Int -> Event
Event 4{-# INLINEevtClose #-}eventIs ::Event ->Event ->BooleventIs :: Event -> Event -> Bool
eventIs (Event a :: Int
a )(Event b :: Int
b )=Int
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=0-- | @since 4.4.0.0instanceShow Event whereshow :: Event -> String
show e :: Event
e ='['Char -> ShowS
forall a. a -> [a] -> [a]
:(String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ","([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
null )([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [Event
evtRead Event -> ShowS
`so` "evtRead",Event
evtWrite Event -> ShowS
`so` "evtWrite",Event
evtClose Event -> ShowS
`so` "evtClose"])String -> ShowS
forall a. [a] -> [a] -> [a]
++ "]"whereev :: Event
ev so :: Event -> ShowS
`so` disp :: String
disp |Event
e Event -> Event -> Bool
`eventIs` Event
ev =String
disp |Bool
otherwise =""-- | @since 4.10.0.0instanceSemigroup Event where<> :: Event -> Event -> Event
(<>) =Event -> Event -> Event
evtCombine stimes :: b -> Event -> Event
stimes =b -> Event -> Event
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesMonoid -- | @since 4.4.0.0instanceMonoid Event wheremempty :: Event
mempty =Event
evtNothing mconcat :: [Event] -> Event
mconcat =[Event] -> Event
evtConcat evtCombine ::Event ->Event ->Event evtCombine :: Event -> Event -> Event
evtCombine (Event a :: Int
a )(Event b :: Int
b )=Int -> Event
Event (Int
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b ){-# INLINEevtCombine #-}evtConcat ::[Event ]->Event evtConcat :: [Event] -> Event
evtConcat =(Event -> Event -> Event) -> Event -> [Event] -> Event
forall a b. (b -> a -> b) -> b -> [a] -> b
foldl' Event -> Event -> Event
evtCombine Event
evtNothing {-# INLINEevtConcat #-}-- | The lifetime of an event registration.---- @since 4.8.1.0dataLifetime =OneShot -- ^ the registration will be active for only one-- event|MultiShot -- ^ the registration will trigger multiple timesderiving(Show -- ^ @since 4.8.1.0,Eq-- ^ @since 4.8.1.0)-- | The longer of two lifetimes.elSupremum ::Lifetime ->Lifetime ->Lifetime elSupremum :: Lifetime -> Lifetime -> Lifetime
elSupremum OneShot OneShot =Lifetime
OneShot elSupremum __=Lifetime
MultiShot {-# INLINEelSupremum #-}-- | @since 4.10.0.0instanceSemigroup Lifetime where<> :: Lifetime -> Lifetime -> Lifetime
(<>) =Lifetime -> Lifetime -> Lifetime
elSupremum stimes :: b -> Lifetime -> Lifetime
stimes =b -> Lifetime -> Lifetime
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesMonoid -- | @mappend@ takes the longer of two lifetimes.---- @since 4.8.0.0instanceMonoid Lifetime wheremempty :: Lifetime
mempty =Lifetime
OneShot -- | A pair of an event and lifetime---- Here we encode the event in the bottom three bits and the lifetime-- in the fourth bit.newtypeEventLifetime =EL Intderiving(Show -- ^ @since 4.8.0.0,Eq-- ^ @since 4.8.0.0)-- | @since 4.11.0.0instanceSemigroup EventLifetime whereEL a :: Int
a <> :: EventLifetime -> EventLifetime -> EventLifetime
<> EL b :: Int
b =Int -> EventLifetime
EL (Int
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b )-- | @since 4.8.0.0instanceMonoid EventLifetime wheremempty :: EventLifetime
mempty =Int -> EventLifetime
EL 0eventLifetime ::Event ->Lifetime ->EventLifetime eventLifetime :: Event -> Lifetime -> EventLifetime
eventLifetime (Event e :: Int
e )l :: Lifetime
l =Int -> EventLifetime
EL (Int
e Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Lifetime -> Int
forall p. Num p => Lifetime -> p
lifetimeBit Lifetime
l )wherelifetimeBit :: Lifetime -> p
lifetimeBit OneShot =0lifetimeBit MultiShot =8{-# INLINEeventLifetime #-}elLifetime ::EventLifetime ->Lifetime elLifetime :: EventLifetime -> Lifetime
elLifetime (EL x :: Int
x )=ifInt
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 8Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==0thenLifetime
OneShot elseLifetime
MultiShot {-# INLINEelLifetime #-}elEvent ::EventLifetime ->Event elEvent :: EventLifetime -> Event
elEvent (EL x :: Int
x )=Int -> Event
Event (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0x7){-# INLINEelEvent #-}-- | A type alias for timeouts, specified in nanoseconds.dataTimeout =Timeout {-# UNPACK#-}!Word64 |Forever derivingShow -- ^ @since 4.4.0.0-- | Event notification backend.dataBackend =foralla .Backend {()
_beState ::!a -- | Poll backend for new events. The provided callback is called-- once per file descriptor with new events.,()
_bePoll ::a -- backend state->Maybe Timeout -- timeout in milliseconds ('Nothing' for non-blocking poll)->(Fd ->Event ->IO())-- I/O callback->IOInt-- | Register, modify, or unregister interest in the given events-- on the given file descriptor.,()
_beModifyFd ::a ->Fd -- file descriptor->Event -- old events to watch for ('mempty' for new)->Event -- new events to watch for ('mempty' to delete)->IOBool-- | Register interest in new events on a given file descriptor, set-- to be deactivated after the first event.,()
_beModifyFdOnce ::a ->Fd -- file descriptor->Event -- new events to watch->IOBool,()
_beDelete ::a ->IO()}backend ::(a ->Maybe Timeout ->(Fd ->Event ->IO())->IOInt)->(a ->Fd ->Event ->Event ->IOBool)->(a ->Fd ->Event ->IOBool)->(a ->IO())->a ->Backend 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 :: a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
bPoll bModifyFd :: a -> Fd -> Event -> Event -> IO Bool
bModifyFd bModifyFdOnce :: a -> Fd -> Event -> IO Bool
bModifyFdOnce bDelete :: a -> IO ()
bDelete state :: a
state =a
-> (a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int)
-> (a -> Fd -> Event -> Event -> IO Bool)
-> (a -> Fd -> Event -> IO Bool)
-> (a -> IO ())
-> Backend
forall a.
a
-> (a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int)
-> (a -> Fd -> Event -> Event -> IO Bool)
-> (a -> Fd -> Event -> IO Bool)
-> (a -> IO ())
-> Backend
Backend a
state a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
bPoll a -> Fd -> Event -> Event -> IO Bool
bModifyFd a -> Fd -> Event -> IO Bool
bModifyFdOnce a -> IO ()
bDelete {-# INLINEbackend #-}poll ::Backend ->Maybe Timeout ->(Fd ->Event ->IO())->IOIntpoll :: Backend -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
poll (Backend bState :: a
bState bPoll :: a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
bPoll ___)=a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
bPoll a
bState {-# INLINEpoll #-}-- | Returns 'True' if the modification succeeded.-- Returns 'False' if this backend does not support-- event notifications on this type of file.modifyFd ::Backend ->Fd ->Event ->Event ->IOBoolmodifyFd :: Backend -> Fd -> Event -> Event -> IO Bool
modifyFd (Backend bState :: a
bState _bModifyFd :: a -> Fd -> Event -> Event -> IO Bool
bModifyFd __)=a -> Fd -> Event -> Event -> IO Bool
bModifyFd a
bState {-# INLINEmodifyFd #-}-- | Returns 'True' if the modification succeeded.-- Returns 'False' if this backend does not support-- event notifications on this type of file.modifyFdOnce ::Backend ->Fd ->Event ->IOBoolmodifyFdOnce :: Backend -> Fd -> Event -> IO Bool
modifyFdOnce (Backend bState :: a
bState __bModifyFdOnce :: a -> Fd -> Event -> IO Bool
bModifyFdOnce _)=a -> Fd -> Event -> IO Bool
bModifyFdOnce a
bState {-# INLINEmodifyFdOnce #-}delete ::Backend ->IO()delete :: Backend -> IO ()
delete (Backend bState :: a
bState ___bDelete :: a -> IO ()
bDelete )=a -> IO ()
bDelete a
bState {-# INLINEdelete #-}-- | Throw an 'Prelude.IOError' corresponding to the current value of-- 'getErrno' if the result value of the 'IO' action is -1 and-- 'getErrno' is not 'eINTR'. If the result value is -1 and-- 'getErrno' returns 'eINTR' 0 is returned. Otherwise the result-- value is returned.throwErrnoIfMinus1NoRetry ::(Eqa ,Num a )=>String ->IOa ->IOa throwErrnoIfMinus1NoRetry :: String -> IO a -> IO a
throwErrnoIfMinus1NoRetry loc :: String
loc f :: IO a
f =doa
res <-IO a
f ifa
res a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==-1thendoErrno
err <-IO Errno
getErrno ifErrno
err Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
==Errno
eINTR thena -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return 0elseString -> IO a
forall a. String -> IO a
throwErrno String
loc elsea -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res