{-# LINE 1 "libraries/base/GHC/Event/KQueue.hsc" #-}
{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CApiFFI                    #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE Trustworthy                #-}

{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Unused LANGUAGE pragma" #-}

module GHC.Event.KQueue
    (
      new
    , available
    ) where

import qualified GHC.Event.Internal as E



{-# LINE 29 "libraries/base/GHC/Event/KQueue.hsc" #-}

import Data.Bits (Bits(..), FiniteBits(..))
import Data.Int
import Data.Maybe ( catMaybes )
import Data.Word (Word16, Word32)
import Foreign.C.Error (throwErrnoIfMinus1, eINTR, eINVAL,
                        eNOTSUP, getErrno, throwErrno)
import Foreign.C.Types
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (withArrayLen)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable (Storable(..))
import GHC.Base
import GHC.Enum (toEnum)
import GHC.Num (Num(..))
import GHC.Real (quotRem, fromIntegral)
import GHC.Show (Show(show))
import GHC.Event.Internal (Timeout(..))
import System.Posix.Internals (c_close, c_getpid)
import System.Posix.Types (Fd(..), CPid)
import qualified GHC.Event.Array as A


{-# LINE 54 "libraries/base/GHC/Event/KQueue.hsc" #-}





-- Handle brokenness on some BSD variants, notably OS X up to at least
-- 10.6.  If NOTE_EOF isn't available, we have no way to receive a
-- notification from the kernel when we reach EOF on a plain file.

{-# LINE 65 "libraries/base/GHC/Event/KQueue.hsc" #-}

available :: Bool
available :: Bool
available = Bool
True
{-# INLINE available #-}

------------------------------------------------------------------------
-- Exported interface

data KQueue = KQueue {
      KQueue -> KQueueFd
kqueueFd     :: {-# UNPACK #-} !KQueueFd
    , KQueue -> Array Event
kqueueEvents :: {-# UNPACK #-} !(A.Array Event)
    , KQueue -> CPid
kqueuePid    :: {-# UNPACK #-} !CPid -- ^ pid, used to detect forks
    }

new :: IO E.Backend
new :: IO Backend
new = do
  KQueueFd
kqfd <- IO KQueueFd
kqueue
  Array Event
events <- Int -> IO (Array Event)
forall a. Storable a => Int -> IO (Array a)
A.new Int
64
  CPid
pid <- IO CPid
c_getpid
  let !be :: Backend
be = (KQueue -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int)
-> (KQueue -> Fd -> Event -> Event -> IO Bool)
-> (KQueue -> Fd -> Event -> IO Bool)
-> (KQueue -> IO ())
-> KQueue
-> Backend
forall a.
(a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int)
-> (a -> Fd -> Event -> Event -> IO Bool)
-> (a -> Fd -> Event -> IO Bool)
-> (a -> IO ())
-> a
-> Backend
E.backend KQueue -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
poll KQueue -> Fd -> Event -> Event -> IO Bool
modifyFd KQueue -> Fd -> Event -> IO Bool
modifyFdOnce KQueue -> IO ()
delete (KQueueFd -> Array Event -> CPid -> KQueue
KQueue KQueueFd
kqfd Array Event
events CPid
pid)
  Backend -> IO Backend
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Backend
be

delete :: KQueue -> IO ()
delete :: KQueue -> IO ()
delete KQueue
kq = do
  -- detect forks: the queue isn't inherited by a child process created with
  -- fork. Hence we mustn't try to close the old fd or we might close a random
  -- one (e.g. the one used by timerfd, cf #24672).
  CPid
pid <- IO CPid
c_getpid
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CPid
pid CPid -> CPid -> Bool
forall a. Eq a => a -> a -> Bool
== KQueue -> CPid
kqueuePid KQueue
kq) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    CInt
_ <- CInt -> IO CInt
c_close (CInt -> IO CInt) -> (KQueue -> CInt) -> KQueue -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KQueueFd -> CInt
fromKQueueFd (KQueueFd -> CInt) -> (KQueue -> KQueueFd) -> KQueue -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KQueue -> KQueueFd
kqueueFd (KQueue -> IO CInt) -> KQueue -> IO CInt
forall a b. (a -> b) -> a -> b
$ KQueue
kq
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

modifyFd :: KQueue -> Fd -> E.Event -> E.Event -> IO Bool
modifyFd :: KQueue -> Fd -> Event -> Event -> IO Bool
modifyFd KQueue
kq Fd
fd Event
oevt Event
nevt = do
  KQueueFd -> [Event] -> IO Bool
kqueueControl (KQueue -> KQueueFd
kqueueFd KQueue
kq) [Event]
evs
  where
    evs :: [Event]
evs = Fd -> [Filter] -> Flag -> FFlag -> [Event]
toEvents Fd
fd (Event -> [Filter]
toFilter Event
oevt) Flag
flagDelete FFlag
noteEOF
       [Event] -> [Event] -> [Event]
forall a. Semigroup a => a -> a -> a
<> Fd -> [Filter] -> Flag -> FFlag -> [Event]
toEvents Fd
fd (Event -> [Filter]
toFilter Event
nevt) Flag
flagAdd FFlag
noteEOF

toFilter :: E.Event -> [Filter]
toFilter :: Event -> [Filter]
toFilter Event
e = [Maybe Filter] -> [Filter]
forall a. [Maybe a] -> [a]
catMaybes [ Event -> Filter -> Maybe Filter
forall {a}. Event -> a -> Maybe a
check Event
E.evtRead Filter
filterRead, Event -> Filter -> Maybe Filter
forall {a}. Event -> a -> Maybe a
check Event
E.evtWrite Filter
filterWrite ]
  where
    check :: Event -> a -> Maybe a
check Event
e' a
f = if Event
e Event -> Event -> Bool
`E.eventIs` Event
e' then a -> Maybe a
forall a. a -> Maybe a
Just a
f else Maybe a
forall a. Maybe a
Nothing

modifyFdOnce :: KQueue -> Fd -> E.Event -> IO Bool
modifyFdOnce :: KQueue -> Fd -> Event -> IO Bool
modifyFdOnce KQueue
kq Fd
fd Event
evt =
    KQueueFd -> [Event] -> IO Bool
kqueueControl (KQueue -> KQueueFd
kqueueFd KQueue
kq) (Fd -> [Filter] -> Flag -> FFlag -> [Event]
toEvents Fd
fd (Event -> [Filter]
toFilter Event
evt) (Flag
flagAdd Flag -> Flag -> Flag
forall a. Bits a => a -> a -> a
.|. Flag
flagOneshot) FFlag
noteEOF)

poll :: KQueue
     -> Maybe Timeout
     -> (Fd -> E.Event -> IO ())
     -> IO Int
poll :: KQueue -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
poll KQueue
kq Maybe Timeout
mtimeout Fd -> Event -> IO ()
f = do
    let events :: Array Event
events = KQueue -> Array Event
kqueueEvents KQueue
kq
        fd :: KQueueFd
fd = KQueue -> KQueueFd
kqueueFd KQueue
kq

    Int
n <- Array Event -> (Ptr Event -> Int -> IO Int) -> IO Int
forall a. Array a -> (Ptr a -> Int -> IO Int) -> IO Int
A.unsafeLoad Array Event
events ((Ptr Event -> Int -> IO Int) -> IO Int)
-> (Ptr Event -> Int -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Event
es Int
cap -> case Maybe Timeout
mtimeout of
      Just Timeout
timeout -> KQueueFd -> Ptr Event -> Int -> TimeSpec -> IO Int
kqueueWait KQueueFd
fd Ptr Event
es Int
cap (TimeSpec -> IO Int) -> TimeSpec -> IO Int
forall a b. (a -> b) -> a -> b
$ Timeout -> TimeSpec
fromTimeout Timeout
timeout
      Maybe Timeout
Nothing      -> KQueueFd -> Ptr Event -> Int -> IO Int
kqueueWaitNonBlock KQueueFd
fd Ptr Event
es Int
cap

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Array Event -> (Event -> IO ()) -> IO ()
forall a. Storable a => Array a -> (a -> IO ()) -> IO ()
A.forM_ Array Event
events ((Event -> IO ()) -> IO ()) -> (Event -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Event
e -> Fd -> Event -> IO ()
f (CUIntPtr -> Fd
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Event -> CUIntPtr
ident Event
e)) (Filter -> Event
toEvent (Event -> Filter
filter Event
e))
        Int
cap <- Array Event -> IO Int
forall a. Array a -> IO Int
A.capacity Array Event
events
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cap) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Array Event -> Int -> IO ()
forall a. Storable a => Array a -> Int -> IO ()
A.ensureCapacity Array Event
events (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cap)
    Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
------------------------------------------------------------------------
-- FFI binding

newtype KQueueFd = KQueueFd {
      KQueueFd -> CInt
fromKQueueFd :: CInt
    } deriving ( KQueueFd -> KQueueFd -> Bool
(KQueueFd -> KQueueFd -> Bool)
-> (KQueueFd -> KQueueFd -> Bool) -> Eq KQueueFd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KQueueFd -> KQueueFd -> Bool
== :: KQueueFd -> KQueueFd -> Bool
$c/= :: KQueueFd -> KQueueFd -> Bool
/= :: KQueueFd -> KQueueFd -> Bool
Eq   -- ^ @since 4.4.0.0
               , Int -> KQueueFd -> ShowS
[KQueueFd] -> ShowS
KQueueFd -> String
(Int -> KQueueFd -> ShowS)
-> (KQueueFd -> String) -> ([KQueueFd] -> ShowS) -> Show KQueueFd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KQueueFd -> ShowS
showsPrec :: Int -> KQueueFd -> ShowS
$cshow :: KQueueFd -> String
show :: KQueueFd -> String
$cshowList :: [KQueueFd] -> ShowS
showList :: [KQueueFd] -> ShowS
Show -- ^ @since 4.4.0.0
               )

data Event = KEvent {
      Event -> CUIntPtr
ident  :: {-# UNPACK #-} !CUIntPtr
    , Event -> Filter
filter :: {-# UNPACK #-} !Filter
    , Event -> Flag
flags  :: {-# UNPACK #-} !Flag
    , Event -> FFlag
fflags :: {-# UNPACK #-} !FFlag

{-# LINE 147 "libraries/base/GHC/Event/KQueue.hsc" #-}
    , Event -> CIntPtr
data_  :: {-# UNPACK #-} !CIntPtr

{-# LINE 149 "libraries/base/GHC/Event/KQueue.hsc" #-}
    , udata  :: {-# UNPACK #-} !(Ptr ())
    } deriving Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> String
show :: Event -> String
$cshowList :: [Event] -> ShowS
showList :: [Event] -> ShowS
Show -- ^ @since 4.4.0.0

toEvents :: Fd -> [Filter] -> Flag -> FFlag -> [Event]
toEvents :: Fd -> [Filter] -> Flag -> FFlag -> [Event]
toEvents Fd
fd [Filter]
flts Flag
flag FFlag
fflag = (Filter -> Event) -> [Filter] -> [Event]
forall a b. (a -> b) -> [a] -> [b]
map (\Filter
filt -> CUIntPtr -> Filter -> Flag -> FFlag -> CIntPtr -> Ptr () -> Event
KEvent (Fd -> CUIntPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd) Filter
filt Flag
flag FFlag
fflag CIntPtr
0 Ptr ()
forall a. Ptr a
nullPtr) [Filter]
flts

-- | @since 4.3.1.0
instance Storable Event where
    sizeOf :: Event -> Int
sizeOf Event
_ = (Int
64)
{-# LINE 158 "libraries/base/GHC/Event/KQueue.hsc" #-}
    alignment _ = alignment (undefined :: CInt)

    peek :: Ptr Event -> IO Event
peek Ptr Event
ptr = do
        CUIntPtr
ident'  <- (\Ptr Event
hsc_ptr -> Ptr Event -> Int -> IO CUIntPtr
forall b. Ptr b -> Int -> IO CUIntPtr
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Event
hsc_ptr Int
0) Ptr Event
ptr
{-# LINE 162 "libraries/base/GHC/Event/KQueue.hsc" #-}
        Int16
filter' <- (\Ptr Event
hsc_ptr -> Ptr Event -> Int -> IO Int16
forall b. Ptr b -> Int -> IO Int16
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Event
hsc_ptr Int
8) Ptr Event
ptr
{-# LINE 163 "libraries/base/GHC/Event/KQueue.hsc" #-}
        Word16
flags'  <- (\Ptr Event
hsc_ptr -> Ptr Event -> Int -> IO Word16
forall b. Ptr b -> Int -> IO Word16
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Event
hsc_ptr Int
10) Ptr Event
ptr
{-# LINE 164 "libraries/base/GHC/Event/KQueue.hsc" #-}
        FFlag
fflags' <- (\Ptr Event
hsc_ptr -> Ptr Event -> Int -> IO FFlag
forall b. Ptr b -> Int -> IO FFlag
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Event
hsc_ptr Int
12) Ptr Event
ptr
{-# LINE 165 "libraries/base/GHC/Event/KQueue.hsc" #-}
        CIntPtr
data'   <- (\Ptr Event
hsc_ptr -> Ptr Event -> Int -> IO CIntPtr
forall b. Ptr b -> Int -> IO CIntPtr
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Event
hsc_ptr Int
16) Ptr Event
ptr
{-# LINE 166 "libraries/base/GHC/Event/KQueue.hsc" #-}
        Ptr ()
udata'  <- (\Ptr Event
hsc_ptr -> Ptr Event -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Event
hsc_ptr Int
24) Ptr Event
ptr
{-# LINE 167 "libraries/base/GHC/Event/KQueue.hsc" #-}
        let !ev :: Event
ev = CUIntPtr -> Filter -> Flag -> FFlag -> CIntPtr -> Ptr () -> Event
KEvent CUIntPtr
ident' (Int16 -> Filter
Filter Int16
filter') (Word16 -> Flag
Flag Word16
flags') FFlag
fflags' CIntPtr
data'
                         Ptr ()
udata'
        Event -> IO Event
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Event
ev

    poke :: Ptr Event -> Event -> IO ()
poke Ptr Event
ptr Event
ev = do
        (\Ptr Event
hsc_ptr -> Ptr Event -> Int -> CUIntPtr -> IO ()
forall b. Ptr b -> Int -> CUIntPtr -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Event
hsc_ptr Int
0) Ptr Event
ptr (Event -> CUIntPtr
ident Event
ev)
{-# LINE 173 "libraries/base/GHC/Event/KQueue.hsc" #-}
        (\Ptr Event
hsc_ptr -> Ptr Event -> Int -> Filter -> IO ()
forall b. Ptr b -> Int -> Filter -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Event
hsc_ptr Int
8) Ptr Event
ptr (Event -> Filter
filter Event
ev)
{-# LINE 174 "libraries/base/GHC/Event/KQueue.hsc" #-}
        (\Ptr Event
hsc_ptr -> Ptr Event -> Int -> Flag -> IO ()
forall b. Ptr b -> Int -> Flag -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Event
hsc_ptr Int
10) Ptr Event
ptr (Event -> Flag
flags Event
ev)
{-# LINE 175 "libraries/base/GHC/Event/KQueue.hsc" #-}
        (\Ptr Event
hsc_ptr -> Ptr Event -> Int -> FFlag -> IO ()
forall b. Ptr b -> Int -> FFlag -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Event
hsc_ptr Int
12) Ptr Event
ptr (Event -> FFlag
fflags Event
ev)
{-# LINE 176 "libraries/base/GHC/Event/KQueue.hsc" #-}
        (\Ptr Event
hsc_ptr -> Ptr Event -> Int -> CIntPtr -> IO ()
forall b. Ptr b -> Int -> CIntPtr -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Event
hsc_ptr Int
16) Ptr Event
ptr (Event -> CIntPtr
data_ Event
ev)
{-# LINE 177 "libraries/base/GHC/Event/KQueue.hsc" #-}
        (\Ptr Event
hsc_ptr -> Ptr Event -> Int -> Ptr () -> IO ()
forall b. Ptr b -> Int -> Ptr () -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Event
hsc_ptr Int
24) Ptr Event
ptr (Event -> Ptr ()
udata Event
ev)
{-# LINE 178 "libraries/base/GHC/Event/KQueue.hsc" #-}

newtype FFlag = FFlag Word32
    deriving ( FFlag -> FFlag -> Bool
(FFlag -> FFlag -> Bool) -> (FFlag -> FFlag -> Bool) -> Eq FFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FFlag -> FFlag -> Bool
== :: FFlag -> FFlag -> Bool
$c/= :: FFlag -> FFlag -> Bool
/= :: FFlag -> FFlag -> Bool
Eq       -- ^ @since 4.4.0.0
             , Int -> FFlag -> ShowS
[FFlag] -> ShowS
FFlag -> String
(Int -> FFlag -> ShowS)
-> (FFlag -> String) -> ([FFlag] -> ShowS) -> Show FFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FFlag -> ShowS
showsPrec :: Int -> FFlag -> ShowS
$cshow :: FFlag -> String
show :: FFlag -> String
$cshowList :: [FFlag] -> ShowS
showList :: [FFlag] -> ShowS
Show     -- ^ @since 4.4.0.0
             , Ptr FFlag -> IO FFlag
Ptr FFlag -> Int -> IO FFlag
Ptr FFlag -> Int -> FFlag -> IO ()
Ptr FFlag -> FFlag -> IO ()
FFlag -> Int
(FFlag -> Int)
-> (FFlag -> Int)
-> (Ptr FFlag -> Int -> IO FFlag)
-> (Ptr FFlag -> Int -> FFlag -> IO ())
-> (forall b. Ptr b -> Int -> IO FFlag)
-> (forall b. Ptr b -> Int -> FFlag -> IO ())
-> (Ptr FFlag -> IO FFlag)
-> (Ptr FFlag -> FFlag -> IO ())
-> Storable FFlag
forall b. Ptr b -> Int -> IO FFlag
forall b. Ptr b -> Int -> FFlag -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: FFlag -> Int
sizeOf :: FFlag -> Int
$calignment :: FFlag -> Int
alignment :: FFlag -> Int
$cpeekElemOff :: Ptr FFlag -> Int -> IO FFlag
peekElemOff :: Ptr FFlag -> Int -> IO FFlag
$cpokeElemOff :: Ptr FFlag -> Int -> FFlag -> IO ()
pokeElemOff :: Ptr FFlag -> Int -> FFlag -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO FFlag
peekByteOff :: forall b. Ptr b -> Int -> IO FFlag
$cpokeByteOff :: forall b. Ptr b -> Int -> FFlag -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> FFlag -> IO ()
$cpeek :: Ptr FFlag -> IO FFlag
peek :: Ptr FFlag -> IO FFlag
$cpoke :: Ptr FFlag -> FFlag -> IO ()
poke :: Ptr FFlag -> FFlag -> IO ()
Storable -- ^ @since 4.4.0.0
             )

noteEOF  :: FFlag
noteEOF :: FFlag
noteEOF  = Word32 -> FFlag
FFlag Word32
0

{-# LINE 188 "libraries/base/GHC/Event/KQueue.hsc" #-}


{-# LINE 192 "libraries/base/GHC/Event/KQueue.hsc" #-}
newtype Flag = Flag Word16

{-# LINE 194 "libraries/base/GHC/Event/KQueue.hsc" #-}
    deriving ( Bits       -- ^ @since 4.7.0.0
             , FiniteBits -- ^ @since 4.7.0.0
             , Eq         -- ^ @since 4.4.0.0
             , Num        -- ^ @since 4.7.0.0
             , Show       -- ^ @since 4.4.0.0
             , Storable   -- ^ @since 4.4.0.0
             )

flagAdd      :: Flag
flagAdd :: Flag
flagAdd      = Word16 -> Flag
Flag Word16
1
flagDelete   :: Flag
flagDelete :: Flag
flagDelete   = Word16 -> Flag
Flag Word16
2
flagOneshot  :: Flag
flagOneshot :: Flag
flagOneshot  = Word16 -> Flag
Flag Word16
16

{-# LINE 207 "libraries/base/GHC/Event/KQueue.hsc" #-}


{-# LINE 211 "libraries/base/GHC/Event/KQueue.hsc" #-}
newtype Filter = Filter Int16

{-# LINE 213 "libraries/base/GHC/Event/KQueue.hsc" #-}
    deriving ( Eq       -- ^ @since 4.4.0.0
             , Num      -- ^ @since 4.4.0.0
             , Show     -- ^ @since 4.4.0.0
             , Storable -- ^ @since 4.4.0.0
             )

filterRead :: Filter
filterRead :: Filter
filterRead = Int16 -> Filter
Filter (-Int16
1)
{-# LINE 221 "libraries/base/GHC/Event/KQueue.hsc" #-}
filterWrite :: Filter
filterWrite :: Filter
filterWrite  = Int16 -> Filter
Filter (-Int16
2)
{-# LINE 223 "libraries/base/GHC/Event/KQueue.hsc" #-}

data TimeSpec = TimeSpec {
      TimeSpec -> CTime
tv_sec  :: {-# UNPACK #-} !CTime
    , TimeSpec -> CLong
tv_nsec :: {-# UNPACK #-} !CLong
    }

-- | @since 4.3.1.0
instance Storable TimeSpec where
    sizeOf :: TimeSpec -> Int
sizeOf TimeSpec
_ = (Int
16)
{-# LINE 232 "libraries/base/GHC/Event/KQueue.hsc" #-}
    alignment _ = alignment (undefined :: CInt)

    peek :: Ptr TimeSpec -> IO TimeSpec
peek Ptr TimeSpec
ptr = do
        CTime
tv_sec'  <- (\Ptr TimeSpec
hsc_ptr -> Ptr TimeSpec -> Int -> IO CTime
forall b. Ptr b -> Int -> IO CTime
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr TimeSpec
hsc_ptr Int
0) Ptr TimeSpec
ptr
{-# LINE 236 "libraries/base/GHC/Event/KQueue.hsc" #-}
        CLong
tv_nsec' <- (\Ptr TimeSpec
hsc_ptr -> Ptr TimeSpec -> Int -> IO CLong
forall b. Ptr b -> Int -> IO CLong
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr TimeSpec
hsc_ptr Int
8) Ptr TimeSpec
ptr
{-# LINE 237 "libraries/base/GHC/Event/KQueue.hsc" #-}
        let !ts :: TimeSpec
ts = CTime -> CLong -> TimeSpec
TimeSpec CTime
tv_sec' CLong
tv_nsec'
        TimeSpec -> IO TimeSpec
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeSpec
ts

    poke :: Ptr TimeSpec -> TimeSpec -> IO ()
poke Ptr TimeSpec
ptr TimeSpec
ts = do
        (\Ptr TimeSpec
hsc_ptr -> Ptr TimeSpec -> Int -> CTime -> IO ()
forall b. Ptr b -> Int -> CTime -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TimeSpec
hsc_ptr Int
0) Ptr TimeSpec
ptr (TimeSpec -> CTime
tv_sec TimeSpec
ts)
{-# LINE 242 "libraries/base/GHC/Event/KQueue.hsc" #-}
        (\Ptr TimeSpec
hsc_ptr -> Ptr TimeSpec -> Int -> CLong -> IO ()
forall b. Ptr b -> Int -> CLong -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TimeSpec
hsc_ptr Int
8) Ptr TimeSpec
ptr (TimeSpec -> CLong
tv_nsec TimeSpec
ts)
{-# LINE 243 "libraries/base/GHC/Event/KQueue.hsc" #-}

kqueue :: IO KQueueFd
kqueue :: IO KQueueFd
kqueue = CInt -> KQueueFd
KQueueFd (CInt -> KQueueFd) -> IO CInt -> IO KQueueFd
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"kqueue" IO CInt
c_kqueue

kqueueControl :: KQueueFd -> [Event] -> IO Bool
kqueueControl :: KQueueFd -> [Event] -> IO Bool
kqueueControl KQueueFd
kfd [Event]
evts =
    TimeSpec -> (Ptr TimeSpec -> IO Bool) -> IO Bool
forall a. TimeSpec -> (Ptr TimeSpec -> IO a) -> IO a
withTimeSpec (CTime -> CLong -> TimeSpec
TimeSpec CTime
0 CLong
0) ((Ptr TimeSpec -> IO Bool) -> IO Bool)
-> (Ptr TimeSpec -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr TimeSpec
tp ->
        [Event] -> (Int -> Ptr Event -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Event]
evts ((Int -> Ptr Event -> IO Bool) -> IO Bool)
-> (Int -> Ptr Event -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Int
evlen Ptr Event
evp -> do
            CInt
res <- Bool
-> KQueueFd
-> Ptr Event
-> Int
-> Ptr Event
-> Int
-> Ptr TimeSpec
-> IO CInt
kevent Bool
False KQueueFd
kfd Ptr Event
evp Int
evlen Ptr Event
forall a. Ptr a
nullPtr Int
0 Ptr TimeSpec
tp
            if CInt
res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== -CInt
1
              then do
               Errno
err <- IO Errno
getErrno
               case Errno
err of
                 Errno
_ | Errno
err Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eINTR  -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                 Errno
_ | Errno
err Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eINVAL -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                 Errno
_ | Errno
err Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eNOTSUP -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                 Errno
_                 -> String -> IO Bool
forall a. String -> IO a
throwErrno String
"kevent"
              else Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

kqueueWait :: KQueueFd -> Ptr Event -> Int -> TimeSpec -> IO Int
kqueueWait :: KQueueFd -> Ptr Event -> Int -> TimeSpec -> IO Int
kqueueWait KQueueFd
fd Ptr Event
es Int
cap TimeSpec
tm =
    (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
E.throwErrnoIfMinus1NoRetry String
"kevent" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
    TimeSpec -> (Ptr TimeSpec -> IO CInt) -> IO CInt
forall a. TimeSpec -> (Ptr TimeSpec -> IO a) -> IO a
withTimeSpec TimeSpec
tm ((Ptr TimeSpec -> IO CInt) -> IO CInt)
-> (Ptr TimeSpec -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Bool
-> KQueueFd
-> Ptr Event
-> Int
-> Ptr Event
-> Int
-> Ptr TimeSpec
-> IO CInt
kevent Bool
True KQueueFd
fd Ptr Event
forall a. Ptr a
nullPtr Int
0 Ptr Event
es Int
cap

kqueueWaitNonBlock :: KQueueFd -> Ptr Event -> Int -> IO Int
kqueueWaitNonBlock :: KQueueFd -> Ptr Event -> Int -> IO Int
kqueueWaitNonBlock KQueueFd
fd Ptr Event
es Int
cap =
    (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
E.throwErrnoIfMinus1NoRetry String
"kevent" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
    TimeSpec -> (Ptr TimeSpec -> IO CInt) -> IO CInt
forall a. TimeSpec -> (Ptr TimeSpec -> IO a) -> IO a
withTimeSpec (CTime -> CLong -> TimeSpec
TimeSpec CTime
0 CLong
0) ((Ptr TimeSpec -> IO CInt) -> IO CInt)
-> (Ptr TimeSpec -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Bool
-> KQueueFd
-> Ptr Event
-> Int
-> Ptr Event
-> Int
-> Ptr TimeSpec
-> IO CInt
kevent Bool
False KQueueFd
fd Ptr Event
forall a. Ptr a
nullPtr Int
0 Ptr Event
es Int
cap

-- TODO: We cannot retry on EINTR as the timeout would be wrong.
-- Perhaps we should just return without calling any callbacks.
kevent :: Bool -> KQueueFd -> Ptr Event -> Int -> Ptr Event -> Int -> Ptr TimeSpec
       -> IO CInt
kevent :: Bool
-> KQueueFd
-> Ptr Event
-> Int
-> Ptr Event
-> Int
-> Ptr TimeSpec
-> IO CInt
kevent Bool
safe KQueueFd
k Ptr Event
chs Int
chlen Ptr Event
evs Int
evlen Ptr TimeSpec
ts
  | Bool
safe      = KQueueFd
-> Ptr Event
-> CInt
-> Ptr Event
-> CInt
-> Ptr TimeSpec
-> IO CInt
c_kevent KQueueFd
k Ptr Event
chs (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chlen) Ptr Event
evs (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
evlen) Ptr TimeSpec
ts
  | Bool
otherwise = KQueueFd
-> Ptr Event
-> CInt
-> Ptr Event
-> CInt
-> Ptr TimeSpec
-> IO CInt
c_kevent_unsafe KQueueFd
k Ptr Event
chs (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chlen) Ptr Event
evs (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
evlen) Ptr TimeSpec
ts

withTimeSpec :: TimeSpec -> (Ptr TimeSpec -> IO a) -> IO a
withTimeSpec :: forall a. TimeSpec -> (Ptr TimeSpec -> IO a) -> IO a
withTimeSpec TimeSpec
ts Ptr TimeSpec -> IO a
f
  | TimeSpec -> CTime
tv_sec TimeSpec
ts CTime -> CTime -> Bool
forall a. Ord a => a -> a -> Bool
< CTime
0 = Ptr TimeSpec -> IO a
f Ptr TimeSpec
forall a. Ptr a
nullPtr
  | Bool
otherwise     = (Ptr TimeSpec -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TimeSpec -> IO a) -> IO a) -> (Ptr TimeSpec -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr TimeSpec
ptr -> Ptr TimeSpec -> TimeSpec -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr TimeSpec
ptr TimeSpec
ts IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr TimeSpec -> IO a
f Ptr TimeSpec
ptr

fromTimeout :: Timeout -> TimeSpec
fromTimeout :: Timeout -> TimeSpec
fromTimeout Timeout
Forever     = CTime -> CLong -> TimeSpec
TimeSpec (-CTime
1) (-CLong
1)
fromTimeout (Timeout Word64
s) = CTime -> CLong -> TimeSpec
TimeSpec (Int -> CTime
forall a. Enum a => Int -> a
toEnum Int
sec') (Int -> CLong
forall a. Enum a => Int -> a
toEnum Int
nanosec')
  where
    (Word64
sec, Word64
nanosec) = Word64
s Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
1000000000

    nanosec', sec' :: Int
    sec' :: Int
sec' = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sec
    nanosec' :: Int
nanosec' = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
nanosec

toEvent :: Filter -> E.Event
toEvent :: Filter -> Event
toEvent (Filter Int16
f)
  | Int16
f Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int16
1) = Event
E.evtRead
{-# LINE 298 "libraries/base/GHC/Event/KQueue.hsc" #-}
  | f == (-2) = E.evtWrite
{-# LINE 299 "libraries/base/GHC/Event/KQueue.hsc" #-}
  | otherwise = errorWithoutStackTrace $ "toEvent: unknown filter " ++ show f

foreign import ccall unsafe "kqueue"
    c_kqueue :: IO CInt


{-# LINE 305 "libraries/base/GHC/Event/KQueue.hsc" #-}
foreign import capi safe "sys/event.h kevent"
    c_kevent :: KQueueFd -> Ptr Event -> CInt -> Ptr Event -> CInt
             -> Ptr TimeSpec -> IO CInt

foreign import ccall unsafe "kevent"
    c_kevent_unsafe :: KQueueFd -> Ptr Event -> CInt -> Ptr Event -> CInt
                    -> Ptr TimeSpec -> IO CInt

{-# LINE 315 "libraries/base/GHC/Event/KQueue.hsc" #-}


{-# LINE 317 "libraries/base/GHC/Event/KQueue.hsc" #-}