{-# 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)
import System.Posix.Types (Fd(..))
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)
    }

new :: IO E.Backend
new :: IO Backend
new = do
  KQueueFd
kqfd <- IO KQueueFd
kqueue
  Array Event
events <- forall a. Storable a => Int -> IO (Array a)
A.new Int
64
  let !be :: Backend
be = 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 -> KQueue
KQueue KQueueFd
kqfd Array Event
events)
  forall (m :: * -> *) a. Monad m => a -> m a
return Backend
be

delete :: KQueue -> IO ()
delete :: KQueue -> IO ()
delete KQueue
kq = do
  CInt
_ <- CInt -> IO CInt
c_close forall b c a. (b -> c) -> (a -> b) -> a -> c
. KQueueFd -> CInt
fromKQueueFd forall b c a. (b -> c) -> (a -> b) -> a -> c
. KQueue -> KQueueFd
kqueueFd forall a b. (a -> b) -> a -> b
$ KQueue
kq
  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
       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 = forall a. [Maybe a] -> [a]
catMaybes [ forall {a}. Event -> a -> Maybe a
check Event
E.evtRead Filter
filterRead, 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 forall a. a -> Maybe a
Just a
f else 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 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 <- forall a. Array a -> (Ptr a -> Int -> IO Int) -> IO Int
A.unsafeLoad Array Event
events 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 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

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ do
        forall a. Storable a => Array a -> (a -> IO ()) -> IO ()
A.forM_ Array Event
events forall a b. (a -> b) -> a -> b
$ \Event
e -> Fd -> Event -> IO ()
f (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 <- forall a. Array a -> IO Int
A.capacity Array Event
events
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Eq a => a -> a -> Bool
== Int
cap) forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Array a -> Int -> IO ()
A.ensureCapacity Array Event
events (Int
2 forall a. Num a => a -> a -> a
* Int
cap)
    forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
------------------------------------------------------------------------
-- FFI binding

newtype KQueueFd = KQueueFd {
      KQueueFd -> CInt
fromKQueueFd :: CInt
    } deriving ( KQueueFd -> KQueueFd -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KQueueFd -> KQueueFd -> Bool
$c/= :: KQueueFd -> KQueueFd -> Bool
== :: KQueueFd -> KQueueFd -> Bool
$c== :: KQueueFd -> KQueueFd -> Bool
Eq   -- ^ @since 4.4.0.0
               , Int -> KQueueFd -> ShowS
[KQueueFd] -> ShowS
KQueueFd -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KQueueFd] -> ShowS
$cshowList :: [KQueueFd] -> ShowS
show :: KQueueFd -> String
$cshow :: KQueueFd -> String
showsPrec :: Int -> KQueueFd -> ShowS
$cshowsPrec :: Int -> 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 140 "libraries/base/GHC/Event/KQueue.hsc" #-}
    , Event -> CIntPtr
data_  :: {-# UNPACK #-} !CIntPtr

{-# LINE 142 "libraries/base/GHC/Event/KQueue.hsc" #-}
    , udata  :: {-# UNPACK #-} !(Ptr ())
    } deriving Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> 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 = forall a b. (a -> b) -> [a] -> [b]
map (\Filter
filt -> CUIntPtr -> Filter -> Flag -> FFlag -> CIntPtr -> Ptr () -> Event
KEvent (forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd) Filter
filt Flag
flag FFlag
fflag CIntPtr
0 forall a. Ptr a
nullPtr) [Filter]
flts

-- | @since 4.3.1.0
instance Storable Event where
    sizeOf :: Event -> Int
sizeOf Event
_ = (Int
32)
{-# LINE 151 "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 -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Event
hsc_ptr Int
0) Ptr Event
ptr
{-# LINE 155 "libraries/base/GHC/Event/KQueue.hsc" #-}
        Int16
filter' <- (\Ptr Event
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Event
hsc_ptr Int
8) Ptr Event
ptr
{-# LINE 156 "libraries/base/GHC/Event/KQueue.hsc" #-}
        Word16
flags'  <- (\Ptr Event
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Event
hsc_ptr Int
10) Ptr Event
ptr
{-# LINE 157 "libraries/base/GHC/Event/KQueue.hsc" #-}
        FFlag
fflags' <- (\Ptr Event
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Event
hsc_ptr Int
12) Ptr Event
ptr
{-# LINE 158 "libraries/base/GHC/Event/KQueue.hsc" #-}
        CIntPtr
data'   <- (\Ptr Event
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Event
hsc_ptr Int
16) Ptr Event
ptr
{-# LINE 159 "libraries/base/GHC/Event/KQueue.hsc" #-}
        Ptr ()
udata'  <- (\Ptr Event
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Event
hsc_ptr Int
24) Ptr Event
ptr
{-# LINE 160 "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'
        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 -> 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 166 "libraries/base/GHC/Event/KQueue.hsc" #-}
        (\Ptr Event
hsc_ptr -> 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 167 "libraries/base/GHC/Event/KQueue.hsc" #-}
        (\Ptr Event
hsc_ptr -> 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 168 "libraries/base/GHC/Event/KQueue.hsc" #-}
        (\Ptr Event
hsc_ptr -> 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 169 "libraries/base/GHC/Event/KQueue.hsc" #-}
        (\Ptr Event
hsc_ptr -> 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 170 "libraries/base/GHC/Event/KQueue.hsc" #-}
        (\Ptr Event
hsc_ptr -> 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 171 "libraries/base/GHC/Event/KQueue.hsc" #-}

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

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

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


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

{-# LINE 187 "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 200 "libraries/base/GHC/Event/KQueue.hsc" #-}


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

{-# LINE 206 "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 214 "libraries/base/GHC/Event/KQueue.hsc" #-}
filterWrite :: Filter
filterWrite :: Filter
filterWrite  = Int16 -> Filter
Filter (-Int16
2)
{-# LINE 216 "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 225 "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 -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr TimeSpec
hsc_ptr Int
0) Ptr TimeSpec
ptr
{-# LINE 229 "libraries/base/GHC/Event/KQueue.hsc" #-}
        CLong
tv_nsec' <- (\Ptr TimeSpec
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr TimeSpec
hsc_ptr Int
8) Ptr TimeSpec
ptr
{-# LINE 230 "libraries/base/GHC/Event/KQueue.hsc" #-}
        let !ts :: TimeSpec
ts = CTime -> CLong -> TimeSpec
TimeSpec CTime
tv_sec' CLong
tv_nsec'
        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 -> 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 235 "libraries/base/GHC/Event/KQueue.hsc" #-}
        (\Ptr TimeSpec
hsc_ptr -> 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 236 "libraries/base/GHC/Event/KQueue.hsc" #-}

kqueue :: IO KQueueFd
kqueue :: IO KQueueFd
kqueue = CInt -> KQueueFd
KQueueFd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` 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 =
    forall a. TimeSpec -> (Ptr TimeSpec -> IO a) -> IO a
withTimeSpec (CTime -> CLong -> TimeSpec
TimeSpec CTime
0 CLong
0) forall a b. (a -> b) -> a -> b
$ \Ptr TimeSpec
tp ->
        forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Event]
evts 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 forall a. Ptr a
nullPtr Int
0 Ptr TimeSpec
tp
            if CInt
res forall a. Eq a => a -> a -> Bool
== -CInt
1
              then do
               Errno
err <- IO Errno
getErrno
               case Errno
err of
                 Errno
_ | Errno
err forall a. Eq a => a -> a -> Bool
== Errno
eINTR  -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                 Errno
_ | Errno
err forall a. Eq a => a -> a -> Bool
== Errno
eINVAL -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                 Errno
_ | Errno
err forall a. Eq a => a -> a -> Bool
== Errno
eNOTSUP -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                 Errno
_                 -> forall a. String -> IO a
throwErrno String
"kevent"
              else 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 =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => String -> IO a -> IO a
E.throwErrnoIfMinus1NoRetry String
"kevent" forall a b. (a -> b) -> a -> b
$
    forall a. TimeSpec -> (Ptr TimeSpec -> IO a) -> IO a
withTimeSpec TimeSpec
tm forall a b. (a -> b) -> a -> b
$ Bool
-> KQueueFd
-> Ptr Event
-> Int
-> Ptr Event
-> Int
-> Ptr TimeSpec
-> IO CInt
kevent Bool
True KQueueFd
fd 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 =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => String -> IO a -> IO a
E.throwErrnoIfMinus1NoRetry String
"kevent" forall a b. (a -> b) -> a -> b
$
    forall a. TimeSpec -> (Ptr TimeSpec -> IO a) -> IO a
withTimeSpec (CTime -> CLong -> TimeSpec
TimeSpec CTime
0 CLong
0) forall a b. (a -> b) -> a -> b
$ Bool
-> KQueueFd
-> Ptr Event
-> Int
-> Ptr Event
-> Int
-> Ptr TimeSpec
-> IO CInt
kevent Bool
False KQueueFd
fd 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chlen) Ptr Event
evs (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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chlen) Ptr Event
evs (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 forall a. Ord a => a -> a -> Bool
< CTime
0 = Ptr TimeSpec -> IO a
f forall a. Ptr a
nullPtr
  | Bool
otherwise     = forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr TimeSpec
ptr -> forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr TimeSpec
ptr TimeSpec
ts 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 (forall a. Enum a => Int -> a
toEnum Int
sec') (forall a. Enum a => Int -> a
toEnum Int
nanosec')
  where
    (Word64
sec, Word64
nanosec) = Word64
s forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
1000000000

    nanosec', sec' :: Int
    sec' :: Int
sec' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sec
    nanosec' :: Int
nanosec' = 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 forall a. Eq a => a -> a -> Bool
== (-Int16
1) = Event
E.evtRead
{-# LINE 291 "libraries/base/GHC/Event/KQueue.hsc" #-}
  | f == (-2) = E.evtWrite
{-# LINE 292 "libraries/base/GHC/Event/KQueue.hsc" #-}
  | otherwise = errorWithoutStackTrace $ "toEvent: unknown filter " ++ show f

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


{-# LINE 298 "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 308 "libraries/base/GHC/Event/KQueue.hsc" #-}


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