module GHC.Event.Internal.Types
(
Event
, evtRead
, evtWrite
, evtClose
, evtNothing
, eventIs
, Lifetime(..)
, EventLifetime
, eventLifetime
, elLifetime
, elEvent
, Timeout(..)
) where
import Data.OldList (foldl', filter, intercalate, null)
import Data.Bits ((.|.), (.&.))
import Data.Semigroup.Internal (stimesMonoid)
import GHC.Base
import GHC.Show (Show(..))
import GHC.Word (Word64)
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 Semigroup Event where
(<>) = evtCombine
stimes = stimesMonoid
instance Monoid Event where
mempty = evtNothing
mconcat = evtConcat
evtCombine :: Event -> Event -> Event
evtCombine (Event a) (Event b) = Event (a .|. b)
evtConcat :: [Event] -> Event
evtConcat = foldl' evtCombine evtNothing
data Lifetime = OneShot
| MultiShot
deriving ( Show
, Eq
)
elSupremum :: Lifetime -> Lifetime -> Lifetime
elSupremum OneShot OneShot = OneShot
elSupremum _ _ = MultiShot
instance Semigroup Lifetime where
(<>) = elSupremum
stimes = stimesMonoid
instance Monoid Lifetime where
mempty = OneShot
newtype EventLifetime = EL Int
deriving ( Show
, Eq
)
instance Semigroup EventLifetime where
EL a <> EL b = EL (a .|. b)
instance Monoid EventLifetime where
mempty = EL 0
eventLifetime :: Event -> Lifetime -> EventLifetime
eventLifetime (Event e) l = EL (e .|. lifetimeBit l)
where
lifetimeBit OneShot = 0
lifetimeBit MultiShot = 8
elLifetime :: EventLifetime -> Lifetime
elLifetime (EL x) = if x .&. 8 == 0 then OneShot else MultiShot
elEvent :: EventLifetime -> Event
elEvent (EL x) = Event (x .&. 0x7)
data Timeout = Timeout !Word64
| Forever
deriving Show