{-# LANGUAGE NoImplicitPrelude #-}
-------------------------------------------------------------------------------
-- |
-- Module      :  GHC.IO.Types
-- Copyright   :  (c) Tamar Christina 2018
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  stable
-- Portability :  non-portable
--
-- Abstraction over C Handle types for GHC, Unix wants FD (CInt) while Windows
-- Wants Handle (CIntPtr), so we abstract over them here.
--
-------------------------------------------------------------------------------

module GHC.Event.Internal.Types
    (
    -- * Event type
      Event
    , evtRead
    , evtWrite
    , evtClose
    , evtNothing
    , eventIs
    -- * Lifetimes
    , Lifetime(..)
    , EventLifetime
    , eventLifetime
    , elLifetime
    , elEvent
    -- * Timeout type
    , 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)

-- | An I\/O event.
newtype Event = Event Int
    deriving Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
/= :: Event -> Event -> Bool
Eq -- ^ @since 4.4.0.0

evtNothing :: Event
evtNothing :: Event
evtNothing = Int -> Event
Event Int
0
{-# INLINE evtNothing #-}

-- | Data is available to be read.
evtRead :: Event
evtRead :: Event
evtRead = Int -> Event
Event Int
1
{-# INLINE evtRead #-}

-- | The file descriptor is ready to accept a write.
evtWrite :: Event
evtWrite :: Event
evtWrite = Int -> Event
Event Int
2
{-# INLINE evtWrite #-}

-- | Another thread closed the file descriptor.
evtClose :: Event
evtClose :: Event
evtClose = Int -> Event
Event Int
4
{-# INLINE evtClose #-}

eventIs :: Event -> Event -> Bool
eventIs :: Event -> Event -> Bool
eventIs (Event Int
a) (Event 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
/= Int
0

-- | @since 4.4.0.0
instance Show Event where
    show :: Event -> String
show Event
e = Char
'[' Char -> ShowS
forall a. a -> [a] -> [a]
: (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([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` String
"evtRead",
                     Event
evtWrite Event -> ShowS
`so` String
"evtWrite",
                     Event
evtClose Event -> ShowS
`so` String
"evtClose"]) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
        where Event
ev so :: Event -> ShowS
`so` String
disp | Event
e Event -> Event -> Bool
`eventIs` Event
ev = String
disp
                           | Bool
otherwise      = String
""

-- | @since 4.10.0.0
instance Semigroup Event where
    <> :: Event -> Event -> Event
(<>)    = Event -> Event -> Event
evtCombine
    stimes :: forall b. Integral b => b -> Event -> Event
stimes  = b -> Event -> Event
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesMonoid

-- | @since 4.4.0.0
instance Monoid Event where
    mempty :: Event
mempty  = Event
evtNothing
    mconcat :: [Event] -> Event
mconcat = [Event] -> Event
evtConcat

evtCombine :: Event -> Event -> Event
evtCombine :: Event -> Event -> Event
evtCombine (Event Int
a) (Event Int
b) = Int -> Event
Event (Int
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b)
{-# INLINE evtCombine #-}

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
{-# INLINE evtConcat #-}

-- | The lifetime of an event registration.
--
-- @since 4.8.1.0
data Lifetime = OneShot   -- ^ the registration will be active for only one
                          -- event
              | MultiShot -- ^ the registration will trigger multiple times
              deriving ( Int -> Lifetime -> ShowS
[Lifetime] -> ShowS
Lifetime -> String
(Int -> Lifetime -> ShowS)
-> (Lifetime -> String) -> ([Lifetime] -> ShowS) -> Show Lifetime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lifetime -> ShowS
showsPrec :: Int -> Lifetime -> ShowS
$cshow :: Lifetime -> String
show :: Lifetime -> String
$cshowList :: [Lifetime] -> ShowS
showList :: [Lifetime] -> ShowS
Show -- ^ @since 4.8.1.0
                       , Lifetime -> Lifetime -> Bool
(Lifetime -> Lifetime -> Bool)
-> (Lifetime -> Lifetime -> Bool) -> Eq Lifetime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lifetime -> Lifetime -> Bool
== :: Lifetime -> Lifetime -> Bool
$c/= :: Lifetime -> Lifetime -> Bool
/= :: Lifetime -> Lifetime -> Bool
Eq   -- ^ @since 4.8.1.0
                       )

-- | The longer of two lifetimes.
elSupremum :: Lifetime -> Lifetime -> Lifetime
elSupremum :: Lifetime -> Lifetime -> Lifetime
elSupremum Lifetime
OneShot Lifetime
OneShot = Lifetime
OneShot
elSupremum Lifetime
_       Lifetime
_       = Lifetime
MultiShot
{-# INLINE elSupremum #-}

-- | @since 4.10.0.0
instance Semigroup Lifetime where
    <> :: Lifetime -> Lifetime -> Lifetime
(<>) = Lifetime -> Lifetime -> Lifetime
elSupremum
    stimes :: forall b. Integral b => 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.0
instance Monoid Lifetime where
    mempty :: 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.
newtype EventLifetime = EL Int
                      deriving ( Int -> EventLifetime -> ShowS
[EventLifetime] -> ShowS
EventLifetime -> String
(Int -> EventLifetime -> ShowS)
-> (EventLifetime -> String)
-> ([EventLifetime] -> ShowS)
-> Show EventLifetime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventLifetime -> ShowS
showsPrec :: Int -> EventLifetime -> ShowS
$cshow :: EventLifetime -> String
show :: EventLifetime -> String
$cshowList :: [EventLifetime] -> ShowS
showList :: [EventLifetime] -> ShowS
Show -- ^ @since 4.8.0.0
                               , EventLifetime -> EventLifetime -> Bool
(EventLifetime -> EventLifetime -> Bool)
-> (EventLifetime -> EventLifetime -> Bool) -> Eq EventLifetime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventLifetime -> EventLifetime -> Bool
== :: EventLifetime -> EventLifetime -> Bool
$c/= :: EventLifetime -> EventLifetime -> Bool
/= :: EventLifetime -> EventLifetime -> Bool
Eq   -- ^ @since 4.8.0.0
                               )

-- | @since 4.11.0.0
instance Semigroup EventLifetime where
    EL Int
a <> :: EventLifetime -> EventLifetime -> EventLifetime
<> EL Int
b = Int -> EventLifetime
EL (Int
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b)

-- | @since 4.8.0.0
instance Monoid EventLifetime where
    mempty :: EventLifetime
mempty = Int -> EventLifetime
EL Int
0

eventLifetime :: Event -> Lifetime -> EventLifetime
eventLifetime :: Event -> Lifetime -> EventLifetime
eventLifetime (Event Int
e) Lifetime
l = Int -> EventLifetime
EL (Int
e Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Lifetime -> Int
forall {a}. Num a => Lifetime -> a
lifetimeBit Lifetime
l)
  where
    lifetimeBit :: Lifetime -> a
lifetimeBit Lifetime
OneShot   = a
0
    lifetimeBit Lifetime
MultiShot = a
8
{-# INLINE eventLifetime #-}

elLifetime :: EventLifetime -> Lifetime
elLifetime :: EventLifetime -> Lifetime
elLifetime (EL Int
x) = if Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
8 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Lifetime
OneShot else Lifetime
MultiShot
{-# INLINE elLifetime #-}

elEvent :: EventLifetime -> Event
elEvent :: EventLifetime -> Event
elEvent (EL Int
x) = Int -> Event
Event (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x7)
{-# INLINE elEvent #-}

-- | A type alias for timeouts, specified in nanoseconds.
data Timeout = Timeout {-# UNPACK #-} !Word64
             | Forever
               deriving Int -> Timeout -> ShowS
[Timeout] -> ShowS
Timeout -> String
(Int -> Timeout -> ShowS)
-> (Timeout -> String) -> ([Timeout] -> ShowS) -> Show Timeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Timeout -> ShowS
showsPrec :: Int -> Timeout -> ShowS
$cshow :: Timeout -> String
show :: Timeout -> String
$cshowList :: [Timeout] -> ShowS
showList :: [Timeout] -> ShowS
Show -- ^ @since 4.4.0.0