    {-# LANGUAGE Unsafe #-}
    {-# LANGUAGE ExistentialQuantification, NoImplicitPrelude #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE UnboxedTuples #-}

    module GHC.Event.Internal
        (
        -- * Event back end
          Backend
        , backend
        , delete
        , poll
        , modifyFd
        , modifyFdOnce
        , module GHC.Event.Internal.Types
        -- * Helpers
        , throwErrnoIfMinus1NoRetry

        -- Atomic ptr exchange for WinIO
        , exchangePtr
        ) where

    import Foreign.C.Error (eINTR, getErrno, throwErrno)
    import System.Posix.Types (Fd)
    import GHC.Base
    import GHC.Num (Num(..))
    import GHC.Event.Internal.Types

    import GHC.Ptr (Ptr(..))

    -- | Event notification backend.
    data Backend = forall a. 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
                  -> IO Int

        -- | 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)
                      -> IO Bool

        -- | 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
                             -> IO Bool

        , ()
    _beDelete :: a -> IO ()
        }

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

    poll :: Backend -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
    poll :: Backend -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
    poll (Backend a
    bState a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
    bPoll a -> Fd -> Event -> Event -> IO Bool
    _ a -> Fd -> Event -> IO Bool
    _ a -> IO ()
    _) = a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
    bPoll a
    bState
    {-# INLINE poll #-}

    -- | 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 -> IO Bool
    modifyFd :: Backend -> Fd -> Event -> Event -> IO Bool
    modifyFd (Backend a
    bState a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
    _ a -> Fd -> Event -> Event -> IO Bool
    bModifyFd a -> Fd -> Event -> IO Bool
    _ a -> IO ()
    _) = a -> Fd -> Event -> Event -> IO Bool
    bModifyFd a
    bState
    {-# INLINE modifyFd #-}

    -- | 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 -> IO Bool
    modifyFdOnce :: Backend -> Fd -> Event -> IO Bool
    modifyFdOnce (Backend a
    bState a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
    _ a -> Fd -> Event -> Event -> IO Bool
    _ a -> Fd -> Event -> IO Bool
    bModifyFdOnce a -> IO ()
    _) = a -> Fd -> Event -> IO Bool
    bModifyFdOnce a
    bState
    {-# INLINE modifyFdOnce #-}

    delete :: Backend -> IO ()
    delete :: Backend -> IO ()
    delete (Backend a
    bState a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
    _ a -> Fd -> Event -> Event -> IO Bool
    _ a -> Fd -> Event -> IO Bool
    _ a -> IO ()
    bDelete) = a -> IO ()
    bDelete a
    bState
    {-# INLINE delete #-}

    -- | 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 :: (Eq a, Num a) => String -> IO a -> IO a
    throwErrnoIfMinus1NoRetry :: forall a. (Eq a, Num a) => String -> IO a -> IO a
    throwErrnoIfMinus1NoRetry String
    loc IO a
    f = do
        a
    res <- IO a
    f
        if a
    res a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == -a
    1
            then do
                Errno
    err <- IO Errno
    getErrno
                if Errno
    err Errno -> Errno -> Bool
    forall a. Eq a => a -> a -> Bool
    == Errno
    eINTR then a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    0 else String -> IO a
    forall a. String -> IO a
    throwErrno String
    loc
            else a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    res

    {-# INLINE exchangePtr #-}
    -- | @exchangePtr pptr x@ swaps the pointer pointed to by @pptr@ with the value
    -- @x@, returning the old value.
    exchangePtr :: Ptr (Ptr a) -> Ptr a -> IO (Ptr a)
    exchangePtr :: forall a. Ptr (Ptr a) -> Ptr a -> IO (Ptr a)
    exchangePtr (Ptr Addr#
    dst) (Ptr Addr#
    val) =
      (State# RealWorld -> (# State# RealWorld, Ptr a #)) -> IO (Ptr a)
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
    IO ((State# RealWorld -> (# State# RealWorld, Ptr a #)) -> IO (Ptr a))
    -> (State# RealWorld -> (# State# RealWorld, Ptr a #))
    -> IO (Ptr a)
    forall a b. (a -> b) -> a -> b
    $ \State# RealWorld
    s ->
          case (Addr# -> Addr# -> State# RealWorld -> (# State# RealWorld, Addr# #)
    forall d. Addr# -> Addr# -> State# d -> (# State# d, Addr# #)
    atomicExchangeAddrAddr# Addr#
    dst Addr#
    val State# RealWorld
    s) of
            (# State# RealWorld
    s2, Addr#
    old_val #) -> (# State# RealWorld
    s2, Addr# -> Ptr a
    forall a. Addr# -> Ptr a
    Ptr Addr#
    old_val #)