{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Gst.Structs.Poll.Poll' keeps track of file descriptors much like fd_set (used with
-- @/select()/@) or a struct pollfd array (used with @/poll()/@). Once created with
-- @/gst_poll_new()/@, the set can be used to wait for file descriptors to be
-- readable and\/or writable. It is possible to make this wait be controlled
-- by specifying 'P.True' for the /@controllable@/ flag when creating the set (or
-- later calling 'GI.Gst.Structs.Poll.pollSetControllable').
-- 
-- New file descriptors are added to the set using 'GI.Gst.Structs.Poll.pollAddFd', and
-- removed using 'GI.Gst.Structs.Poll.pollRemoveFd'. Controlling which file descriptors
-- should be waited for to become readable and\/or writable are done using
-- 'GI.Gst.Structs.Poll.pollFdCtlRead', 'GI.Gst.Structs.Poll.pollFdCtlWrite' and 'GI.Gst.Structs.Poll.pollFdCtlPri'.
-- 
-- Use 'GI.Gst.Structs.Poll.pollWait' to wait for the file descriptors to actually become
-- readable and\/or writable, or to timeout if no file descriptor is available
-- in time. The wait can be controlled by calling 'GI.Gst.Structs.Poll.pollRestart' and
-- 'GI.Gst.Structs.Poll.pollSetFlushing'.
-- 
-- Once the file descriptor set has been waited for, one can use
-- 'GI.Gst.Structs.Poll.pollFdHasClosed' to see if the file descriptor has been closed,
-- 'GI.Gst.Structs.Poll.pollFdHasError' to see if it has generated an error,
-- 'GI.Gst.Structs.Poll.pollFdCanRead' to see if it is possible to read from the file
-- descriptor, and 'GI.Gst.Structs.Poll.pollFdCanWrite' to see if it is possible to
-- write to it.

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Gst.Structs.Poll
    ( 

-- * Exported types
    Poll(..)                                ,
    noPoll                                  ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolvePollMethod                       ,
#endif


-- ** addFd #method:addFd#

#if defined(ENABLE_OVERLOADING)
    PollAddFdMethodInfo                     ,
#endif
    pollAddFd                               ,


-- ** fdCanRead #method:fdCanRead#

#if defined(ENABLE_OVERLOADING)
    PollFdCanReadMethodInfo                 ,
#endif
    pollFdCanRead                           ,


-- ** fdCanWrite #method:fdCanWrite#

#if defined(ENABLE_OVERLOADING)
    PollFdCanWriteMethodInfo                ,
#endif
    pollFdCanWrite                          ,


-- ** fdCtlPri #method:fdCtlPri#

#if defined(ENABLE_OVERLOADING)
    PollFdCtlPriMethodInfo                  ,
#endif
    pollFdCtlPri                            ,


-- ** fdCtlRead #method:fdCtlRead#

#if defined(ENABLE_OVERLOADING)
    PollFdCtlReadMethodInfo                 ,
#endif
    pollFdCtlRead                           ,


-- ** fdCtlWrite #method:fdCtlWrite#

#if defined(ENABLE_OVERLOADING)
    PollFdCtlWriteMethodInfo                ,
#endif
    pollFdCtlWrite                          ,


-- ** fdHasClosed #method:fdHasClosed#

#if defined(ENABLE_OVERLOADING)
    PollFdHasClosedMethodInfo               ,
#endif
    pollFdHasClosed                         ,


-- ** fdHasError #method:fdHasError#

#if defined(ENABLE_OVERLOADING)
    PollFdHasErrorMethodInfo                ,
#endif
    pollFdHasError                          ,


-- ** fdHasPri #method:fdHasPri#

#if defined(ENABLE_OVERLOADING)
    PollFdHasPriMethodInfo                  ,
#endif
    pollFdHasPri                            ,


-- ** fdIgnored #method:fdIgnored#

#if defined(ENABLE_OVERLOADING)
    PollFdIgnoredMethodInfo                 ,
#endif
    pollFdIgnored                           ,


-- ** getReadGpollfd #method:getReadGpollfd#

#if defined(ENABLE_OVERLOADING)
    PollGetReadGpollfdMethodInfo            ,
#endif
    pollGetReadGpollfd                      ,


-- ** readControl #method:readControl#

#if defined(ENABLE_OVERLOADING)
    PollReadControlMethodInfo               ,
#endif
    pollReadControl                         ,


-- ** removeFd #method:removeFd#

#if defined(ENABLE_OVERLOADING)
    PollRemoveFdMethodInfo                  ,
#endif
    pollRemoveFd                            ,


-- ** restart #method:restart#

#if defined(ENABLE_OVERLOADING)
    PollRestartMethodInfo                   ,
#endif
    pollRestart                             ,


-- ** setControllable #method:setControllable#

#if defined(ENABLE_OVERLOADING)
    PollSetControllableMethodInfo           ,
#endif
    pollSetControllable                     ,


-- ** setFlushing #method:setFlushing#

#if defined(ENABLE_OVERLOADING)
    PollSetFlushingMethodInfo               ,
#endif
    pollSetFlushing                         ,


-- ** wait #method:wait#

#if defined(ENABLE_OVERLOADING)
    PollWaitMethodInfo                      ,
#endif
    pollWait                                ,


-- ** writeControl #method:writeControl#

#if defined(ENABLE_OVERLOADING)
    PollWriteControlMethodInfo              ,
#endif
    pollWriteControl                        ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GLib.Structs.PollFD as GLib.PollFD
import {-# SOURCE #-} qualified GI.Gst.Structs.PollFD as Gst.PollFD

-- | Memory-managed wrapper type.
newtype Poll = Poll (ManagedPtr Poll)
    deriving (Poll -> Poll -> Bool
(Poll -> Poll -> Bool) -> (Poll -> Poll -> Bool) -> Eq Poll
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Poll -> Poll -> Bool
$c/= :: Poll -> Poll -> Bool
== :: Poll -> Poll -> Bool
$c== :: Poll -> Poll -> Bool
Eq)
-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance WrappedPtr Poll where
    wrappedPtrCalloc :: IO (Ptr Poll)
wrappedPtrCalloc = Ptr Poll -> IO (Ptr Poll)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Poll
forall a. Ptr a
nullPtr
    wrappedPtrCopy :: Poll -> IO Poll
wrappedPtrCopy = Poll -> IO Poll
forall (m :: * -> *) a. Monad m => a -> m a
return
    wrappedPtrFree :: Maybe (GDestroyNotify Poll)
wrappedPtrFree = Maybe (GDestroyNotify Poll)
forall a. Maybe a
Nothing

-- | A convenience alias for `Nothing` :: `Maybe` `Poll`.
noPoll :: Maybe Poll
noPoll :: Maybe Poll
noPoll = Maybe Poll
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Poll
type instance O.AttributeList Poll = PollAttributeList
type PollAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method Poll::add_fd
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd"
--           , argType = TInterface Name { namespace = "Gst" , name = "PollFD" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_add_fd" gst_poll_add_fd :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    Ptr Gst.PollFD.PollFD ->                -- fd : TInterface (Name {namespace = "Gst", name = "PollFD"})
    IO CInt

-- | Add a file descriptor to the file descriptor set.
pollAddFd ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a file descriptor set.
    -> Gst.PollFD.PollFD
    -- ^ /@fd@/: a file descriptor.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the file descriptor was successfully added to the set.
pollAddFd :: Poll -> PollFD -> m Bool
pollAddFd set :: Poll
set fd :: PollFD
fd = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    Ptr PollFD
fd' <- PollFD -> IO (Ptr PollFD)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PollFD
fd
    CInt
result <- Ptr Poll -> Ptr PollFD -> IO CInt
gst_poll_add_fd Ptr Poll
set' Ptr PollFD
fd'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    PollFD -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PollFD
fd
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PollAddFdMethodInfo
instance (signature ~ (Gst.PollFD.PollFD -> m Bool), MonadIO m) => O.MethodInfo PollAddFdMethodInfo Poll signature where
    overloadedMethod = pollAddFd

#endif

-- method Poll::fd_can_read
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd"
--           , argType = TInterface Name { namespace = "Gst" , name = "PollFD" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_fd_can_read" gst_poll_fd_can_read :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    Ptr Gst.PollFD.PollFD ->                -- fd : TInterface (Name {namespace = "Gst", name = "PollFD"})
    IO CInt

-- | Check if /@fd@/ in /@set@/ has data to be read.
pollFdCanRead ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a file descriptor set.
    -> Gst.PollFD.PollFD
    -- ^ /@fd@/: a file descriptor.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the descriptor has data to be read.
pollFdCanRead :: Poll -> PollFD -> m Bool
pollFdCanRead set :: Poll
set fd :: PollFD
fd = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    Ptr PollFD
fd' <- PollFD -> IO (Ptr PollFD)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PollFD
fd
    CInt
result <- Ptr Poll -> Ptr PollFD -> IO CInt
gst_poll_fd_can_read Ptr Poll
set' Ptr PollFD
fd'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    PollFD -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PollFD
fd
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PollFdCanReadMethodInfo
instance (signature ~ (Gst.PollFD.PollFD -> m Bool), MonadIO m) => O.MethodInfo PollFdCanReadMethodInfo Poll signature where
    overloadedMethod = pollFdCanRead

#endif

-- method Poll::fd_can_write
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd"
--           , argType = TInterface Name { namespace = "Gst" , name = "PollFD" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_fd_can_write" gst_poll_fd_can_write :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    Ptr Gst.PollFD.PollFD ->                -- fd : TInterface (Name {namespace = "Gst", name = "PollFD"})
    IO CInt

-- | Check if /@fd@/ in /@set@/ can be used for writing.
pollFdCanWrite ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a file descriptor set.
    -> Gst.PollFD.PollFD
    -- ^ /@fd@/: a file descriptor.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the descriptor can be used for writing.
pollFdCanWrite :: Poll -> PollFD -> m Bool
pollFdCanWrite set :: Poll
set fd :: PollFD
fd = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    Ptr PollFD
fd' <- PollFD -> IO (Ptr PollFD)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PollFD
fd
    CInt
result <- Ptr Poll -> Ptr PollFD -> IO CInt
gst_poll_fd_can_write Ptr Poll
set' Ptr PollFD
fd'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    PollFD -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PollFD
fd
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PollFdCanWriteMethodInfo
instance (signature ~ (Gst.PollFD.PollFD -> m Bool), MonadIO m) => O.MethodInfo PollFdCanWriteMethodInfo Poll signature where
    overloadedMethod = pollFdCanWrite

#endif

-- method Poll::fd_ctl_pri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd"
--           , argType = TInterface Name { namespace = "Gst" , name = "PollFD" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "active"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a new status." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_fd_ctl_pri" gst_poll_fd_ctl_pri :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    Ptr Gst.PollFD.PollFD ->                -- fd : TInterface (Name {namespace = "Gst", name = "PollFD"})
    CInt ->                                 -- active : TBasicType TBoolean
    IO CInt

-- | Control whether the descriptor /@fd@/ in /@set@/ will be monitored for
-- exceptional conditions (POLLPRI).
-- 
-- Not implemented on Windows (will just return 'P.False' there).
-- 
-- /Since: 1.16/
pollFdCtlPri ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a file descriptor set.
    -> Gst.PollFD.PollFD
    -- ^ /@fd@/: a file descriptor.
    -> Bool
    -- ^ /@active@/: a new status.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the descriptor was successfully updated.
pollFdCtlPri :: Poll -> PollFD -> Bool -> m Bool
pollFdCtlPri set :: Poll
set fd :: PollFD
fd active :: Bool
active = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    Ptr PollFD
fd' <- PollFD -> IO (Ptr PollFD)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PollFD
fd
    let active' :: CInt
active' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
active
    CInt
result <- Ptr Poll -> Ptr PollFD -> CInt -> IO CInt
gst_poll_fd_ctl_pri Ptr Poll
set' Ptr PollFD
fd' CInt
active'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    PollFD -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PollFD
fd
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PollFdCtlPriMethodInfo
instance (signature ~ (Gst.PollFD.PollFD -> Bool -> m Bool), MonadIO m) => O.MethodInfo PollFdCtlPriMethodInfo Poll signature where
    overloadedMethod = pollFdCtlPri

#endif

-- method Poll::fd_ctl_read
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd"
--           , argType = TInterface Name { namespace = "Gst" , name = "PollFD" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "active"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a new status." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_fd_ctl_read" gst_poll_fd_ctl_read :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    Ptr Gst.PollFD.PollFD ->                -- fd : TInterface (Name {namespace = "Gst", name = "PollFD"})
    CInt ->                                 -- active : TBasicType TBoolean
    IO CInt

-- | Control whether the descriptor /@fd@/ in /@set@/ will be monitored for
-- readability.
pollFdCtlRead ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a file descriptor set.
    -> Gst.PollFD.PollFD
    -- ^ /@fd@/: a file descriptor.
    -> Bool
    -- ^ /@active@/: a new status.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the descriptor was successfully updated.
pollFdCtlRead :: Poll -> PollFD -> Bool -> m Bool
pollFdCtlRead set :: Poll
set fd :: PollFD
fd active :: Bool
active = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    Ptr PollFD
fd' <- PollFD -> IO (Ptr PollFD)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PollFD
fd
    let active' :: CInt
active' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
active
    CInt
result <- Ptr Poll -> Ptr PollFD -> CInt -> IO CInt
gst_poll_fd_ctl_read Ptr Poll
set' Ptr PollFD
fd' CInt
active'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    PollFD -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PollFD
fd
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PollFdCtlReadMethodInfo
instance (signature ~ (Gst.PollFD.PollFD -> Bool -> m Bool), MonadIO m) => O.MethodInfo PollFdCtlReadMethodInfo Poll signature where
    overloadedMethod = pollFdCtlRead

#endif

-- method Poll::fd_ctl_write
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd"
--           , argType = TInterface Name { namespace = "Gst" , name = "PollFD" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "active"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a new status." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_fd_ctl_write" gst_poll_fd_ctl_write :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    Ptr Gst.PollFD.PollFD ->                -- fd : TInterface (Name {namespace = "Gst", name = "PollFD"})
    CInt ->                                 -- active : TBasicType TBoolean
    IO CInt

-- | Control whether the descriptor /@fd@/ in /@set@/ will be monitored for
-- writability.
pollFdCtlWrite ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a file descriptor set.
    -> Gst.PollFD.PollFD
    -- ^ /@fd@/: a file descriptor.
    -> Bool
    -- ^ /@active@/: a new status.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the descriptor was successfully updated.
pollFdCtlWrite :: Poll -> PollFD -> Bool -> m Bool
pollFdCtlWrite set :: Poll
set fd :: PollFD
fd active :: Bool
active = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    Ptr PollFD
fd' <- PollFD -> IO (Ptr PollFD)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PollFD
fd
    let active' :: CInt
active' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
active
    CInt
result <- Ptr Poll -> Ptr PollFD -> CInt -> IO CInt
gst_poll_fd_ctl_write Ptr Poll
set' Ptr PollFD
fd' CInt
active'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    PollFD -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PollFD
fd
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PollFdCtlWriteMethodInfo
instance (signature ~ (Gst.PollFD.PollFD -> Bool -> m Bool), MonadIO m) => O.MethodInfo PollFdCtlWriteMethodInfo Poll signature where
    overloadedMethod = pollFdCtlWrite

#endif

-- method Poll::fd_has_closed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd"
--           , argType = TInterface Name { namespace = "Gst" , name = "PollFD" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_fd_has_closed" gst_poll_fd_has_closed :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    Ptr Gst.PollFD.PollFD ->                -- fd : TInterface (Name {namespace = "Gst", name = "PollFD"})
    IO CInt

-- | Check if /@fd@/ in /@set@/ has closed the connection.
pollFdHasClosed ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a file descriptor set.
    -> Gst.PollFD.PollFD
    -- ^ /@fd@/: a file descriptor.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the connection was closed.
pollFdHasClosed :: Poll -> PollFD -> m Bool
pollFdHasClosed set :: Poll
set fd :: PollFD
fd = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    Ptr PollFD
fd' <- PollFD -> IO (Ptr PollFD)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PollFD
fd
    CInt
result <- Ptr Poll -> Ptr PollFD -> IO CInt
gst_poll_fd_has_closed Ptr Poll
set' Ptr PollFD
fd'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    PollFD -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PollFD
fd
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PollFdHasClosedMethodInfo
instance (signature ~ (Gst.PollFD.PollFD -> m Bool), MonadIO m) => O.MethodInfo PollFdHasClosedMethodInfo Poll signature where
    overloadedMethod = pollFdHasClosed

#endif

-- method Poll::fd_has_error
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd"
--           , argType = TInterface Name { namespace = "Gst" , name = "PollFD" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_fd_has_error" gst_poll_fd_has_error :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    Ptr Gst.PollFD.PollFD ->                -- fd : TInterface (Name {namespace = "Gst", name = "PollFD"})
    IO CInt

-- | Check if /@fd@/ in /@set@/ has an error.
pollFdHasError ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a file descriptor set.
    -> Gst.PollFD.PollFD
    -- ^ /@fd@/: a file descriptor.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the descriptor has an error.
pollFdHasError :: Poll -> PollFD -> m Bool
pollFdHasError set :: Poll
set fd :: PollFD
fd = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    Ptr PollFD
fd' <- PollFD -> IO (Ptr PollFD)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PollFD
fd
    CInt
result <- Ptr Poll -> Ptr PollFD -> IO CInt
gst_poll_fd_has_error Ptr Poll
set' Ptr PollFD
fd'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    PollFD -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PollFD
fd
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PollFdHasErrorMethodInfo
instance (signature ~ (Gst.PollFD.PollFD -> m Bool), MonadIO m) => O.MethodInfo PollFdHasErrorMethodInfo Poll signature where
    overloadedMethod = pollFdHasError

#endif

-- method Poll::fd_has_pri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd"
--           , argType = TInterface Name { namespace = "Gst" , name = "PollFD" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_fd_has_pri" gst_poll_fd_has_pri :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    Ptr Gst.PollFD.PollFD ->                -- fd : TInterface (Name {namespace = "Gst", name = "PollFD"})
    IO CInt

-- | Check if /@fd@/ in /@set@/ has an exceptional condition (POLLPRI).
-- 
-- Not implemented on Windows (will just return 'P.False' there).
-- 
-- /Since: 1.16/
pollFdHasPri ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a file descriptor set.
    -> Gst.PollFD.PollFD
    -- ^ /@fd@/: a file descriptor.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the descriptor has an exceptional condition.
pollFdHasPri :: Poll -> PollFD -> m Bool
pollFdHasPri set :: Poll
set fd :: PollFD
fd = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    Ptr PollFD
fd' <- PollFD -> IO (Ptr PollFD)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PollFD
fd
    CInt
result <- Ptr Poll -> Ptr PollFD -> IO CInt
gst_poll_fd_has_pri Ptr Poll
set' Ptr PollFD
fd'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    PollFD -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PollFD
fd
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PollFdHasPriMethodInfo
instance (signature ~ (Gst.PollFD.PollFD -> m Bool), MonadIO m) => O.MethodInfo PollFdHasPriMethodInfo Poll signature where
    overloadedMethod = pollFdHasPri

#endif

-- method Poll::fd_ignored
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd"
--           , argType = TInterface Name { namespace = "Gst" , name = "PollFD" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_fd_ignored" gst_poll_fd_ignored :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    Ptr Gst.PollFD.PollFD ->                -- fd : TInterface (Name {namespace = "Gst", name = "PollFD"})
    IO ()

-- | Mark /@fd@/ as ignored so that the next call to 'GI.Gst.Structs.Poll.pollWait' will yield
-- the same result for /@fd@/ as last time. This function must be called if no
-- operation (read\/write\/recv\/send\/etc.) will be performed on /@fd@/ before
-- the next call to 'GI.Gst.Structs.Poll.pollWait'.
-- 
-- The reason why this is needed is because the underlying implementation
-- might not allow querying the fd more than once between calls to one of
-- the re-enabling operations.
pollFdIgnored ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a file descriptor set.
    -> Gst.PollFD.PollFD
    -- ^ /@fd@/: a file descriptor.
    -> m ()
pollFdIgnored :: Poll -> PollFD -> m ()
pollFdIgnored set :: Poll
set fd :: PollFD
fd = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    Ptr PollFD
fd' <- PollFD -> IO (Ptr PollFD)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PollFD
fd
    Ptr Poll -> Ptr PollFD -> IO ()
gst_poll_fd_ignored Ptr Poll
set' Ptr PollFD
fd'
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    PollFD -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PollFD
fd
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PollFdIgnoredMethodInfo
instance (signature ~ (Gst.PollFD.PollFD -> m ()), MonadIO m) => O.MethodInfo PollFdIgnoredMethodInfo Poll signature where
    overloadedMethod = pollFdIgnored

#endif

-- XXX Could not generate method Poll::free
-- Error was : Bad introspection data: "Transferring a non-boxed struct with unknown size!"
-- method Poll::get_read_gpollfd
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPoll" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "PollFD" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GPollFD" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_get_read_gpollfd" gst_poll_get_read_gpollfd :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    Ptr GLib.PollFD.PollFD ->               -- fd : TInterface (Name {namespace = "GLib", name = "PollFD"})
    IO ()

-- | Get a GPollFD for the reading part of the control socket. This is useful when
-- integrating with a GSource and GMainLoop.
pollGetReadGpollfd ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a t'GI.Gst.Structs.Poll.Poll'
    -> GLib.PollFD.PollFD
    -- ^ /@fd@/: a t'GI.GLib.Structs.PollFD.PollFD'
    -> m ()
pollGetReadGpollfd :: Poll -> PollFD -> m ()
pollGetReadGpollfd set :: Poll
set fd :: PollFD
fd = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    Ptr PollFD
fd' <- PollFD -> IO (Ptr PollFD)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PollFD
fd
    Ptr Poll -> Ptr PollFD -> IO ()
gst_poll_get_read_gpollfd Ptr Poll
set' Ptr PollFD
fd'
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    PollFD -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PollFD
fd
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PollGetReadGpollfdMethodInfo
instance (signature ~ (GLib.PollFD.PollFD -> m ()), MonadIO m) => O.MethodInfo PollGetReadGpollfdMethodInfo Poll signature where
    overloadedMethod = pollGetReadGpollfd

#endif

-- method Poll::read_control
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPoll." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_read_control" gst_poll_read_control :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    IO CInt

-- | Read a byte from the control socket of the controllable /@set@/.
-- 
-- This function only works for timer t'GI.Gst.Structs.Poll.Poll' objects created with
-- @/gst_poll_new_timer()/@.
pollReadControl ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a t'GI.Gst.Structs.Poll.Poll'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' on success. 'P.False' when when there was no byte to read or
    -- reading the byte failed. If there was no byte to read, and only then, errno
    -- will contain EWOULDBLOCK or EAGAIN. For all other values of errno this always signals a
    -- critical error.
pollReadControl :: Poll -> m Bool
pollReadControl set :: Poll
set = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    CInt
result <- Ptr Poll -> IO CInt
gst_poll_read_control Ptr Poll
set'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PollReadControlMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo PollReadControlMethodInfo Poll signature where
    overloadedMethod = pollReadControl

#endif

-- method Poll::remove_fd
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd"
--           , argType = TInterface Name { namespace = "Gst" , name = "PollFD" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_remove_fd" gst_poll_remove_fd :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    Ptr Gst.PollFD.PollFD ->                -- fd : TInterface (Name {namespace = "Gst", name = "PollFD"})
    IO CInt

-- | Remove a file descriptor from the file descriptor set.
pollRemoveFd ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a file descriptor set.
    -> Gst.PollFD.PollFD
    -- ^ /@fd@/: a file descriptor.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the file descriptor was successfully removed from the set.
pollRemoveFd :: Poll -> PollFD -> m Bool
pollRemoveFd set :: Poll
set fd :: PollFD
fd = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    Ptr PollFD
fd' <- PollFD -> IO (Ptr PollFD)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PollFD
fd
    CInt
result <- Ptr Poll -> Ptr PollFD -> IO CInt
gst_poll_remove_fd Ptr Poll
set' Ptr PollFD
fd'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    PollFD -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PollFD
fd
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PollRemoveFdMethodInfo
instance (signature ~ (Gst.PollFD.PollFD -> m Bool), MonadIO m) => O.MethodInfo PollRemoveFdMethodInfo Poll signature where
    overloadedMethod = pollRemoveFd

#endif

-- method Poll::restart
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPoll." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_restart" gst_poll_restart :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    IO ()

-- | Restart any 'GI.Gst.Structs.Poll.pollWait' that is in progress. This function is typically
-- used after adding or removing descriptors to /@set@/.
-- 
-- If /@set@/ is not controllable, then this call will have no effect.
-- 
-- This function only works for non-timer t'GI.Gst.Structs.Poll.Poll' objects created with
-- @/gst_poll_new()/@.
pollRestart ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a t'GI.Gst.Structs.Poll.Poll'.
    -> m ()
pollRestart :: Poll -> m ()
pollRestart set :: Poll
set = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    Ptr Poll -> IO ()
gst_poll_restart Ptr Poll
set'
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PollRestartMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo PollRestartMethodInfo Poll signature where
    overloadedMethod = pollRestart

#endif

-- method Poll::set_controllable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPoll." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "controllable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new controllable state."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_set_controllable" gst_poll_set_controllable :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    CInt ->                                 -- controllable : TBasicType TBoolean
    IO CInt

-- | When /@controllable@/ is 'P.True', this function ensures that future calls to
-- 'GI.Gst.Structs.Poll.pollWait' will be affected by 'GI.Gst.Structs.Poll.pollRestart' and
-- 'GI.Gst.Structs.Poll.pollSetFlushing'.
-- 
-- This function only works for non-timer t'GI.Gst.Structs.Poll.Poll' objects created with
-- @/gst_poll_new()/@.
pollSetControllable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a t'GI.Gst.Structs.Poll.Poll'.
    -> Bool
    -- ^ /@controllable@/: new controllable state.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the controllability of /@set@/ could be updated.
pollSetControllable :: Poll -> Bool -> m Bool
pollSetControllable set :: Poll
set controllable :: Bool
controllable = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    let controllable' :: CInt
controllable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
controllable
    CInt
result <- Ptr Poll -> CInt -> IO CInt
gst_poll_set_controllable Ptr Poll
set' CInt
controllable'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PollSetControllableMethodInfo
instance (signature ~ (Bool -> m Bool), MonadIO m) => O.MethodInfo PollSetControllableMethodInfo Poll signature where
    overloadedMethod = pollSetControllable

#endif

-- method Poll::set_flushing
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPoll." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flushing"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new flushing state."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_set_flushing" gst_poll_set_flushing :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    CInt ->                                 -- flushing : TBasicType TBoolean
    IO ()

-- | When /@flushing@/ is 'P.True', this function ensures that current and future calls
-- to 'GI.Gst.Structs.Poll.pollWait' will return -1, with errno set to EBUSY.
-- 
-- Unsetting the flushing state will restore normal operation of /@set@/.
-- 
-- This function only works for non-timer t'GI.Gst.Structs.Poll.Poll' objects created with
-- @/gst_poll_new()/@.
pollSetFlushing ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a t'GI.Gst.Structs.Poll.Poll'.
    -> Bool
    -- ^ /@flushing@/: new flushing state.
    -> m ()
pollSetFlushing :: Poll -> Bool -> m ()
pollSetFlushing set :: Poll
set flushing :: Bool
flushing = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    let flushing' :: CInt
flushing' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
flushing
    Ptr Poll -> CInt -> IO ()
gst_poll_set_flushing Ptr Poll
set' CInt
flushing'
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PollSetFlushingMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.MethodInfo PollSetFlushingMethodInfo Poll signature where
    overloadedMethod = pollSetFlushing

#endif

-- method Poll::wait
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPoll." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timeout in nanoseconds."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_wait" gst_poll_wait :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    Word64 ->                               -- timeout : TBasicType TUInt64
    IO Int32

-- | Wait for activity on the file descriptors in /@set@/. This function waits up to
-- the specified /@timeout@/.  A timeout of 'GI.Gst.Constants.CLOCK_TIME_NONE' waits forever.
-- 
-- For t'GI.Gst.Structs.Poll.Poll' objects created with @/gst_poll_new()/@, this function can only be
-- called from a single thread at a time.  If called from multiple threads,
-- -1 will be returned with errno set to EPERM.
-- 
-- This is not true for timer t'GI.Gst.Structs.Poll.Poll' objects created with
-- @/gst_poll_new_timer()/@, where it is allowed to have multiple threads waiting
-- simultaneously.
pollWait ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a t'GI.Gst.Structs.Poll.Poll'.
    -> Word64
    -- ^ /@timeout@/: a timeout in nanoseconds.
    -> m Int32
    -- ^ __Returns:__ The number of t'GI.Gst.Structs.PollFD.PollFD' in /@set@/ that have activity or 0 when no
    -- activity was detected after /@timeout@/. If an error occurs, -1 is returned
    -- and errno is set.
pollWait :: Poll -> Word64 -> m Int32
pollWait set :: Poll
set timeout :: Word64
timeout = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    Int32
result <- Ptr Poll -> Word64 -> IO Int32
gst_poll_wait Ptr Poll
set' Word64
timeout
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data PollWaitMethodInfo
instance (signature ~ (Word64 -> m Int32), MonadIO m) => O.MethodInfo PollWaitMethodInfo Poll signature where
    overloadedMethod = pollWait

#endif

-- method Poll::write_control
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType = TInterface Name { namespace = "Gst" , name = "Poll" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPoll." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_poll_write_control" gst_poll_write_control :: 
    Ptr Poll ->                             -- set : TInterface (Name {namespace = "Gst", name = "Poll"})
    IO CInt

-- | Write a byte to the control socket of the controllable /@set@/.
-- This function is mostly useful for timer t'GI.Gst.Structs.Poll.Poll' objects created with
-- @/gst_poll_new_timer()/@.
-- 
-- It will make any current and future 'GI.Gst.Structs.Poll.pollWait' function return with
-- 1, meaning the control socket is set. After an equal amount of calls to
-- 'GI.Gst.Structs.Poll.pollReadControl' have been performed, calls to 'GI.Gst.Structs.Poll.pollWait' will
-- block again until their timeout expired.
-- 
-- This function only works for timer t'GI.Gst.Structs.Poll.Poll' objects created with
-- @/gst_poll_new_timer()/@.
pollWriteControl ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Poll
    -- ^ /@set@/: a t'GI.Gst.Structs.Poll.Poll'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' on success. 'P.False' when when the byte could not be written.
    -- errno contains the detailed error code but will never be EAGAIN, EINTR or
    -- EWOULDBLOCK. 'P.False' always signals a critical error.
pollWriteControl :: Poll -> m Bool
pollWriteControl set :: Poll
set = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Poll
set' <- Poll -> IO (Ptr Poll)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Poll
set
    CInt
result <- Ptr Poll -> IO CInt
gst_poll_write_control Ptr Poll
set'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Poll -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Poll
set
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PollWriteControlMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo PollWriteControlMethodInfo Poll signature where
    overloadedMethod = pollWriteControl

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolvePollMethod (t :: Symbol) (o :: *) :: * where
    ResolvePollMethod "addFd" o = PollAddFdMethodInfo
    ResolvePollMethod "fdCanRead" o = PollFdCanReadMethodInfo
    ResolvePollMethod "fdCanWrite" o = PollFdCanWriteMethodInfo
    ResolvePollMethod "fdCtlPri" o = PollFdCtlPriMethodInfo
    ResolvePollMethod "fdCtlRead" o = PollFdCtlReadMethodInfo
    ResolvePollMethod "fdCtlWrite" o = PollFdCtlWriteMethodInfo
    ResolvePollMethod "fdHasClosed" o = PollFdHasClosedMethodInfo
    ResolvePollMethod "fdHasError" o = PollFdHasErrorMethodInfo
    ResolvePollMethod "fdHasPri" o = PollFdHasPriMethodInfo
    ResolvePollMethod "fdIgnored" o = PollFdIgnoredMethodInfo
    ResolvePollMethod "readControl" o = PollReadControlMethodInfo
    ResolvePollMethod "removeFd" o = PollRemoveFdMethodInfo
    ResolvePollMethod "restart" o = PollRestartMethodInfo
    ResolvePollMethod "wait" o = PollWaitMethodInfo
    ResolvePollMethod "writeControl" o = PollWriteControlMethodInfo
    ResolvePollMethod "getReadGpollfd" o = PollGetReadGpollfdMethodInfo
    ResolvePollMethod "setControllable" o = PollSetControllableMethodInfo
    ResolvePollMethod "setFlushing" o = PollSetFlushingMethodInfo
    ResolvePollMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolvePollMethod t Poll, O.MethodInfo info Poll p) => OL.IsLabel t (Poll -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif