{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Manages a set of pads that operate in collect mode. This means that control
-- is given to the manager of this object when all pads have data.
-- 
--   * Collectpads are created with 'GI.GstBase.Objects.CollectPads.collectPadsNew'. A callback should then
--     be installed with gst_collect_pads_set_function ().
-- 
--   * Pads are added to the collection with 'GI.GstBase.Objects.CollectPads.collectPadsAddPad'\/
--     'GI.GstBase.Objects.CollectPads.collectPadsRemovePad'. The pad has to be a sinkpad. When added,
--     the chain, event and query functions of the pad are overridden. The
--     element_private of the pad is used to store private information for the
--     collectpads.
-- 
--   * For each pad, data is queued in the _chain function or by
--     performing a pull_range.
-- 
--   * When data is queued on all pads in waiting mode, the callback function is called.
-- 
--   * Data can be dequeued from the pad with the 'GI.GstBase.Objects.CollectPads.collectPadsPop' method.
--     One can peek at the data with the 'GI.GstBase.Objects.CollectPads.collectPadsPeek' function.
--     These functions will return 'P.Nothing' if the pad received an EOS event. When all
--     pads return 'P.Nothing' from a 'GI.GstBase.Objects.CollectPads.collectPadsPeek', the element can emit an EOS
--     event itself.
-- 
--   * Data can also be dequeued in byte units using the 'GI.GstBase.Objects.CollectPads.collectPadsAvailable',
--     'GI.GstBase.Objects.CollectPads.collectPadsReadBuffer' and 'GI.GstBase.Objects.CollectPads.collectPadsFlush' calls.
-- 
--   * Elements should call 'GI.GstBase.Objects.CollectPads.collectPadsStart' and 'GI.GstBase.Objects.CollectPads.collectPadsStop' in
--     their state change functions to start and stop the processing of the collectpads.
--     The 'GI.GstBase.Objects.CollectPads.collectPadsStop' call should be called before calling the parent
--     element state change function in the PAUSED_TO_READY state change to ensure
--     no pad is blocked and the element can finish streaming.
-- 
--   * 'GI.GstBase.Objects.CollectPads.collectPadsSetWaiting' sets a pad to waiting or non-waiting mode.
--     CollectPads element is not waiting for data to be collected on non-waiting pads.
--     Thus these pads may but need not have data when the callback is called.
--     All pads are in waiting mode by default.

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

module GI.GstBase.Objects.CollectPads
    ( 

-- * Exported types
    CollectPads(..)                         ,
    IsCollectPads                           ,
    toCollectPads                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveCollectPadsMethod                ,
#endif


-- ** addPad #method:addPad#

#if defined(ENABLE_OVERLOADING)
    CollectPadsAddPadMethodInfo             ,
#endif
    collectPadsAddPad                       ,


-- ** available #method:available#

#if defined(ENABLE_OVERLOADING)
    CollectPadsAvailableMethodInfo          ,
#endif
    collectPadsAvailable                    ,


-- ** clipRunningTime #method:clipRunningTime#

#if defined(ENABLE_OVERLOADING)
    CollectPadsClipRunningTimeMethodInfo    ,
#endif
    collectPadsClipRunningTime              ,


-- ** eventDefault #method:eventDefault#

#if defined(ENABLE_OVERLOADING)
    CollectPadsEventDefaultMethodInfo       ,
#endif
    collectPadsEventDefault                 ,


-- ** flush #method:flush#

#if defined(ENABLE_OVERLOADING)
    CollectPadsFlushMethodInfo              ,
#endif
    collectPadsFlush                        ,


-- ** new #method:new#

    collectPadsNew                          ,


-- ** peek #method:peek#

#if defined(ENABLE_OVERLOADING)
    CollectPadsPeekMethodInfo               ,
#endif
    collectPadsPeek                         ,


-- ** pop #method:pop#

#if defined(ENABLE_OVERLOADING)
    CollectPadsPopMethodInfo                ,
#endif
    collectPadsPop                          ,


-- ** queryDefault #method:queryDefault#

#if defined(ENABLE_OVERLOADING)
    CollectPadsQueryDefaultMethodInfo       ,
#endif
    collectPadsQueryDefault                 ,


-- ** readBuffer #method:readBuffer#

#if defined(ENABLE_OVERLOADING)
    CollectPadsReadBufferMethodInfo         ,
#endif
    collectPadsReadBuffer                   ,


-- ** removePad #method:removePad#

#if defined(ENABLE_OVERLOADING)
    CollectPadsRemovePadMethodInfo          ,
#endif
    collectPadsRemovePad                    ,


-- ** setBufferFunction #method:setBufferFunction#

#if defined(ENABLE_OVERLOADING)
    CollectPadsSetBufferFunctionMethodInfo  ,
#endif
    collectPadsSetBufferFunction            ,


-- ** setClipFunction #method:setClipFunction#

#if defined(ENABLE_OVERLOADING)
    CollectPadsSetClipFunctionMethodInfo    ,
#endif
    collectPadsSetClipFunction              ,


-- ** setCompareFunction #method:setCompareFunction#

#if defined(ENABLE_OVERLOADING)
    CollectPadsSetCompareFunctionMethodInfo ,
#endif
    collectPadsSetCompareFunction           ,


-- ** setEventFunction #method:setEventFunction#

#if defined(ENABLE_OVERLOADING)
    CollectPadsSetEventFunctionMethodInfo   ,
#endif
    collectPadsSetEventFunction             ,


-- ** setFlushFunction #method:setFlushFunction#

#if defined(ENABLE_OVERLOADING)
    CollectPadsSetFlushFunctionMethodInfo   ,
#endif
    collectPadsSetFlushFunction             ,


-- ** setFlushing #method:setFlushing#

#if defined(ENABLE_OVERLOADING)
    CollectPadsSetFlushingMethodInfo        ,
#endif
    collectPadsSetFlushing                  ,


-- ** setFunction #method:setFunction#

#if defined(ENABLE_OVERLOADING)
    CollectPadsSetFunctionMethodInfo        ,
#endif
    collectPadsSetFunction                  ,


-- ** setQueryFunction #method:setQueryFunction#

#if defined(ENABLE_OVERLOADING)
    CollectPadsSetQueryFunctionMethodInfo   ,
#endif
    collectPadsSetQueryFunction             ,


-- ** setWaiting #method:setWaiting#

#if defined(ENABLE_OVERLOADING)
    CollectPadsSetWaitingMethodInfo         ,
#endif
    collectPadsSetWaiting                   ,


-- ** srcEventDefault #method:srcEventDefault#

#if defined(ENABLE_OVERLOADING)
    CollectPadsSrcEventDefaultMethodInfo    ,
#endif
    collectPadsSrcEventDefault              ,


-- ** start #method:start#

#if defined(ENABLE_OVERLOADING)
    CollectPadsStartMethodInfo              ,
#endif
    collectPadsStart                        ,


-- ** stop #method:stop#

#if defined(ENABLE_OVERLOADING)
    CollectPadsStopMethodInfo               ,
#endif
    collectPadsStop                         ,


-- ** takeBuffer #method:takeBuffer#

#if defined(ENABLE_OVERLOADING)
    CollectPadsTakeBufferMethodInfo         ,
#endif
    collectPadsTakeBuffer                   ,




    ) 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.BasicTypes as B.Types
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 Control.Monad.IO.Class as MIO
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.GObject.Objects.Object as GObject.Object
import qualified GI.Gst.Enums as Gst.Enums
import qualified GI.Gst.Objects.Object as Gst.Object
import qualified GI.Gst.Objects.Pad as Gst.Pad
import qualified GI.Gst.Structs.Buffer as Gst.Buffer
import qualified GI.Gst.Structs.Event as Gst.Event
import qualified GI.Gst.Structs.Query as Gst.Query
import qualified GI.GstBase.Callbacks as GstBase.Callbacks
import {-# SOURCE #-} qualified GI.GstBase.Structs.CollectData as GstBase.CollectData

-- | Memory-managed wrapper type.
newtype CollectPads = CollectPads (SP.ManagedPtr CollectPads)
    deriving (CollectPads -> CollectPads -> Bool
(CollectPads -> CollectPads -> Bool)
-> (CollectPads -> CollectPads -> Bool) -> Eq CollectPads
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollectPads -> CollectPads -> Bool
$c/= :: CollectPads -> CollectPads -> Bool
== :: CollectPads -> CollectPads -> Bool
$c== :: CollectPads -> CollectPads -> Bool
Eq)

instance SP.ManagedPtrNewtype CollectPads where
    toManagedPtr :: CollectPads -> ManagedPtr CollectPads
toManagedPtr (CollectPads ManagedPtr CollectPads
p) = ManagedPtr CollectPads
p

foreign import ccall "gst_collect_pads_get_type"
    c_gst_collect_pads_get_type :: IO B.Types.GType

instance B.Types.TypedObject CollectPads where
    glibType :: IO GType
glibType = IO GType
c_gst_collect_pads_get_type

instance B.Types.GObject CollectPads

-- | Convert 'CollectPads' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue CollectPads where
    toGValue :: CollectPads -> IO GValue
toGValue CollectPads
o = do
        GType
gtype <- IO GType
c_gst_collect_pads_get_type
        CollectPads -> (Ptr CollectPads -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr CollectPads
o (GType
-> (GValue -> Ptr CollectPads -> IO ())
-> Ptr CollectPads
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr CollectPads -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO CollectPads
fromGValue GValue
gv = do
        Ptr CollectPads
ptr <- GValue -> IO (Ptr CollectPads)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr CollectPads)
        (ManagedPtr CollectPads -> CollectPads)
-> Ptr CollectPads -> IO CollectPads
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr CollectPads -> CollectPads
CollectPads Ptr CollectPads
ptr
        
    

-- | Type class for types which can be safely cast to `CollectPads`, for instance with `toCollectPads`.
class (SP.GObject o, O.IsDescendantOf CollectPads o) => IsCollectPads o
instance (SP.GObject o, O.IsDescendantOf CollectPads o) => IsCollectPads o

instance O.HasParentTypes CollectPads
type instance O.ParentTypes CollectPads = '[Gst.Object.Object, GObject.Object.Object]

-- | Cast to `CollectPads`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toCollectPads :: (MonadIO m, IsCollectPads o) => o -> m CollectPads
toCollectPads :: o -> m CollectPads
toCollectPads = IO CollectPads -> m CollectPads
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CollectPads -> m CollectPads)
-> (o -> IO CollectPads) -> o -> m CollectPads
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr CollectPads -> CollectPads) -> o -> IO CollectPads
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr CollectPads -> CollectPads
CollectPads

#if defined(ENABLE_OVERLOADING)
type family ResolveCollectPadsMethod (t :: Symbol) (o :: *) :: * where
    ResolveCollectPadsMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveCollectPadsMethod "addPad" o = CollectPadsAddPadMethodInfo
    ResolveCollectPadsMethod "available" o = CollectPadsAvailableMethodInfo
    ResolveCollectPadsMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveCollectPadsMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveCollectPadsMethod "clipRunningTime" o = CollectPadsClipRunningTimeMethodInfo
    ResolveCollectPadsMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveCollectPadsMethod "eventDefault" o = CollectPadsEventDefaultMethodInfo
    ResolveCollectPadsMethod "flush" o = CollectPadsFlushMethodInfo
    ResolveCollectPadsMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveCollectPadsMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveCollectPadsMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveCollectPadsMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveCollectPadsMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveCollectPadsMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveCollectPadsMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveCollectPadsMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveCollectPadsMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveCollectPadsMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveCollectPadsMethod "peek" o = CollectPadsPeekMethodInfo
    ResolveCollectPadsMethod "pop" o = CollectPadsPopMethodInfo
    ResolveCollectPadsMethod "queryDefault" o = CollectPadsQueryDefaultMethodInfo
    ResolveCollectPadsMethod "readBuffer" o = CollectPadsReadBufferMethodInfo
    ResolveCollectPadsMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveCollectPadsMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveCollectPadsMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveCollectPadsMethod "removePad" o = CollectPadsRemovePadMethodInfo
    ResolveCollectPadsMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveCollectPadsMethod "srcEventDefault" o = CollectPadsSrcEventDefaultMethodInfo
    ResolveCollectPadsMethod "start" o = CollectPadsStartMethodInfo
    ResolveCollectPadsMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveCollectPadsMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveCollectPadsMethod "stop" o = CollectPadsStopMethodInfo
    ResolveCollectPadsMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveCollectPadsMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveCollectPadsMethod "takeBuffer" o = CollectPadsTakeBufferMethodInfo
    ResolveCollectPadsMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveCollectPadsMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveCollectPadsMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveCollectPadsMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveCollectPadsMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveCollectPadsMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveCollectPadsMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveCollectPadsMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveCollectPadsMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveCollectPadsMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveCollectPadsMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveCollectPadsMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveCollectPadsMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveCollectPadsMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveCollectPadsMethod "setBufferFunction" o = CollectPadsSetBufferFunctionMethodInfo
    ResolveCollectPadsMethod "setClipFunction" o = CollectPadsSetClipFunctionMethodInfo
    ResolveCollectPadsMethod "setCompareFunction" o = CollectPadsSetCompareFunctionMethodInfo
    ResolveCollectPadsMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveCollectPadsMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveCollectPadsMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveCollectPadsMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveCollectPadsMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveCollectPadsMethod "setEventFunction" o = CollectPadsSetEventFunctionMethodInfo
    ResolveCollectPadsMethod "setFlushFunction" o = CollectPadsSetFlushFunctionMethodInfo
    ResolveCollectPadsMethod "setFlushing" o = CollectPadsSetFlushingMethodInfo
    ResolveCollectPadsMethod "setFunction" o = CollectPadsSetFunctionMethodInfo
    ResolveCollectPadsMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveCollectPadsMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveCollectPadsMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveCollectPadsMethod "setQueryFunction" o = CollectPadsSetQueryFunctionMethodInfo
    ResolveCollectPadsMethod "setWaiting" o = CollectPadsSetWaitingMethodInfo
    ResolveCollectPadsMethod l o = O.MethodResolutionFailed l o

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList CollectPads
type instance O.AttributeList CollectPads = CollectPadsAttributeList
type CollectPadsAttributeList = ('[ '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList CollectPads = CollectPadsSignalList
type CollectPadsSignalList = ('[ '("deepNotify", Gst.Object.ObjectDeepNotifySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method CollectPads::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GstBase" , name = "CollectPads" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_new" gst_collect_pads_new :: 
    IO (Ptr CollectPads)

-- | Create a new instance of t'GI.GstBase.Objects.CollectPads.CollectPads'.
-- 
-- MT safe.
collectPadsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m CollectPads
    -- ^ __Returns:__ a new t'GI.GstBase.Objects.CollectPads.CollectPads', or 'P.Nothing' in case of an error.
collectPadsNew :: m CollectPads
collectPadsNew  = IO CollectPads -> m CollectPads
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CollectPads -> m CollectPads)
-> IO CollectPads -> m CollectPads
forall a b. (a -> b) -> a -> b
$ do
    Ptr CollectPads
result <- IO (Ptr CollectPads)
gst_collect_pads_new
    Text -> Ptr CollectPads -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"collectPadsNew" Ptr CollectPads
result
    CollectPads
result' <- ((ManagedPtr CollectPads -> CollectPads)
-> Ptr CollectPads -> IO CollectPads
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr CollectPads -> CollectPads
CollectPads) Ptr CollectPads
result
    CollectPads -> IO CollectPads
forall (m :: * -> *) a. Monad m => a -> m a
return CollectPads
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method CollectPads::add_pad
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the pad to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the size of the returned #GstCollectData structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy_notify"
--           , argType =
--               TInterface
--                 Name { namespace = "GstBase" , name = "CollectDataDestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "function to be called before the returned\n  #GstCollectData structure is freed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "lock"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether to lock this pad in usual waiting state"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GstBase" , name = "CollectData" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_add_pad" gst_collect_pads_add_pad :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    Ptr Gst.Pad.Pad ->                      -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Word32 ->                               -- size : TBasicType TUInt
    FunPtr GstBase.Callbacks.C_CollectDataDestroyNotify -> -- destroy_notify : TInterface (Name {namespace = "GstBase", name = "CollectDataDestroyNotify"})
    CInt ->                                 -- lock : TBasicType TBoolean
    IO (Ptr GstBase.CollectData.CollectData)

-- | Add a pad to the collection of collect pads. The pad has to be
-- a sinkpad. The refcount of the pad is incremented. Use
-- 'GI.GstBase.Objects.CollectPads.collectPadsRemovePad' to remove the pad from the collection
-- again.
-- 
-- You specify a size for the returned t'GI.GstBase.Structs.CollectData.CollectData' structure
-- so that you can use it to store additional information.
-- 
-- You can also specify a t'GI.GstBase.Callbacks.CollectDataDestroyNotify' that will be called
-- just before the t'GI.GstBase.Structs.CollectData.CollectData' structure is freed. It is passed the
-- pointer to the structure and should free any custom memory and resources
-- allocated for it.
-- 
-- Keeping a pad locked in waiting state is only relevant when using
-- the default collection algorithm (providing the oldest buffer).
-- It ensures a buffer must be available on this pad for a collection
-- to take place.  This is of typical use to a muxer element where
-- non-subtitle streams should always be in waiting state,
-- e.g. to assure that caps information is available on all these streams
-- when initial headers have to be written.
-- 
-- The pad will be automatically activated in push mode when /@pads@/ is
-- started.
-- 
-- MT safe.
collectPadsAddPad ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a, Gst.Pad.IsPad b) =>
    a
    -- ^ /@pads@/: the collectpads to use
    -> b
    -- ^ /@pad@/: the pad to add
    -> Word32
    -- ^ /@size@/: the size of the returned t'GI.GstBase.Structs.CollectData.CollectData' structure
    -> GstBase.Callbacks.CollectDataDestroyNotify
    -- ^ /@destroyNotify@/: function to be called before the returned
    --   t'GI.GstBase.Structs.CollectData.CollectData' structure is freed
    -> Bool
    -- ^ /@lock@/: whether to lock this pad in usual waiting state
    -> m (Maybe GstBase.CollectData.CollectData)
    -- ^ __Returns:__ a new t'GI.GstBase.Structs.CollectData.CollectData' to identify the
    --   new pad. Or 'P.Nothing' if wrong parameters are supplied.
collectPadsAddPad :: a
-> b
-> Word32
-> CollectDataDestroyNotify
-> Bool
-> m (Maybe CollectData)
collectPadsAddPad a
pads b
pad Word32
size CollectDataDestroyNotify
destroyNotify Bool
lock = IO (Maybe CollectData) -> m (Maybe CollectData)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CollectData) -> m (Maybe CollectData))
-> IO (Maybe CollectData) -> m (Maybe CollectData)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    Ptr Pad
pad' <- b -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pad
    Ptr (FunPtr C_CollectDataDestroyNotify)
ptrdestroyNotify <- IO (Ptr (FunPtr C_CollectDataDestroyNotify))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr GstBase.Callbacks.C_CollectDataDestroyNotify))
    FunPtr C_CollectDataDestroyNotify
destroyNotify' <- C_CollectDataDestroyNotify
-> IO (FunPtr C_CollectDataDestroyNotify)
GstBase.Callbacks.mk_CollectDataDestroyNotify (Maybe (Ptr (FunPtr C_CollectDataDestroyNotify))
-> CollectDataDestroyNotify -> C_CollectDataDestroyNotify
GstBase.Callbacks.wrap_CollectDataDestroyNotify (Ptr (FunPtr C_CollectDataDestroyNotify)
-> Maybe (Ptr (FunPtr C_CollectDataDestroyNotify))
forall a. a -> Maybe a
Just Ptr (FunPtr C_CollectDataDestroyNotify)
ptrdestroyNotify) CollectDataDestroyNotify
destroyNotify)
    Ptr (FunPtr C_CollectDataDestroyNotify)
-> FunPtr C_CollectDataDestroyNotify -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_CollectDataDestroyNotify)
ptrdestroyNotify FunPtr C_CollectDataDestroyNotify
destroyNotify'
    let lock' :: CInt
lock' = (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
lock
    Ptr CollectData
result <- Ptr CollectPads
-> Ptr Pad
-> Word32
-> FunPtr C_CollectDataDestroyNotify
-> CInt
-> IO (Ptr CollectData)
gst_collect_pads_add_pad Ptr CollectPads
pads' Ptr Pad
pad' Word32
size FunPtr C_CollectDataDestroyNotify
destroyNotify' CInt
lock'
    Maybe CollectData
maybeResult <- Ptr CollectData
-> (Ptr CollectData -> IO CollectData) -> IO (Maybe CollectData)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CollectData
result ((Ptr CollectData -> IO CollectData) -> IO (Maybe CollectData))
-> (Ptr CollectData -> IO CollectData) -> IO (Maybe CollectData)
forall a b. (a -> b) -> a -> b
$ \Ptr CollectData
result' -> do
        CollectData
result'' <- ((ManagedPtr CollectData -> CollectData)
-> Ptr CollectData -> IO CollectData
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr CollectData -> CollectData
GstBase.CollectData.CollectData) Ptr CollectData
result'
        CollectData -> IO CollectData
forall (m :: * -> *) a. Monad m => a -> m a
return CollectData
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pad
    Maybe CollectData -> IO (Maybe CollectData)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CollectData
maybeResult

#if defined(ENABLE_OVERLOADING)
data CollectPadsAddPadMethodInfo
instance (signature ~ (b -> Word32 -> GstBase.Callbacks.CollectDataDestroyNotify -> Bool -> m (Maybe GstBase.CollectData.CollectData)), MonadIO m, IsCollectPads a, Gst.Pad.IsPad b) => O.MethodInfo CollectPadsAddPadMethodInfo a signature where
    overloadedMethod = collectPadsAddPad

#endif

-- method CollectPads::available
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_available" gst_collect_pads_available :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    IO Word32

-- | Query how much bytes can be read from each queued buffer. This means
-- that the result of this call is the maximum number of bytes that can
-- be read from each of the pads.
-- 
-- This function should be called with /@pads@/ STREAM_LOCK held, such as
-- in the callback.
-- 
-- MT safe.
collectPadsAvailable ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to query
    -> m Word32
    -- ^ __Returns:__ The maximum number of bytes queued on all pads. This function
    -- returns 0 if a pad has no queued buffer.
collectPadsAvailable :: a -> m Word32
collectPadsAvailable a
pads = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    Word32
result <- Ptr CollectPads -> IO Word32
gst_collect_pads_available Ptr CollectPads
pads'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data CollectPadsAvailableMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsAvailableMethodInfo a signature where
    overloadedMethod = collectPadsAvailable

#endif

-- method CollectPads::clip_running_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cdata"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "collect data of corresponding pad"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buf"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "buffer being clipped"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "outbuf"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "output buffer with running time, or NULL if clipped"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data (unused)" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "FlowReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_clip_running_time" gst_collect_pads_clip_running_time :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    Ptr GstBase.CollectData.CollectData ->  -- cdata : TInterface (Name {namespace = "GstBase", name = "CollectData"})
    Ptr Gst.Buffer.Buffer ->                -- buf : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr (Ptr Gst.Buffer.Buffer) ->          -- outbuf : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CInt

-- | Convenience clipping function that converts incoming buffer\'s timestamp
-- to running time, or clips the buffer if outside configured segment.
-- 
-- Since 1.6, this clipping function also sets the DTS parameter of the
-- GstCollectData structure. This version of the running time DTS can be
-- negative. G_MININT64 is used to indicate invalid value.
collectPadsClipRunningTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to use
    -> GstBase.CollectData.CollectData
    -- ^ /@cdata@/: collect data of corresponding pad
    -> Gst.Buffer.Buffer
    -- ^ /@buf@/: buffer being clipped
    -> Ptr ()
    -- ^ /@userData@/: user data (unused)
    -> m ((Gst.Enums.FlowReturn, Maybe Gst.Buffer.Buffer))
collectPadsClipRunningTime :: a
-> CollectData -> Buffer -> Ptr () -> m (FlowReturn, Maybe Buffer)
collectPadsClipRunningTime a
pads CollectData
cdata Buffer
buf Ptr ()
userData = IO (FlowReturn, Maybe Buffer) -> m (FlowReturn, Maybe Buffer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FlowReturn, Maybe Buffer) -> m (FlowReturn, Maybe Buffer))
-> IO (FlowReturn, Maybe Buffer) -> m (FlowReturn, Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    Ptr CollectData
cdata' <- CollectData -> IO (Ptr CollectData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CollectData
cdata
    Ptr Buffer
buf' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buf
    Ptr (Ptr Buffer)
outbuf <- IO (Ptr (Ptr Buffer))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Buffer.Buffer))
    CInt
result <- Ptr CollectPads
-> Ptr CollectData
-> Ptr Buffer
-> Ptr (Ptr Buffer)
-> Ptr ()
-> IO CInt
gst_collect_pads_clip_running_time Ptr CollectPads
pads' Ptr CollectData
cdata' Ptr Buffer
buf' Ptr (Ptr Buffer)
outbuf Ptr ()
userData
    let result' :: FlowReturn
result' = (Int -> FlowReturn
forall a. Enum a => Int -> a
toEnum (Int -> FlowReturn) -> (CInt -> Int) -> CInt -> FlowReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    Ptr Buffer
outbuf' <- Ptr (Ptr Buffer) -> IO (Ptr Buffer)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Buffer)
outbuf
    Maybe Buffer
maybeOutbuf' <- Ptr Buffer -> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Buffer
outbuf' ((Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer))
-> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
outbuf'' -> do
        Buffer
outbuf''' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
outbuf''
        Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
outbuf'''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    CollectDataDestroyNotify
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CollectData
cdata
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buf
    Ptr (Ptr Buffer) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Buffer)
outbuf
    (FlowReturn, Maybe Buffer) -> IO (FlowReturn, Maybe Buffer)
forall (m :: * -> *) a. Monad m => a -> m a
return (FlowReturn
result', Maybe Buffer
maybeOutbuf')

#if defined(ENABLE_OVERLOADING)
data CollectPadsClipRunningTimeMethodInfo
instance (signature ~ (GstBase.CollectData.CollectData -> Gst.Buffer.Buffer -> Ptr () -> m ((Gst.Enums.FlowReturn, Maybe Gst.Buffer.Buffer))), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsClipRunningTimeMethodInfo a signature where
    overloadedMethod = collectPadsClipRunningTime

#endif

-- method CollectPads::event_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "collect data of corresponding pad"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gst" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "event being processed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "discard"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "process but do not send event downstream"
--                 , 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_collect_pads_event_default" gst_collect_pads_event_default :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    Ptr GstBase.CollectData.CollectData ->  -- data : TInterface (Name {namespace = "GstBase", name = "CollectData"})
    Ptr Gst.Event.Event ->                  -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    CInt ->                                 -- discard : TBasicType TBoolean
    IO CInt

-- | Default t'GI.GstBase.Objects.CollectPads.CollectPads' event handling that elements should always
-- chain up to to ensure proper operation.  Element might however indicate
-- event should not be forwarded downstream.
collectPadsEventDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to use
    -> GstBase.CollectData.CollectData
    -- ^ /@data@/: collect data of corresponding pad
    -> Gst.Event.Event
    -- ^ /@event@/: event being processed
    -> Bool
    -- ^ /@discard@/: process but do not send event downstream
    -> m Bool
collectPadsEventDefault :: a -> CollectData -> Event -> Bool -> m Bool
collectPadsEventDefault a
pads CollectData
data_ Event
event Bool
discard = 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 CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    Ptr CollectData
data_' <- CollectData -> IO (Ptr CollectData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CollectData
data_
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    let discard' :: CInt
discard' = (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
discard
    CInt
result <- Ptr CollectPads -> Ptr CollectData -> Ptr Event -> CInt -> IO CInt
gst_collect_pads_event_default Ptr CollectPads
pads' Ptr CollectData
data_' Ptr Event
event' CInt
discard'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    CollectDataDestroyNotify
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CollectData
data_
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CollectPadsEventDefaultMethodInfo
instance (signature ~ (GstBase.CollectData.CollectData -> Gst.Event.Event -> Bool -> m Bool), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsEventDefaultMethodInfo a signature where
    overloadedMethod = collectPadsEventDefault

#endif

-- method CollectPads::flush
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes to flush"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_flush" gst_collect_pads_flush :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    Ptr GstBase.CollectData.CollectData ->  -- data : TInterface (Name {namespace = "GstBase", name = "CollectData"})
    Word32 ->                               -- size : TBasicType TUInt
    IO Word32

-- | Flush /@size@/ bytes from the pad /@data@/.
-- 
-- This function should be called with /@pads@/ STREAM_LOCK held, such as
-- in the callback.
-- 
-- MT safe.
collectPadsFlush ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to query
    -> GstBase.CollectData.CollectData
    -- ^ /@data@/: the data to use
    -> Word32
    -- ^ /@size@/: the number of bytes to flush
    -> m Word32
    -- ^ __Returns:__ The number of bytes flushed This can be less than /@size@/ and
    -- is 0 if the pad was end-of-stream.
collectPadsFlush :: a -> CollectData -> Word32 -> m Word32
collectPadsFlush a
pads CollectData
data_ Word32
size = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    Ptr CollectData
data_' <- CollectData -> IO (Ptr CollectData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CollectData
data_
    Word32
result <- Ptr CollectPads -> Ptr CollectData -> Word32 -> IO Word32
gst_collect_pads_flush Ptr CollectPads
pads' Ptr CollectData
data_' Word32
size
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    CollectDataDestroyNotify
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CollectData
data_
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data CollectPadsFlushMethodInfo
instance (signature ~ (GstBase.CollectData.CollectData -> Word32 -> m Word32), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsFlushMethodInfo a signature where
    overloadedMethod = collectPadsFlush

#endif

-- method CollectPads::peek
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to peek"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_peek" gst_collect_pads_peek :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    Ptr GstBase.CollectData.CollectData ->  -- data : TInterface (Name {namespace = "GstBase", name = "CollectData"})
    IO (Ptr Gst.Buffer.Buffer)

-- | Peek at the buffer currently queued in /@data@/. This function
-- should be called with the /@pads@/ STREAM_LOCK held, such as in the callback
-- handler.
-- 
-- MT safe.
collectPadsPeek ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to peek
    -> GstBase.CollectData.CollectData
    -- ^ /@data@/: the data to use
    -> m (Maybe Gst.Buffer.Buffer)
    -- ^ __Returns:__ The buffer in /@data@/ or 'P.Nothing' if no
    -- buffer is queued. should unref the buffer after usage.
collectPadsPeek :: a -> CollectData -> m (Maybe Buffer)
collectPadsPeek a
pads CollectData
data_ = IO (Maybe Buffer) -> m (Maybe Buffer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Buffer) -> m (Maybe Buffer))
-> IO (Maybe Buffer) -> m (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    Ptr CollectData
data_' <- CollectData -> IO (Ptr CollectData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CollectData
data_
    Ptr Buffer
result <- Ptr CollectPads -> Ptr CollectData -> IO (Ptr Buffer)
gst_collect_pads_peek Ptr CollectPads
pads' Ptr CollectData
data_'
    Maybe Buffer
maybeResult <- Ptr Buffer -> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Buffer
result ((Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer))
-> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
result' -> do
        Buffer
result'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
result'
        Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    CollectDataDestroyNotify
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CollectData
data_
    Maybe Buffer -> IO (Maybe Buffer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
maybeResult

#if defined(ENABLE_OVERLOADING)
data CollectPadsPeekMethodInfo
instance (signature ~ (GstBase.CollectData.CollectData -> m (Maybe Gst.Buffer.Buffer)), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsPeekMethodInfo a signature where
    overloadedMethod = collectPadsPeek

#endif

-- method CollectPads::pop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to pop"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_pop" gst_collect_pads_pop :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    Ptr GstBase.CollectData.CollectData ->  -- data : TInterface (Name {namespace = "GstBase", name = "CollectData"})
    IO (Ptr Gst.Buffer.Buffer)

-- | Pop the buffer currently queued in /@data@/. This function
-- should be called with the /@pads@/ STREAM_LOCK held, such as in the callback
-- handler.
-- 
-- MT safe.
collectPadsPop ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to pop
    -> GstBase.CollectData.CollectData
    -- ^ /@data@/: the data to use
    -> m (Maybe Gst.Buffer.Buffer)
    -- ^ __Returns:__ The buffer in /@data@/ or 'P.Nothing' if no
    -- buffer was queued. You should unref the buffer after usage.
collectPadsPop :: a -> CollectData -> m (Maybe Buffer)
collectPadsPop a
pads CollectData
data_ = IO (Maybe Buffer) -> m (Maybe Buffer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Buffer) -> m (Maybe Buffer))
-> IO (Maybe Buffer) -> m (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    Ptr CollectData
data_' <- CollectData -> IO (Ptr CollectData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CollectData
data_
    Ptr Buffer
result <- Ptr CollectPads -> Ptr CollectData -> IO (Ptr Buffer)
gst_collect_pads_pop Ptr CollectPads
pads' Ptr CollectData
data_'
    Maybe Buffer
maybeResult <- Ptr Buffer -> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Buffer
result ((Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer))
-> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
result' -> do
        Buffer
result'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
result'
        Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    CollectDataDestroyNotify
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CollectData
data_
    Maybe Buffer -> IO (Maybe Buffer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
maybeResult

#if defined(ENABLE_OVERLOADING)
data CollectPadsPopMethodInfo
instance (signature ~ (GstBase.CollectData.CollectData -> m (Maybe Gst.Buffer.Buffer)), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsPopMethodInfo a signature where
    overloadedMethod = collectPadsPop

#endif

-- method CollectPads::query_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "collect data of corresponding pad"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "query being processed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "discard"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "process but do not send event downstream"
--                 , 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_collect_pads_query_default" gst_collect_pads_query_default :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    Ptr GstBase.CollectData.CollectData ->  -- data : TInterface (Name {namespace = "GstBase", name = "CollectData"})
    Ptr Gst.Query.Query ->                  -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    CInt ->                                 -- discard : TBasicType TBoolean
    IO CInt

-- | Default t'GI.GstBase.Objects.CollectPads.CollectPads' query handling that elements should always
-- chain up to to ensure proper operation.  Element might however indicate
-- query should not be forwarded downstream.
collectPadsQueryDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to use
    -> GstBase.CollectData.CollectData
    -- ^ /@data@/: collect data of corresponding pad
    -> Gst.Query.Query
    -- ^ /@query@/: query being processed
    -> Bool
    -- ^ /@discard@/: process but do not send event downstream
    -> m Bool
collectPadsQueryDefault :: a -> CollectData -> Query -> Bool -> m Bool
collectPadsQueryDefault a
pads CollectData
data_ Query
query Bool
discard = 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 CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    Ptr CollectData
data_' <- CollectData -> IO (Ptr CollectData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CollectData
data_
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let discard' :: CInt
discard' = (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
discard
    CInt
result <- Ptr CollectPads -> Ptr CollectData -> Ptr Query -> CInt -> IO CInt
gst_collect_pads_query_default Ptr CollectPads
pads' Ptr CollectData
data_' Ptr Query
query' CInt
discard'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    CollectDataDestroyNotify
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CollectData
data_
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CollectPadsQueryDefaultMethodInfo
instance (signature ~ (GstBase.CollectData.CollectData -> Gst.Query.Query -> Bool -> m Bool), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsQueryDefaultMethodInfo a signature where
    overloadedMethod = collectPadsQueryDefault

#endif

-- method CollectPads::read_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes to read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_read_buffer" gst_collect_pads_read_buffer :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    Ptr GstBase.CollectData.CollectData ->  -- data : TInterface (Name {namespace = "GstBase", name = "CollectData"})
    Word32 ->                               -- size : TBasicType TUInt
    IO (Ptr Gst.Buffer.Buffer)

-- | Get a subbuffer of /@size@/ bytes from the given pad /@data@/.
-- 
-- This function should be called with /@pads@/ STREAM_LOCK held, such as in the
-- callback.
-- 
-- MT safe.
collectPadsReadBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to query
    -> GstBase.CollectData.CollectData
    -- ^ /@data@/: the data to use
    -> Word32
    -- ^ /@size@/: the number of bytes to read
    -> m (Maybe Gst.Buffer.Buffer)
    -- ^ __Returns:__ A sub buffer. The size of the buffer can
    -- be less that requested. A return of 'P.Nothing' signals that the pad is
    -- end-of-stream. Unref the buffer after use.
collectPadsReadBuffer :: a -> CollectData -> Word32 -> m (Maybe Buffer)
collectPadsReadBuffer a
pads CollectData
data_ Word32
size = IO (Maybe Buffer) -> m (Maybe Buffer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Buffer) -> m (Maybe Buffer))
-> IO (Maybe Buffer) -> m (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    Ptr CollectData
data_' <- CollectData -> IO (Ptr CollectData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CollectData
data_
    Ptr Buffer
result <- Ptr CollectPads -> Ptr CollectData -> Word32 -> IO (Ptr Buffer)
gst_collect_pads_read_buffer Ptr CollectPads
pads' Ptr CollectData
data_' Word32
size
    Maybe Buffer
maybeResult <- Ptr Buffer -> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Buffer
result ((Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer))
-> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
result' -> do
        Buffer
result'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
result'
        Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    CollectDataDestroyNotify
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CollectData
data_
    Maybe Buffer -> IO (Maybe Buffer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
maybeResult

#if defined(ENABLE_OVERLOADING)
data CollectPadsReadBufferMethodInfo
instance (signature ~ (GstBase.CollectData.CollectData -> Word32 -> m (Maybe Gst.Buffer.Buffer)), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsReadBufferMethodInfo a signature where
    overloadedMethod = collectPadsReadBuffer

#endif

-- method CollectPads::remove_pad
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the pad to remove" , 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_collect_pads_remove_pad" gst_collect_pads_remove_pad :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    Ptr Gst.Pad.Pad ->                      -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Remove a pad from the collection of collect pads. This function will also
-- free the t'GI.GstBase.Structs.CollectData.CollectData' and all the resources that were allocated with
-- 'GI.GstBase.Objects.CollectPads.collectPadsAddPad'.
-- 
-- The pad will be deactivated automatically when /@pads@/ is stopped.
-- 
-- MT safe.
collectPadsRemovePad ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a, Gst.Pad.IsPad b) =>
    a
    -- ^ /@pads@/: the collectpads to use
    -> b
    -- ^ /@pad@/: the pad to remove
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pad could be removed.
collectPadsRemovePad :: a -> b -> m Bool
collectPadsRemovePad a
pads b
pad = 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 CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    Ptr Pad
pad' <- b -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pad
    CInt
result <- Ptr CollectPads -> Ptr Pad -> IO CInt
gst_collect_pads_remove_pad Ptr CollectPads
pads' Ptr Pad
pad'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CollectPadsRemovePadMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsCollectPads a, Gst.Pad.IsPad b) => O.MethodInfo CollectPadsRemovePadMethodInfo a signature where
    overloadedMethod = collectPadsRemovePad

#endif

-- method CollectPads::set_buffer_function
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "GstBase" , name = "CollectPadsBufferFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the function to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_set_buffer_function" gst_collect_pads_set_buffer_function :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    FunPtr GstBase.Callbacks.C_CollectPadsBufferFunction -> -- func : TInterface (Name {namespace = "GstBase", name = "CollectPadsBufferFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Set the callback function and user data that will be called with
-- the oldest buffer when all pads have been collected, or 'P.Nothing' on EOS.
-- If a buffer is passed, the callback owns a reference and must unref
-- it.
-- 
-- MT safe.
collectPadsSetBufferFunction ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to use
    -> GstBase.Callbacks.CollectPadsBufferFunction
    -- ^ /@func@/: the function to set
    -> m ()
collectPadsSetBufferFunction :: a -> CollectPadsBufferFunction -> m ()
collectPadsSetBufferFunction a
pads CollectPadsBufferFunction
func = 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 CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    FunPtr C_CollectPadsBufferFunction
func' <- C_CollectPadsBufferFunction
-> IO (FunPtr C_CollectPadsBufferFunction)
GstBase.Callbacks.mk_CollectPadsBufferFunction (Maybe (Ptr (FunPtr C_CollectPadsBufferFunction))
-> CollectPadsBufferFunction_WithClosures
-> C_CollectPadsBufferFunction
GstBase.Callbacks.wrap_CollectPadsBufferFunction Maybe (Ptr (FunPtr C_CollectPadsBufferFunction))
forall a. Maybe a
Nothing (CollectPadsBufferFunction -> CollectPadsBufferFunction_WithClosures
GstBase.Callbacks.drop_closures_CollectPadsBufferFunction CollectPadsBufferFunction
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr CollectPads
-> FunPtr C_CollectPadsBufferFunction -> Ptr () -> IO ()
gst_collect_pads_set_buffer_function Ptr CollectPads
pads' FunPtr C_CollectPadsBufferFunction
func' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_CollectPadsBufferFunction -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CollectPadsBufferFunction
func'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectPadsSetBufferFunctionMethodInfo
instance (signature ~ (GstBase.Callbacks.CollectPadsBufferFunction -> m ()), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsSetBufferFunctionMethodInfo a signature where
    overloadedMethod = collectPadsSetBufferFunction

#endif

-- method CollectPads::set_clip_function
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clipfunc"
--           , argType =
--               TInterface
--                 Name { namespace = "GstBase" , name = "CollectPadsClipFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "clip function to install"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to @clip_func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_set_clip_function" gst_collect_pads_set_clip_function :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    FunPtr GstBase.Callbacks.C_CollectPadsClipFunction -> -- clipfunc : TInterface (Name {namespace = "GstBase", name = "CollectPadsClipFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Install a clipping function that is called right after a buffer is received
-- on a pad managed by /@pads@/. See t'GI.GstBase.Callbacks.CollectPadsClipFunction' for more info.
collectPadsSetClipFunction ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to use
    -> GstBase.Callbacks.CollectPadsClipFunction
    -- ^ /@clipfunc@/: clip function to install
    -> m ()
collectPadsSetClipFunction :: a -> CollectPadsClipFunction -> m ()
collectPadsSetClipFunction a
pads CollectPadsClipFunction
clipfunc = 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 CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    FunPtr
  (Ptr CollectPads
   -> Ptr CollectData
   -> Ptr Buffer
   -> Ptr (Ptr Buffer)
   -> Ptr ()
   -> IO CInt)
clipfunc' <- (Ptr CollectPads
 -> Ptr CollectData
 -> Ptr Buffer
 -> Ptr (Ptr Buffer)
 -> Ptr ()
 -> IO CInt)
-> IO
     (FunPtr
        (Ptr CollectPads
         -> Ptr CollectData
         -> Ptr Buffer
         -> Ptr (Ptr Buffer)
         -> Ptr ()
         -> IO CInt))
GstBase.Callbacks.mk_CollectPadsClipFunction (Maybe
  (Ptr
     (FunPtr
        (Ptr CollectPads
         -> Ptr CollectData
         -> Ptr Buffer
         -> Ptr (Ptr Buffer)
         -> Ptr ()
         -> IO CInt)))
-> CollectPadsClipFunction_WithClosures
-> Ptr CollectPads
-> Ptr CollectData
-> Ptr Buffer
-> Ptr (Ptr Buffer)
-> Ptr ()
-> IO CInt
GstBase.Callbacks.wrap_CollectPadsClipFunction Maybe
  (Ptr
     (FunPtr
        (Ptr CollectPads
         -> Ptr CollectData
         -> Ptr Buffer
         -> Ptr (Ptr Buffer)
         -> Ptr ()
         -> IO CInt)))
forall a. Maybe a
Nothing (CollectPadsClipFunction -> CollectPadsClipFunction_WithClosures
GstBase.Callbacks.drop_closures_CollectPadsClipFunction CollectPadsClipFunction
clipfunc))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr CollectPads
-> FunPtr
     (Ptr CollectPads
      -> Ptr CollectData
      -> Ptr Buffer
      -> Ptr (Ptr Buffer)
      -> Ptr ()
      -> IO CInt)
-> Ptr ()
-> IO ()
gst_collect_pads_set_clip_function Ptr CollectPads
pads' FunPtr
  (Ptr CollectPads
   -> Ptr CollectData
   -> Ptr Buffer
   -> Ptr (Ptr Buffer)
   -> Ptr ()
   -> IO CInt)
clipfunc' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr
  (Ptr CollectPads
   -> Ptr CollectData
   -> Ptr Buffer
   -> Ptr (Ptr Buffer)
   -> Ptr ()
   -> IO CInt)
-> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr
  (Ptr CollectPads
   -> Ptr CollectData
   -> Ptr Buffer
   -> Ptr (Ptr Buffer)
   -> Ptr ()
   -> IO CInt)
clipfunc'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectPadsSetClipFunctionMethodInfo
instance (signature ~ (GstBase.Callbacks.CollectPadsClipFunction -> m ()), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsSetClipFunctionMethodInfo a signature where
    overloadedMethod = collectPadsSetClipFunction

#endif

-- method CollectPads::set_compare_function
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the pads to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstBase" , name = "CollectPadsCompareFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the function to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_set_compare_function" gst_collect_pads_set_compare_function :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    FunPtr GstBase.Callbacks.C_CollectPadsCompareFunction -> -- func : TInterface (Name {namespace = "GstBase", name = "CollectPadsCompareFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Set the timestamp comparison function.
-- 
-- MT safe.
collectPadsSetCompareFunction ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the pads to use
    -> GstBase.Callbacks.CollectPadsCompareFunction
    -- ^ /@func@/: the function to set
    -> m ()
collectPadsSetCompareFunction :: a -> CollectPadsCompareFunction -> m ()
collectPadsSetCompareFunction a
pads CollectPadsCompareFunction
func = 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 CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    FunPtr C_CollectPadsCompareFunction
func' <- C_CollectPadsCompareFunction
-> IO (FunPtr C_CollectPadsCompareFunction)
GstBase.Callbacks.mk_CollectPadsCompareFunction (Maybe (Ptr (FunPtr C_CollectPadsCompareFunction))
-> CollectPadsCompareFunction_WithClosures
-> C_CollectPadsCompareFunction
GstBase.Callbacks.wrap_CollectPadsCompareFunction Maybe (Ptr (FunPtr C_CollectPadsCompareFunction))
forall a. Maybe a
Nothing (CollectPadsCompareFunction
-> CollectPadsCompareFunction_WithClosures
GstBase.Callbacks.drop_closures_CollectPadsCompareFunction CollectPadsCompareFunction
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr CollectPads
-> FunPtr C_CollectPadsCompareFunction -> Ptr () -> IO ()
gst_collect_pads_set_compare_function Ptr CollectPads
pads' FunPtr C_CollectPadsCompareFunction
func' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_CollectPadsCompareFunction -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CollectPadsCompareFunction
func'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectPadsSetCompareFunctionMethodInfo
instance (signature ~ (GstBase.Callbacks.CollectPadsCompareFunction -> m ()), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsSetCompareFunctionMethodInfo a signature where
    overloadedMethod = collectPadsSetCompareFunction

#endif

-- method CollectPads::set_event_function
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "GstBase" , name = "CollectPadsEventFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the function to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_set_event_function" gst_collect_pads_set_event_function :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    FunPtr GstBase.Callbacks.C_CollectPadsEventFunction -> -- func : TInterface (Name {namespace = "GstBase", name = "CollectPadsEventFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Set the event callback function and user data that will be called when
-- collectpads has received an event originating from one of the collected
-- pads.  If the event being processed is a serialized one, this callback is
-- called with /@pads@/ STREAM_LOCK held, otherwise not.  As this lock should be
-- held when calling a number of CollectPads functions, it should be acquired
-- if so (unusually) needed.
-- 
-- MT safe.
collectPadsSetEventFunction ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to use
    -> GstBase.Callbacks.CollectPadsEventFunction
    -- ^ /@func@/: the function to set
    -> m ()
collectPadsSetEventFunction :: a -> CollectPadsEventFunction -> m ()
collectPadsSetEventFunction a
pads CollectPadsEventFunction
func = 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 CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    FunPtr C_CollectPadsEventFunction
func' <- C_CollectPadsEventFunction
-> IO (FunPtr C_CollectPadsEventFunction)
GstBase.Callbacks.mk_CollectPadsEventFunction (Maybe (Ptr (FunPtr C_CollectPadsEventFunction))
-> CollectPadsEventFunction_WithClosures
-> C_CollectPadsEventFunction
GstBase.Callbacks.wrap_CollectPadsEventFunction Maybe (Ptr (FunPtr C_CollectPadsEventFunction))
forall a. Maybe a
Nothing (CollectPadsEventFunction -> CollectPadsEventFunction_WithClosures
GstBase.Callbacks.drop_closures_CollectPadsEventFunction CollectPadsEventFunction
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr CollectPads
-> FunPtr C_CollectPadsEventFunction -> Ptr () -> IO ()
gst_collect_pads_set_event_function Ptr CollectPads
pads' FunPtr C_CollectPadsEventFunction
func' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_CollectPadsEventFunction -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CollectPadsEventFunction
func'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectPadsSetEventFunctionMethodInfo
instance (signature ~ (GstBase.Callbacks.CollectPadsEventFunction -> m ()), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsSetEventFunctionMethodInfo a signature where
    overloadedMethod = collectPadsSetEventFunction

#endif

-- method CollectPads::set_flush_function
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "GstBase" , name = "CollectPadsFlushFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flush function to install"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to @func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_set_flush_function" gst_collect_pads_set_flush_function :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    FunPtr GstBase.Callbacks.C_CollectPadsFlushFunction -> -- func : TInterface (Name {namespace = "GstBase", name = "CollectPadsFlushFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Install a flush function that is called when the internal
-- state of all pads should be flushed as part of flushing seek
-- handling. See t'GI.GstBase.Callbacks.CollectPadsFlushFunction' for more info.
-- 
-- /Since: 1.4/
collectPadsSetFlushFunction ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to use
    -> GstBase.Callbacks.CollectPadsFlushFunction
    -- ^ /@func@/: flush function to install
    -> m ()
collectPadsSetFlushFunction :: a -> CollectPadsFlushFunction -> m ()
collectPadsSetFlushFunction a
pads CollectPadsFlushFunction
func = 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 CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    FunPtr C_CollectPadsFlushFunction
func' <- C_CollectPadsFlushFunction
-> IO (FunPtr C_CollectPadsFlushFunction)
GstBase.Callbacks.mk_CollectPadsFlushFunction (Maybe (Ptr (FunPtr C_CollectPadsFlushFunction))
-> CollectPadsFlushFunction_WithClosures
-> C_CollectPadsFlushFunction
GstBase.Callbacks.wrap_CollectPadsFlushFunction Maybe (Ptr (FunPtr C_CollectPadsFlushFunction))
forall a. Maybe a
Nothing (CollectPadsFlushFunction -> CollectPadsFlushFunction_WithClosures
GstBase.Callbacks.drop_closures_CollectPadsFlushFunction CollectPadsFlushFunction
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr CollectPads
-> FunPtr C_CollectPadsFlushFunction -> Ptr () -> IO ()
gst_collect_pads_set_flush_function Ptr CollectPads
pads' FunPtr C_CollectPadsFlushFunction
func' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_CollectPadsFlushFunction -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CollectPadsFlushFunction
func'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectPadsSetFlushFunctionMethodInfo
instance (signature ~ (GstBase.Callbacks.CollectPadsFlushFunction -> m ()), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsSetFlushFunctionMethodInfo a signature where
    overloadedMethod = collectPadsSetFlushFunction

#endif

-- method CollectPads::set_flushing
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to use"
--                 , 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 "desired state of the pads"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_set_flushing" gst_collect_pads_set_flushing :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    CInt ->                                 -- flushing : TBasicType TBoolean
    IO ()

-- | Change the flushing state of all the pads in the collection. No pad
-- is able to accept anymore data when /@flushing@/ is 'P.True'. Calling this
-- function with /@flushing@/ 'P.False' makes /@pads@/ accept data again.
-- Caller must ensure that downstream streaming (thread) is not blocked,
-- e.g. by sending a FLUSH_START downstream.
-- 
-- MT safe.
collectPadsSetFlushing ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to use
    -> Bool
    -- ^ /@flushing@/: desired state of the pads
    -> m ()
collectPadsSetFlushing :: a -> Bool -> m ()
collectPadsSetFlushing a
pads 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 CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    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 CollectPads -> CInt -> IO ()
gst_collect_pads_set_flushing Ptr CollectPads
pads' CInt
flushing'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectPadsSetFlushingMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsSetFlushingMethodInfo a signature where
    overloadedMethod = collectPadsSetFlushing

#endif

-- method CollectPads::set_function
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "GstBase" , name = "CollectPadsFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the function to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_set_function" gst_collect_pads_set_function :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    FunPtr GstBase.Callbacks.C_CollectPadsFunction -> -- func : TInterface (Name {namespace = "GstBase", name = "CollectPadsFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | CollectPads provides a default collection algorithm that will determine
-- the oldest buffer available on all of its pads, and then delegate
-- to a configured callback.
-- However, if circumstances are more complicated and\/or more control
-- is desired, this sets a callback that will be invoked instead when
-- all the pads added to the collection have buffers queued.
-- Evidently, this callback is not compatible with
-- 'GI.GstBase.Objects.CollectPads.collectPadsSetBufferFunction' callback.
-- If this callback is set, the former will be unset.
-- 
-- MT safe.
collectPadsSetFunction ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to use
    -> GstBase.Callbacks.CollectPadsFunction
    -- ^ /@func@/: the function to set
    -> m ()
collectPadsSetFunction :: a -> CollectPadsFunction -> m ()
collectPadsSetFunction a
pads CollectPadsFunction
func = 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 CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    FunPtr C_CollectPadsFunction
func' <- C_CollectPadsFunction -> IO (FunPtr C_CollectPadsFunction)
GstBase.Callbacks.mk_CollectPadsFunction (Maybe (Ptr (FunPtr C_CollectPadsFunction))
-> CollectPadsFunction_WithClosures -> C_CollectPadsFunction
GstBase.Callbacks.wrap_CollectPadsFunction Maybe (Ptr (FunPtr C_CollectPadsFunction))
forall a. Maybe a
Nothing (CollectPadsFunction -> CollectPadsFunction_WithClosures
GstBase.Callbacks.drop_closures_CollectPadsFunction CollectPadsFunction
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr CollectPads -> FunPtr C_CollectPadsFunction -> Ptr () -> IO ()
gst_collect_pads_set_function Ptr CollectPads
pads' FunPtr C_CollectPadsFunction
func' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_CollectPadsFunction -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CollectPadsFunction
func'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectPadsSetFunctionMethodInfo
instance (signature ~ (GstBase.Callbacks.CollectPadsFunction -> m ()), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsSetFunctionMethodInfo a signature where
    overloadedMethod = collectPadsSetFunction

#endif

-- method CollectPads::set_query_function
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "GstBase" , name = "CollectPadsQueryFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the function to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_set_query_function" gst_collect_pads_set_query_function :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    FunPtr GstBase.Callbacks.C_CollectPadsQueryFunction -> -- func : TInterface (Name {namespace = "GstBase", name = "CollectPadsQueryFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Set the query callback function and user data that will be called after
-- collectpads has received a query originating from one of the collected
-- pads.  If the query being processed is a serialized one, this callback is
-- called with /@pads@/ STREAM_LOCK held, otherwise not.  As this lock should be
-- held when calling a number of CollectPads functions, it should be acquired
-- if so (unusually) needed.
-- 
-- MT safe.
collectPadsSetQueryFunction ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to use
    -> GstBase.Callbacks.CollectPadsQueryFunction
    -- ^ /@func@/: the function to set
    -> m ()
collectPadsSetQueryFunction :: a -> CollectPadsQueryFunction -> m ()
collectPadsSetQueryFunction a
pads CollectPadsQueryFunction
func = 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 CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    FunPtr C_CollectPadsQueryFunction
func' <- C_CollectPadsQueryFunction
-> IO (FunPtr C_CollectPadsQueryFunction)
GstBase.Callbacks.mk_CollectPadsQueryFunction (Maybe (Ptr (FunPtr C_CollectPadsQueryFunction))
-> CollectPadsQueryFunction_WithClosures
-> C_CollectPadsQueryFunction
GstBase.Callbacks.wrap_CollectPadsQueryFunction Maybe (Ptr (FunPtr C_CollectPadsQueryFunction))
forall a. Maybe a
Nothing (CollectPadsQueryFunction -> CollectPadsQueryFunction_WithClosures
GstBase.Callbacks.drop_closures_CollectPadsQueryFunction CollectPadsQueryFunction
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr CollectPads
-> FunPtr C_CollectPadsQueryFunction -> Ptr () -> IO ()
gst_collect_pads_set_query_function Ptr CollectPads
pads' FunPtr C_CollectPadsQueryFunction
func' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_CollectPadsQueryFunction -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CollectPadsQueryFunction
func'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectPadsSetQueryFunctionMethodInfo
instance (signature ~ (GstBase.Callbacks.CollectPadsQueryFunction -> m ()), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsSetQueryFunctionMethodInfo a signature where
    overloadedMethod = collectPadsSetQueryFunction

#endif

-- method CollectPads::set_waiting
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "waiting"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "boolean indicating whether this pad should operate\n          in waiting or non-waiting mode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_set_waiting" gst_collect_pads_set_waiting :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    Ptr GstBase.CollectData.CollectData ->  -- data : TInterface (Name {namespace = "GstBase", name = "CollectData"})
    CInt ->                                 -- waiting : TBasicType TBoolean
    IO ()

-- | Sets a pad to waiting or non-waiting mode, if at least this pad
-- has not been created with locked waiting state,
-- in which case nothing happens.
-- 
-- This function should be called with /@pads@/ STREAM_LOCK held, such as
-- in the callback.
-- 
-- MT safe.
collectPadsSetWaiting ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads
    -> GstBase.CollectData.CollectData
    -- ^ /@data@/: the data to use
    -> Bool
    -- ^ /@waiting@/: boolean indicating whether this pad should operate
    --           in waiting or non-waiting mode
    -> m ()
collectPadsSetWaiting :: a -> CollectData -> Bool -> m ()
collectPadsSetWaiting a
pads CollectData
data_ Bool
waiting = 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 CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    Ptr CollectData
data_' <- CollectData -> IO (Ptr CollectData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CollectData
data_
    let waiting' :: CInt
waiting' = (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
waiting
    Ptr CollectPads -> Ptr CollectData -> CInt -> IO ()
gst_collect_pads_set_waiting Ptr CollectPads
pads' Ptr CollectData
data_' CInt
waiting'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    CollectDataDestroyNotify
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CollectData
data_
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectPadsSetWaitingMethodInfo
instance (signature ~ (GstBase.CollectData.CollectData -> Bool -> m ()), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsSetWaitingMethodInfo a signature where
    overloadedMethod = collectPadsSetWaiting

#endif

-- method CollectPads::src_event_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCollectPads to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "src #GstPad that received the event"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gst" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "event being processed"
--                 , 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_collect_pads_src_event_default" gst_collect_pads_src_event_default :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    Ptr Gst.Pad.Pad ->                      -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Event.Event ->                  -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    IO CInt

-- | Default t'GI.GstBase.Objects.CollectPads.CollectPads' event handling for the src pad of elements.
-- Elements can chain up to this to let flushing seek event handling
-- be done by t'GI.GstBase.Objects.CollectPads.CollectPads'.
-- 
-- /Since: 1.4/
collectPadsSrcEventDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a, Gst.Pad.IsPad b) =>
    a
    -- ^ /@pads@/: the t'GI.GstBase.Objects.CollectPads.CollectPads' to use
    -> b
    -- ^ /@pad@/: src t'GI.Gst.Objects.Pad.Pad' that received the event
    -> Gst.Event.Event
    -- ^ /@event@/: event being processed
    -> m Bool
collectPadsSrcEventDefault :: a -> b -> Event -> m Bool
collectPadsSrcEventDefault a
pads b
pad Event
event = 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 CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    Ptr Pad
pad' <- b -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pad
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    CInt
result <- Ptr CollectPads -> Ptr Pad -> Ptr Event -> IO CInt
gst_collect_pads_src_event_default Ptr CollectPads
pads' Ptr Pad
pad' Ptr Event
event'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pad
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CollectPadsSrcEventDefaultMethodInfo
instance (signature ~ (b -> Gst.Event.Event -> m Bool), MonadIO m, IsCollectPads a, Gst.Pad.IsPad b) => O.MethodInfo CollectPadsSrcEventDefaultMethodInfo a signature where
    overloadedMethod = collectPadsSrcEventDefault

#endif

-- method CollectPads::start
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_start" gst_collect_pads_start :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    IO ()

-- | Starts the processing of data in the collect_pads.
-- 
-- MT safe.
collectPadsStart ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to use
    -> m ()
collectPadsStart :: a -> m ()
collectPadsStart a
pads = 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 CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    Ptr CollectPads -> IO ()
gst_collect_pads_start Ptr CollectPads
pads'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectPadsStartMethodInfo
instance (signature ~ (m ()), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsStartMethodInfo a signature where
    overloadedMethod = collectPadsStart

#endif

-- method CollectPads::stop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_stop" gst_collect_pads_stop :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    IO ()

-- | Stops the processing of data in the collect_pads. this function
-- will also unblock any blocking operations.
-- 
-- MT safe.
collectPadsStop ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to use
    -> m ()
collectPadsStop :: a -> m ()
collectPadsStop a
pads = 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 CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    Ptr CollectPads -> IO ()
gst_collect_pads_stop Ptr CollectPads
pads'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CollectPadsStopMethodInfo
instance (signature ~ (m ()), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsStopMethodInfo a signature where
    overloadedMethod = collectPadsStop

#endif

-- method CollectPads::take_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pads"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectPads" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collectpads to query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "CollectData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes to read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_collect_pads_take_buffer" gst_collect_pads_take_buffer :: 
    Ptr CollectPads ->                      -- pads : TInterface (Name {namespace = "GstBase", name = "CollectPads"})
    Ptr GstBase.CollectData.CollectData ->  -- data : TInterface (Name {namespace = "GstBase", name = "CollectData"})
    Word32 ->                               -- size : TBasicType TUInt
    IO (Ptr Gst.Buffer.Buffer)

-- | Get a subbuffer of /@size@/ bytes from the given pad /@data@/. Flushes the amount
-- of read bytes.
-- 
-- This function should be called with /@pads@/ STREAM_LOCK held, such as in the
-- callback.
-- 
-- MT safe.
collectPadsTakeBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsCollectPads a) =>
    a
    -- ^ /@pads@/: the collectpads to query
    -> GstBase.CollectData.CollectData
    -- ^ /@data@/: the data to use
    -> Word32
    -- ^ /@size@/: the number of bytes to read
    -> m (Maybe Gst.Buffer.Buffer)
    -- ^ __Returns:__ A sub buffer. The size of the buffer can
    -- be less that requested. A return of 'P.Nothing' signals that the pad is
    -- end-of-stream. Unref the buffer after use.
collectPadsTakeBuffer :: a -> CollectData -> Word32 -> m (Maybe Buffer)
collectPadsTakeBuffer a
pads CollectData
data_ Word32
size = IO (Maybe Buffer) -> m (Maybe Buffer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Buffer) -> m (Maybe Buffer))
-> IO (Maybe Buffer) -> m (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CollectPads
pads' <- a -> IO (Ptr CollectPads)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pads
    Ptr CollectData
data_' <- CollectData -> IO (Ptr CollectData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CollectData
data_
    Ptr Buffer
result <- Ptr CollectPads -> Ptr CollectData -> Word32 -> IO (Ptr Buffer)
gst_collect_pads_take_buffer Ptr CollectPads
pads' Ptr CollectData
data_' Word32
size
    Maybe Buffer
maybeResult <- Ptr Buffer -> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Buffer
result ((Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer))
-> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
result' -> do
        Buffer
result'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
result'
        Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pads
    CollectDataDestroyNotify
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CollectData
data_
    Maybe Buffer -> IO (Maybe Buffer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
maybeResult

#if defined(ENABLE_OVERLOADING)
data CollectPadsTakeBufferMethodInfo
instance (signature ~ (GstBase.CollectData.CollectData -> Word32 -> m (Maybe Gst.Buffer.Buffer)), MonadIO m, IsCollectPads a) => O.MethodInfo CollectPadsTakeBufferMethodInfo a signature where
    overloadedMethod = collectPadsTakeBuffer

#endif