{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Pads managed by a t'GI.GstBase.Objects.Aggregator.Aggregator' subclass.
-- 
-- This class used to live in gst-plugins-bad and was moved to core.
-- 
-- /Since: 1.14/

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

module GI.GstBase.Objects.AggregatorPad
    ( 

-- * Exported types
    AggregatorPad(..)                       ,
    IsAggregatorPad                         ,
    toAggregatorPad                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [activateMode]("GI.Gst.Objects.Pad#g:method:activateMode"), [addControlBinding]("GI.Gst.Objects.Object#g:method:addControlBinding"), [addProbe]("GI.Gst.Objects.Pad#g:method:addProbe"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [canLink]("GI.Gst.Objects.Pad#g:method:canLink"), [chain]("GI.Gst.Objects.Pad#g:method:chain"), [chainList]("GI.Gst.Objects.Pad#g:method:chainList"), [checkReconfigure]("GI.Gst.Objects.Pad#g:method:checkReconfigure"), [createStreamId]("GI.Gst.Objects.Pad#g:method:createStreamId"), [defaultError]("GI.Gst.Objects.Object#g:method:defaultError"), [dropBuffer]("GI.GstBase.Objects.AggregatorPad#g:method:dropBuffer"), [eventDefault]("GI.Gst.Objects.Pad#g:method:eventDefault"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [forward]("GI.Gst.Objects.Pad#g:method:forward"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasActiveControlBindings]("GI.Gst.Objects.Object#g:method:hasActiveControlBindings"), [hasAncestor]("GI.Gst.Objects.Object#g:method:hasAncestor"), [hasAsAncestor]("GI.Gst.Objects.Object#g:method:hasAsAncestor"), [hasAsParent]("GI.Gst.Objects.Object#g:method:hasAsParent"), [hasBuffer]("GI.GstBase.Objects.AggregatorPad#g:method:hasBuffer"), [hasCurrentCaps]("GI.Gst.Objects.Pad#g:method:hasCurrentCaps"), [isActive]("GI.Gst.Objects.Pad#g:method:isActive"), [isBlocked]("GI.Gst.Objects.Pad#g:method:isBlocked"), [isBlocking]("GI.Gst.Objects.Pad#g:method:isBlocking"), [isEos]("GI.GstBase.Objects.AggregatorPad#g:method:isEos"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isInactive]("GI.GstBase.Objects.AggregatorPad#g:method:isInactive"), [isLinked]("GI.Gst.Objects.Pad#g:method:isLinked"), [iterateInternalLinks]("GI.Gst.Objects.Pad#g:method:iterateInternalLinks"), [iterateInternalLinksDefault]("GI.Gst.Objects.Pad#g:method:iterateInternalLinksDefault"), [link]("GI.Gst.Objects.Pad#g:method:link"), [linkFull]("GI.Gst.Objects.Pad#g:method:linkFull"), [linkMaybeGhosting]("GI.Gst.Objects.Pad#g:method:linkMaybeGhosting"), [linkMaybeGhostingFull]("GI.Gst.Objects.Pad#g:method:linkMaybeGhostingFull"), [markReconfigure]("GI.Gst.Objects.Pad#g:method:markReconfigure"), [needsReconfigure]("GI.Gst.Objects.Pad#g:method:needsReconfigure"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [pauseTask]("GI.Gst.Objects.Pad#g:method:pauseTask"), [peekBuffer]("GI.GstBase.Objects.AggregatorPad#g:method:peekBuffer"), [peerQuery]("GI.Gst.Objects.Pad#g:method:peerQuery"), [peerQueryAcceptCaps]("GI.Gst.Objects.Pad#g:method:peerQueryAcceptCaps"), [peerQueryCaps]("GI.Gst.Objects.Pad#g:method:peerQueryCaps"), [peerQueryConvert]("GI.Gst.Objects.Pad#g:method:peerQueryConvert"), [peerQueryDuration]("GI.Gst.Objects.Pad#g:method:peerQueryDuration"), [peerQueryPosition]("GI.Gst.Objects.Pad#g:method:peerQueryPosition"), [popBuffer]("GI.GstBase.Objects.AggregatorPad#g:method:popBuffer"), [proxyQueryAcceptCaps]("GI.Gst.Objects.Pad#g:method:proxyQueryAcceptCaps"), [proxyQueryCaps]("GI.Gst.Objects.Pad#g:method:proxyQueryCaps"), [pullRange]("GI.Gst.Objects.Pad#g:method:pullRange"), [push]("GI.Gst.Objects.Pad#g:method:push"), [pushEvent]("GI.Gst.Objects.Pad#g:method:pushEvent"), [pushList]("GI.Gst.Objects.Pad#g:method:pushList"), [query]("GI.Gst.Objects.Pad#g:method:query"), [queryAcceptCaps]("GI.Gst.Objects.Pad#g:method:queryAcceptCaps"), [queryCaps]("GI.Gst.Objects.Pad#g:method:queryCaps"), [queryConvert]("GI.Gst.Objects.Pad#g:method:queryConvert"), [queryDefault]("GI.Gst.Objects.Pad#g:method:queryDefault"), [queryDuration]("GI.Gst.Objects.Pad#g:method:queryDuration"), [queryPosition]("GI.Gst.Objects.Pad#g:method:queryPosition"), [ref]("GI.Gst.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeControlBinding]("GI.Gst.Objects.Object#g:method:removeControlBinding"), [removeProbe]("GI.Gst.Objects.Pad#g:method:removeProbe"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [sendEvent]("GI.Gst.Objects.Pad#g:method:sendEvent"), [startTask]("GI.Gst.Objects.Pad#g:method:startTask"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [stickyEventsForeach]("GI.Gst.Objects.Pad#g:method:stickyEventsForeach"), [stopTask]("GI.Gst.Objects.Pad#g:method:stopTask"), [storeStickyEvent]("GI.Gst.Objects.Pad#g:method:storeStickyEvent"), [suggestNextSync]("GI.Gst.Objects.Object#g:method:suggestNextSync"), [syncValues]("GI.Gst.Objects.Object#g:method:syncValues"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unlink]("GI.Gst.Objects.Pad#g:method:unlink"), [unparent]("GI.Gst.Objects.Object#g:method:unparent"), [unref]("GI.Gst.Objects.Object#g:method:unref"), [useFixedCaps]("GI.Gst.Objects.Pad#g:method:useFixedCaps"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAllowedCaps]("GI.Gst.Objects.Pad#g:method:getAllowedCaps"), [getControlBinding]("GI.Gst.Objects.Object#g:method:getControlBinding"), [getControlRate]("GI.Gst.Objects.Object#g:method:getControlRate"), [getCurrentCaps]("GI.Gst.Objects.Pad#g:method:getCurrentCaps"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDirection]("GI.Gst.Objects.Pad#g:method:getDirection"), [getElementPrivate]("GI.Gst.Objects.Pad#g:method:getElementPrivate"), [getGValueArray]("GI.Gst.Objects.Object#g:method:getGValueArray"), [getLastFlowReturn]("GI.Gst.Objects.Pad#g:method:getLastFlowReturn"), [getName]("GI.Gst.Objects.Object#g:method:getName"), [getOffset]("GI.Gst.Objects.Pad#g:method:getOffset"), [getPadTemplate]("GI.Gst.Objects.Pad#g:method:getPadTemplate"), [getPadTemplateCaps]("GI.Gst.Objects.Pad#g:method:getPadTemplateCaps"), [getParent]("GI.Gst.Objects.Object#g:method:getParent"), [getParentElement]("GI.Gst.Objects.Pad#g:method:getParentElement"), [getPathString]("GI.Gst.Objects.Object#g:method:getPathString"), [getPeer]("GI.Gst.Objects.Pad#g:method:getPeer"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRange]("GI.Gst.Objects.Pad#g:method:getRange"), [getSingleInternalLink]("GI.Gst.Objects.Pad#g:method:getSingleInternalLink"), [getStickyEvent]("GI.Gst.Objects.Pad#g:method:getStickyEvent"), [getStream]("GI.Gst.Objects.Pad#g:method:getStream"), [getStreamId]("GI.Gst.Objects.Pad#g:method:getStreamId"), [getTaskState]("GI.Gst.Objects.Pad#g:method:getTaskState"), [getValue]("GI.Gst.Objects.Object#g:method:getValue").
-- 
-- ==== Setters
-- [setActivateFunctionFull]("GI.Gst.Objects.Pad#g:method:setActivateFunctionFull"), [setActivatemodeFunctionFull]("GI.Gst.Objects.Pad#g:method:setActivatemodeFunctionFull"), [setActive]("GI.Gst.Objects.Pad#g:method:setActive"), [setChainFunctionFull]("GI.Gst.Objects.Pad#g:method:setChainFunctionFull"), [setChainListFunctionFull]("GI.Gst.Objects.Pad#g:method:setChainListFunctionFull"), [setControlBindingDisabled]("GI.Gst.Objects.Object#g:method:setControlBindingDisabled"), [setControlBindingsDisabled]("GI.Gst.Objects.Object#g:method:setControlBindingsDisabled"), [setControlRate]("GI.Gst.Objects.Object#g:method:setControlRate"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setElementPrivate]("GI.Gst.Objects.Pad#g:method:setElementPrivate"), [setEventFullFunctionFull]("GI.Gst.Objects.Pad#g:method:setEventFullFunctionFull"), [setEventFunctionFull]("GI.Gst.Objects.Pad#g:method:setEventFunctionFull"), [setGetrangeFunctionFull]("GI.Gst.Objects.Pad#g:method:setGetrangeFunctionFull"), [setIterateInternalLinksFunctionFull]("GI.Gst.Objects.Pad#g:method:setIterateInternalLinksFunctionFull"), [setLinkFunctionFull]("GI.Gst.Objects.Pad#g:method:setLinkFunctionFull"), [setName]("GI.Gst.Objects.Object#g:method:setName"), [setOffset]("GI.Gst.Objects.Pad#g:method:setOffset"), [setParent]("GI.Gst.Objects.Object#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setQueryFunctionFull]("GI.Gst.Objects.Pad#g:method:setQueryFunctionFull"), [setUnlinkFunctionFull]("GI.Gst.Objects.Pad#g:method:setUnlinkFunctionFull").

#if defined(ENABLE_OVERLOADING)
    ResolveAggregatorPadMethod              ,
#endif

-- ** dropBuffer #method:dropBuffer#

#if defined(ENABLE_OVERLOADING)
    AggregatorPadDropBufferMethodInfo       ,
#endif
    aggregatorPadDropBuffer                 ,


-- ** hasBuffer #method:hasBuffer#

#if defined(ENABLE_OVERLOADING)
    AggregatorPadHasBufferMethodInfo        ,
#endif
    aggregatorPadHasBuffer                  ,


-- ** isEos #method:isEos#

#if defined(ENABLE_OVERLOADING)
    AggregatorPadIsEosMethodInfo            ,
#endif
    aggregatorPadIsEos                      ,


-- ** isInactive #method:isInactive#

#if defined(ENABLE_OVERLOADING)
    AggregatorPadIsInactiveMethodInfo       ,
#endif
    aggregatorPadIsInactive                 ,


-- ** peekBuffer #method:peekBuffer#

#if defined(ENABLE_OVERLOADING)
    AggregatorPadPeekBufferMethodInfo       ,
#endif
    aggregatorPadPeekBuffer                 ,


-- ** popBuffer #method:popBuffer#

#if defined(ENABLE_OVERLOADING)
    AggregatorPadPopBufferMethodInfo        ,
#endif
    aggregatorPadPopBuffer                  ,




 -- * Properties


-- ** emitSignals #attr:emitSignals#
-- | Enables the emission of signals such as [AggregatorPad::bufferConsumed]("GI.GstBase.Objects.AggregatorPad#g:signal:bufferConsumed")
-- 
-- /Since: 1.16/

#if defined(ENABLE_OVERLOADING)
    AggregatorPadEmitSignalsPropertyInfo    ,
#endif
#if defined(ENABLE_OVERLOADING)
    aggregatorPadEmitSignals                ,
#endif
    constructAggregatorPadEmitSignals       ,
    getAggregatorPadEmitSignals             ,
    setAggregatorPadEmitSignals             ,




 -- * Signals


-- ** bufferConsumed #signal:bufferConsumed#

    AggregatorPadBufferConsumedCallback     ,
#if defined(ENABLE_OVERLOADING)
    AggregatorPadBufferConsumedSignalInfo   ,
#endif
    afterAggregatorPadBufferConsumed        ,
    onAggregatorPadBufferConsumed           ,




    ) 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.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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.Coerce as Coerce
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 GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
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

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

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

foreign import ccall "gst_aggregator_pad_get_type"
    c_gst_aggregator_pad_get_type :: IO B.Types.GType

instance B.Types.TypedObject AggregatorPad where
    glibType :: IO GType
glibType = IO GType
c_gst_aggregator_pad_get_type

instance B.Types.GObject AggregatorPad

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

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

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

-- | Convert 'AggregatorPad' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe AggregatorPad) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_aggregator_pad_get_type
    gvalueSet_ :: Ptr GValue -> Maybe AggregatorPad -> IO ()
gvalueSet_ Ptr GValue
gv Maybe AggregatorPad
P.Nothing = Ptr GValue -> Ptr AggregatorPad -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr AggregatorPad
forall a. Ptr a
FP.nullPtr :: FP.Ptr AggregatorPad)
    gvalueSet_ Ptr GValue
gv (P.Just AggregatorPad
obj) = AggregatorPad -> (Ptr AggregatorPad -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr AggregatorPad
obj (Ptr GValue -> Ptr AggregatorPad -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe AggregatorPad)
gvalueGet_ Ptr GValue
gv = do
        Ptr AggregatorPad
ptr <- Ptr GValue -> IO (Ptr AggregatorPad)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr AggregatorPad)
        if Ptr AggregatorPad
ptr Ptr AggregatorPad -> Ptr AggregatorPad -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr AggregatorPad
forall a. Ptr a
FP.nullPtr
        then AggregatorPad -> Maybe AggregatorPad
forall a. a -> Maybe a
P.Just (AggregatorPad -> Maybe AggregatorPad)
-> IO AggregatorPad -> IO (Maybe AggregatorPad)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr AggregatorPad -> AggregatorPad)
-> Ptr AggregatorPad -> IO AggregatorPad
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr AggregatorPad -> AggregatorPad
AggregatorPad Ptr AggregatorPad
ptr
        else Maybe AggregatorPad -> IO (Maybe AggregatorPad)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AggregatorPad
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveAggregatorPadMethod (t :: Symbol) (o :: *) :: * where
    ResolveAggregatorPadMethod "activateMode" o = Gst.Pad.PadActivateModeMethodInfo
    ResolveAggregatorPadMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveAggregatorPadMethod "addProbe" o = Gst.Pad.PadAddProbeMethodInfo
    ResolveAggregatorPadMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAggregatorPadMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAggregatorPadMethod "canLink" o = Gst.Pad.PadCanLinkMethodInfo
    ResolveAggregatorPadMethod "chain" o = Gst.Pad.PadChainMethodInfo
    ResolveAggregatorPadMethod "chainList" o = Gst.Pad.PadChainListMethodInfo
    ResolveAggregatorPadMethod "checkReconfigure" o = Gst.Pad.PadCheckReconfigureMethodInfo
    ResolveAggregatorPadMethod "createStreamId" o = Gst.Pad.PadCreateStreamIdMethodInfo
    ResolveAggregatorPadMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveAggregatorPadMethod "dropBuffer" o = AggregatorPadDropBufferMethodInfo
    ResolveAggregatorPadMethod "eventDefault" o = Gst.Pad.PadEventDefaultMethodInfo
    ResolveAggregatorPadMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAggregatorPadMethod "forward" o = Gst.Pad.PadForwardMethodInfo
    ResolveAggregatorPadMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAggregatorPadMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAggregatorPadMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveAggregatorPadMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveAggregatorPadMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveAggregatorPadMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveAggregatorPadMethod "hasBuffer" o = AggregatorPadHasBufferMethodInfo
    ResolveAggregatorPadMethod "hasCurrentCaps" o = Gst.Pad.PadHasCurrentCapsMethodInfo
    ResolveAggregatorPadMethod "isActive" o = Gst.Pad.PadIsActiveMethodInfo
    ResolveAggregatorPadMethod "isBlocked" o = Gst.Pad.PadIsBlockedMethodInfo
    ResolveAggregatorPadMethod "isBlocking" o = Gst.Pad.PadIsBlockingMethodInfo
    ResolveAggregatorPadMethod "isEos" o = AggregatorPadIsEosMethodInfo
    ResolveAggregatorPadMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAggregatorPadMethod "isInactive" o = AggregatorPadIsInactiveMethodInfo
    ResolveAggregatorPadMethod "isLinked" o = Gst.Pad.PadIsLinkedMethodInfo
    ResolveAggregatorPadMethod "iterateInternalLinks" o = Gst.Pad.PadIterateInternalLinksMethodInfo
    ResolveAggregatorPadMethod "iterateInternalLinksDefault" o = Gst.Pad.PadIterateInternalLinksDefaultMethodInfo
    ResolveAggregatorPadMethod "link" o = Gst.Pad.PadLinkMethodInfo
    ResolveAggregatorPadMethod "linkFull" o = Gst.Pad.PadLinkFullMethodInfo
    ResolveAggregatorPadMethod "linkMaybeGhosting" o = Gst.Pad.PadLinkMaybeGhostingMethodInfo
    ResolveAggregatorPadMethod "linkMaybeGhostingFull" o = Gst.Pad.PadLinkMaybeGhostingFullMethodInfo
    ResolveAggregatorPadMethod "markReconfigure" o = Gst.Pad.PadMarkReconfigureMethodInfo
    ResolveAggregatorPadMethod "needsReconfigure" o = Gst.Pad.PadNeedsReconfigureMethodInfo
    ResolveAggregatorPadMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAggregatorPadMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAggregatorPadMethod "pauseTask" o = Gst.Pad.PadPauseTaskMethodInfo
    ResolveAggregatorPadMethod "peekBuffer" o = AggregatorPadPeekBufferMethodInfo
    ResolveAggregatorPadMethod "peerQuery" o = Gst.Pad.PadPeerQueryMethodInfo
    ResolveAggregatorPadMethod "peerQueryAcceptCaps" o = Gst.Pad.PadPeerQueryAcceptCapsMethodInfo
    ResolveAggregatorPadMethod "peerQueryCaps" o = Gst.Pad.PadPeerQueryCapsMethodInfo
    ResolveAggregatorPadMethod "peerQueryConvert" o = Gst.Pad.PadPeerQueryConvertMethodInfo
    ResolveAggregatorPadMethod "peerQueryDuration" o = Gst.Pad.PadPeerQueryDurationMethodInfo
    ResolveAggregatorPadMethod "peerQueryPosition" o = Gst.Pad.PadPeerQueryPositionMethodInfo
    ResolveAggregatorPadMethod "popBuffer" o = AggregatorPadPopBufferMethodInfo
    ResolveAggregatorPadMethod "proxyQueryAcceptCaps" o = Gst.Pad.PadProxyQueryAcceptCapsMethodInfo
    ResolveAggregatorPadMethod "proxyQueryCaps" o = Gst.Pad.PadProxyQueryCapsMethodInfo
    ResolveAggregatorPadMethod "pullRange" o = Gst.Pad.PadPullRangeMethodInfo
    ResolveAggregatorPadMethod "push" o = Gst.Pad.PadPushMethodInfo
    ResolveAggregatorPadMethod "pushEvent" o = Gst.Pad.PadPushEventMethodInfo
    ResolveAggregatorPadMethod "pushList" o = Gst.Pad.PadPushListMethodInfo
    ResolveAggregatorPadMethod "query" o = Gst.Pad.PadQueryMethodInfo
    ResolveAggregatorPadMethod "queryAcceptCaps" o = Gst.Pad.PadQueryAcceptCapsMethodInfo
    ResolveAggregatorPadMethod "queryCaps" o = Gst.Pad.PadQueryCapsMethodInfo
    ResolveAggregatorPadMethod "queryConvert" o = Gst.Pad.PadQueryConvertMethodInfo
    ResolveAggregatorPadMethod "queryDefault" o = Gst.Pad.PadQueryDefaultMethodInfo
    ResolveAggregatorPadMethod "queryDuration" o = Gst.Pad.PadQueryDurationMethodInfo
    ResolveAggregatorPadMethod "queryPosition" o = Gst.Pad.PadQueryPositionMethodInfo
    ResolveAggregatorPadMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveAggregatorPadMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAggregatorPadMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveAggregatorPadMethod "removeProbe" o = Gst.Pad.PadRemoveProbeMethodInfo
    ResolveAggregatorPadMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAggregatorPadMethod "sendEvent" o = Gst.Pad.PadSendEventMethodInfo
    ResolveAggregatorPadMethod "startTask" o = Gst.Pad.PadStartTaskMethodInfo
    ResolveAggregatorPadMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAggregatorPadMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAggregatorPadMethod "stickyEventsForeach" o = Gst.Pad.PadStickyEventsForeachMethodInfo
    ResolveAggregatorPadMethod "stopTask" o = Gst.Pad.PadStopTaskMethodInfo
    ResolveAggregatorPadMethod "storeStickyEvent" o = Gst.Pad.PadStoreStickyEventMethodInfo
    ResolveAggregatorPadMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveAggregatorPadMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveAggregatorPadMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAggregatorPadMethod "unlink" o = Gst.Pad.PadUnlinkMethodInfo
    ResolveAggregatorPadMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveAggregatorPadMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveAggregatorPadMethod "useFixedCaps" o = Gst.Pad.PadUseFixedCapsMethodInfo
    ResolveAggregatorPadMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAggregatorPadMethod "getAllowedCaps" o = Gst.Pad.PadGetAllowedCapsMethodInfo
    ResolveAggregatorPadMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveAggregatorPadMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveAggregatorPadMethod "getCurrentCaps" o = Gst.Pad.PadGetCurrentCapsMethodInfo
    ResolveAggregatorPadMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAggregatorPadMethod "getDirection" o = Gst.Pad.PadGetDirectionMethodInfo
    ResolveAggregatorPadMethod "getElementPrivate" o = Gst.Pad.PadGetElementPrivateMethodInfo
    ResolveAggregatorPadMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveAggregatorPadMethod "getLastFlowReturn" o = Gst.Pad.PadGetLastFlowReturnMethodInfo
    ResolveAggregatorPadMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveAggregatorPadMethod "getOffset" o = Gst.Pad.PadGetOffsetMethodInfo
    ResolveAggregatorPadMethod "getPadTemplate" o = Gst.Pad.PadGetPadTemplateMethodInfo
    ResolveAggregatorPadMethod "getPadTemplateCaps" o = Gst.Pad.PadGetPadTemplateCapsMethodInfo
    ResolveAggregatorPadMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveAggregatorPadMethod "getParentElement" o = Gst.Pad.PadGetParentElementMethodInfo
    ResolveAggregatorPadMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveAggregatorPadMethod "getPeer" o = Gst.Pad.PadGetPeerMethodInfo
    ResolveAggregatorPadMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAggregatorPadMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAggregatorPadMethod "getRange" o = Gst.Pad.PadGetRangeMethodInfo
    ResolveAggregatorPadMethod "getSingleInternalLink" o = Gst.Pad.PadGetSingleInternalLinkMethodInfo
    ResolveAggregatorPadMethod "getStickyEvent" o = Gst.Pad.PadGetStickyEventMethodInfo
    ResolveAggregatorPadMethod "getStream" o = Gst.Pad.PadGetStreamMethodInfo
    ResolveAggregatorPadMethod "getStreamId" o = Gst.Pad.PadGetStreamIdMethodInfo
    ResolveAggregatorPadMethod "getTaskState" o = Gst.Pad.PadGetTaskStateMethodInfo
    ResolveAggregatorPadMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveAggregatorPadMethod "setActivateFunctionFull" o = Gst.Pad.PadSetActivateFunctionFullMethodInfo
    ResolveAggregatorPadMethod "setActivatemodeFunctionFull" o = Gst.Pad.PadSetActivatemodeFunctionFullMethodInfo
    ResolveAggregatorPadMethod "setActive" o = Gst.Pad.PadSetActiveMethodInfo
    ResolveAggregatorPadMethod "setChainFunctionFull" o = Gst.Pad.PadSetChainFunctionFullMethodInfo
    ResolveAggregatorPadMethod "setChainListFunctionFull" o = Gst.Pad.PadSetChainListFunctionFullMethodInfo
    ResolveAggregatorPadMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveAggregatorPadMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveAggregatorPadMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveAggregatorPadMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAggregatorPadMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAggregatorPadMethod "setElementPrivate" o = Gst.Pad.PadSetElementPrivateMethodInfo
    ResolveAggregatorPadMethod "setEventFullFunctionFull" o = Gst.Pad.PadSetEventFullFunctionFullMethodInfo
    ResolveAggregatorPadMethod "setEventFunctionFull" o = Gst.Pad.PadSetEventFunctionFullMethodInfo
    ResolveAggregatorPadMethod "setGetrangeFunctionFull" o = Gst.Pad.PadSetGetrangeFunctionFullMethodInfo
    ResolveAggregatorPadMethod "setIterateInternalLinksFunctionFull" o = Gst.Pad.PadSetIterateInternalLinksFunctionFullMethodInfo
    ResolveAggregatorPadMethod "setLinkFunctionFull" o = Gst.Pad.PadSetLinkFunctionFullMethodInfo
    ResolveAggregatorPadMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveAggregatorPadMethod "setOffset" o = Gst.Pad.PadSetOffsetMethodInfo
    ResolveAggregatorPadMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveAggregatorPadMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAggregatorPadMethod "setQueryFunctionFull" o = Gst.Pad.PadSetQueryFunctionFullMethodInfo
    ResolveAggregatorPadMethod "setUnlinkFunctionFull" o = Gst.Pad.PadSetUnlinkFunctionFullMethodInfo
    ResolveAggregatorPadMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveAggregatorPadMethod t AggregatorPad, O.OverloadedMethod info AggregatorPad p, R.HasField t AggregatorPad p) => R.HasField t AggregatorPad p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveAggregatorPadMethod t AggregatorPad, O.OverloadedMethodInfo info AggregatorPad) => OL.IsLabel t (O.MethodProxy info AggregatorPad) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- signal AggregatorPad::buffer-consumed
-- | /No description available in the introspection data./
type AggregatorPadBufferConsumedCallback =
    Gst.Buffer.Buffer
    -> IO ()

type C_AggregatorPadBufferConsumedCallback =
    Ptr AggregatorPad ->                    -- object
    Ptr Gst.Buffer.Buffer ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_AggregatorPadBufferConsumedCallback`.
foreign import ccall "wrapper"
    mk_AggregatorPadBufferConsumedCallback :: C_AggregatorPadBufferConsumedCallback -> IO (FunPtr C_AggregatorPadBufferConsumedCallback)

wrap_AggregatorPadBufferConsumedCallback :: 
    GObject a => (a -> AggregatorPadBufferConsumedCallback) ->
    C_AggregatorPadBufferConsumedCallback
wrap_AggregatorPadBufferConsumedCallback :: forall a.
GObject a =>
(a -> AggregatorPadBufferConsumedCallback)
-> C_AggregatorPadBufferConsumedCallback
wrap_AggregatorPadBufferConsumedCallback a -> AggregatorPadBufferConsumedCallback
gi'cb Ptr AggregatorPad
gi'selfPtr Ptr Buffer
object Ptr ()
_ = do
    Ptr Buffer -> AggregatorPadBufferConsumedCallback -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr Buffer
object (AggregatorPadBufferConsumedCallback -> IO ())
-> AggregatorPadBufferConsumedCallback -> IO ()
forall a b. (a -> b) -> a -> b
$ \Buffer
object' -> do
        Ptr AggregatorPad -> (AggregatorPad -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr AggregatorPad
gi'selfPtr ((AggregatorPad -> IO ()) -> IO ())
-> (AggregatorPad -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AggregatorPad
gi'self -> a -> AggregatorPadBufferConsumedCallback
gi'cb (AggregatorPad -> a
forall a b. Coercible a b => a -> b
Coerce.coerce AggregatorPad
gi'self)  Buffer
object'


-- | Connect a signal handler for the [bufferConsumed](#signal:bufferConsumed) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' aggregatorPad #bufferConsumed callback
-- @
-- 
-- 
onAggregatorPadBufferConsumed :: (IsAggregatorPad a, MonadIO m) => a -> ((?self :: a) => AggregatorPadBufferConsumedCallback) -> m SignalHandlerId
onAggregatorPadBufferConsumed :: forall a (m :: * -> *).
(IsAggregatorPad a, MonadIO m) =>
a
-> ((?self::a) => AggregatorPadBufferConsumedCallback)
-> m SignalHandlerId
onAggregatorPadBufferConsumed a
obj (?self::a) => AggregatorPadBufferConsumedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> AggregatorPadBufferConsumedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => AggregatorPadBufferConsumedCallback
AggregatorPadBufferConsumedCallback
cb
    let wrapped' :: C_AggregatorPadBufferConsumedCallback
wrapped' = (a -> AggregatorPadBufferConsumedCallback)
-> C_AggregatorPadBufferConsumedCallback
forall a.
GObject a =>
(a -> AggregatorPadBufferConsumedCallback)
-> C_AggregatorPadBufferConsumedCallback
wrap_AggregatorPadBufferConsumedCallback a -> AggregatorPadBufferConsumedCallback
wrapped
    FunPtr C_AggregatorPadBufferConsumedCallback
wrapped'' <- C_AggregatorPadBufferConsumedCallback
-> IO (FunPtr C_AggregatorPadBufferConsumedCallback)
mk_AggregatorPadBufferConsumedCallback C_AggregatorPadBufferConsumedCallback
wrapped'
    a
-> Text
-> FunPtr C_AggregatorPadBufferConsumedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"buffer-consumed" FunPtr C_AggregatorPadBufferConsumedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [bufferConsumed](#signal:bufferConsumed) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' aggregatorPad #bufferConsumed callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterAggregatorPadBufferConsumed :: (IsAggregatorPad a, MonadIO m) => a -> ((?self :: a) => AggregatorPadBufferConsumedCallback) -> m SignalHandlerId
afterAggregatorPadBufferConsumed :: forall a (m :: * -> *).
(IsAggregatorPad a, MonadIO m) =>
a
-> ((?self::a) => AggregatorPadBufferConsumedCallback)
-> m SignalHandlerId
afterAggregatorPadBufferConsumed a
obj (?self::a) => AggregatorPadBufferConsumedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> AggregatorPadBufferConsumedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => AggregatorPadBufferConsumedCallback
AggregatorPadBufferConsumedCallback
cb
    let wrapped' :: C_AggregatorPadBufferConsumedCallback
wrapped' = (a -> AggregatorPadBufferConsumedCallback)
-> C_AggregatorPadBufferConsumedCallback
forall a.
GObject a =>
(a -> AggregatorPadBufferConsumedCallback)
-> C_AggregatorPadBufferConsumedCallback
wrap_AggregatorPadBufferConsumedCallback a -> AggregatorPadBufferConsumedCallback
wrapped
    FunPtr C_AggregatorPadBufferConsumedCallback
wrapped'' <- C_AggregatorPadBufferConsumedCallback
-> IO (FunPtr C_AggregatorPadBufferConsumedCallback)
mk_AggregatorPadBufferConsumedCallback C_AggregatorPadBufferConsumedCallback
wrapped'
    a
-> Text
-> FunPtr C_AggregatorPadBufferConsumedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"buffer-consumed" FunPtr C_AggregatorPadBufferConsumedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data AggregatorPadBufferConsumedSignalInfo
instance SignalInfo AggregatorPadBufferConsumedSignalInfo where
    type HaskellCallbackType AggregatorPadBufferConsumedSignalInfo = AggregatorPadBufferConsumedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_AggregatorPadBufferConsumedCallback cb
        cb'' <- mk_AggregatorPadBufferConsumedCallback cb'
        connectSignalFunPtr obj "buffer-consumed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.AggregatorPad::buffer-consumed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Objects-AggregatorPad.html#g:signal:bufferConsumed"})

#endif

-- VVV Prop "emit-signals"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@emit-signals@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' aggregatorPad #emitSignals
-- @
getAggregatorPadEmitSignals :: (MonadIO m, IsAggregatorPad o) => o -> m Bool
getAggregatorPadEmitSignals :: forall (m :: * -> *) o.
(MonadIO m, IsAggregatorPad o) =>
o -> m Bool
getAggregatorPadEmitSignals o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"emit-signals"

-- | Set the value of the “@emit-signals@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' aggregatorPad [ #emitSignals 'Data.GI.Base.Attributes.:=' value ]
-- @
setAggregatorPadEmitSignals :: (MonadIO m, IsAggregatorPad o) => o -> Bool -> m ()
setAggregatorPadEmitSignals :: forall (m :: * -> *) o.
(MonadIO m, IsAggregatorPad o) =>
o -> Bool -> m ()
setAggregatorPadEmitSignals o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"emit-signals" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@emit-signals@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAggregatorPadEmitSignals :: (IsAggregatorPad o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructAggregatorPadEmitSignals :: forall o (m :: * -> *).
(IsAggregatorPad o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructAggregatorPadEmitSignals Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"emit-signals" Bool
val

#if defined(ENABLE_OVERLOADING)
data AggregatorPadEmitSignalsPropertyInfo
instance AttrInfo AggregatorPadEmitSignalsPropertyInfo where
    type AttrAllowedOps AggregatorPadEmitSignalsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AggregatorPadEmitSignalsPropertyInfo = IsAggregatorPad
    type AttrSetTypeConstraint AggregatorPadEmitSignalsPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint AggregatorPadEmitSignalsPropertyInfo = (~) Bool
    type AttrTransferType AggregatorPadEmitSignalsPropertyInfo = Bool
    type AttrGetType AggregatorPadEmitSignalsPropertyInfo = Bool
    type AttrLabel AggregatorPadEmitSignalsPropertyInfo = "emit-signals"
    type AttrOrigin AggregatorPadEmitSignalsPropertyInfo = AggregatorPad
    attrGet = getAggregatorPadEmitSignals
    attrSet = setAggregatorPadEmitSignals
    attrTransfer _ v = do
        return v
    attrConstruct = constructAggregatorPadEmitSignals
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.AggregatorPad.emitSignals"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Objects-AggregatorPad.html#g:attr:emitSignals"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AggregatorPad
type instance O.AttributeList AggregatorPad = AggregatorPadAttributeList
type AggregatorPadAttributeList = ('[ '("caps", Gst.Pad.PadCapsPropertyInfo), '("direction", Gst.Pad.PadDirectionPropertyInfo), '("emitSignals", AggregatorPadEmitSignalsPropertyInfo), '("name", Gst.Object.ObjectNamePropertyInfo), '("offset", Gst.Pad.PadOffsetPropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo), '("template", Gst.Pad.PadTemplatePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
aggregatorPadEmitSignals :: AttrLabelProxy "emitSignals"
aggregatorPadEmitSignals = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList AggregatorPad = AggregatorPadSignalList
type AggregatorPadSignalList = ('[ '("bufferConsumed", AggregatorPadBufferConsumedSignalInfo), '("deepNotify", Gst.Object.ObjectDeepNotifySignalInfo), '("linked", Gst.Pad.PadLinkedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("unlinked", Gst.Pad.PadUnlinkedSignalInfo)] :: [(Symbol, *)])

#endif

-- method AggregatorPad::drop_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "AggregatorPad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the pad where to drop any pending buffer"
--                 , 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_aggregator_pad_drop_buffer" gst_aggregator_pad_drop_buffer :: 
    Ptr AggregatorPad ->                    -- pad : TInterface (Name {namespace = "GstBase", name = "AggregatorPad"})
    IO CInt

-- | Drop the buffer currently queued in /@pad@/.
aggregatorPadDropBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregatorPad a) =>
    a
    -- ^ /@pad@/: the pad where to drop any pending buffer
    -> m Bool
    -- ^ __Returns:__ TRUE if there was a buffer queued in /@pad@/, or FALSE if not.
aggregatorPadDropBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregatorPad a) =>
a -> m Bool
aggregatorPadDropBuffer a
pad = IO Bool -> m Bool
forall a. IO a -> m a
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 AggregatorPad
pad' <- a -> IO (Ptr AggregatorPad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CInt
result <- Ptr AggregatorPad -> IO CInt
gst_aggregator_pad_drop_buffer Ptr AggregatorPad
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
pad
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AggregatorPadDropBufferMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAggregatorPad a) => O.OverloadedMethod AggregatorPadDropBufferMethodInfo a signature where
    overloadedMethod = aggregatorPadDropBuffer

instance O.OverloadedMethodInfo AggregatorPadDropBufferMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.AggregatorPad.aggregatorPadDropBuffer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Objects-AggregatorPad.html#v:aggregatorPadDropBuffer"
        })


#endif

-- method AggregatorPad::has_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "AggregatorPad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the pad to check the buffer on"
--                 , 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_aggregator_pad_has_buffer" gst_aggregator_pad_has_buffer :: 
    Ptr AggregatorPad ->                    -- pad : TInterface (Name {namespace = "GstBase", name = "AggregatorPad"})
    IO CInt

-- | This checks if a pad has a buffer available that will be returned by
-- a call to 'GI.GstBase.Objects.AggregatorPad.aggregatorPadPeekBuffer' or
-- 'GI.GstBase.Objects.AggregatorPad.aggregatorPadPopBuffer'.
-- 
-- /Since: 1.14.1/
aggregatorPadHasBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregatorPad a) =>
    a
    -- ^ /@pad@/: the pad to check the buffer on
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pad has a buffer available as the next thing.
aggregatorPadHasBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregatorPad a) =>
a -> m Bool
aggregatorPadHasBuffer a
pad = IO Bool -> m Bool
forall a. IO a -> m a
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 AggregatorPad
pad' <- a -> IO (Ptr AggregatorPad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CInt
result <- Ptr AggregatorPad -> IO CInt
gst_aggregator_pad_has_buffer Ptr AggregatorPad
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
pad
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AggregatorPadHasBufferMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAggregatorPad a) => O.OverloadedMethod AggregatorPadHasBufferMethodInfo a signature where
    overloadedMethod = aggregatorPadHasBuffer

instance O.OverloadedMethodInfo AggregatorPadHasBufferMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.AggregatorPad.aggregatorPadHasBuffer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Objects-AggregatorPad.html#v:aggregatorPadHasBuffer"
        })


#endif

-- method AggregatorPad::is_eos
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "AggregatorPad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an aggregator pad" , 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_aggregator_pad_is_eos" gst_aggregator_pad_is_eos :: 
    Ptr AggregatorPad ->                    -- pad : TInterface (Name {namespace = "GstBase", name = "AggregatorPad"})
    IO CInt

-- | /No description available in the introspection data./
aggregatorPadIsEos ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregatorPad a) =>
    a
    -- ^ /@pad@/: an aggregator pad
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pad is EOS, otherwise 'P.False'.
aggregatorPadIsEos :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregatorPad a) =>
a -> m Bool
aggregatorPadIsEos a
pad = IO Bool -> m Bool
forall a. IO a -> m a
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 AggregatorPad
pad' <- a -> IO (Ptr AggregatorPad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CInt
result <- Ptr AggregatorPad -> IO CInt
gst_aggregator_pad_is_eos Ptr AggregatorPad
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
pad
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AggregatorPadIsEosMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAggregatorPad a) => O.OverloadedMethod AggregatorPadIsEosMethodInfo a signature where
    overloadedMethod = aggregatorPadIsEos

instance O.OverloadedMethodInfo AggregatorPadIsEosMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.AggregatorPad.aggregatorPadIsEos",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Objects-AggregatorPad.html#v:aggregatorPadIsEos"
        })


#endif

-- method AggregatorPad::is_inactive
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "AggregatorPad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an aggregator pad" , 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_aggregator_pad_is_inactive" gst_aggregator_pad_is_inactive :: 
    Ptr AggregatorPad ->                    -- pad : TInterface (Name {namespace = "GstBase", name = "AggregatorPad"})
    IO CInt

-- | It is only valid to call this method from t'GI.GstBase.Structs.AggregatorClass.AggregatorClass'::@/aggregate/@()
-- 
-- /Since: 1.20/
aggregatorPadIsInactive ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregatorPad a) =>
    a
    -- ^ /@pad@/: an aggregator pad
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pad is inactive, 'P.False' otherwise.
    --   See @/gst_aggregator_ignore_inactive_pads()/@ for more info.
aggregatorPadIsInactive :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregatorPad a) =>
a -> m Bool
aggregatorPadIsInactive a
pad = IO Bool -> m Bool
forall a. IO a -> m a
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 AggregatorPad
pad' <- a -> IO (Ptr AggregatorPad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CInt
result <- Ptr AggregatorPad -> IO CInt
gst_aggregator_pad_is_inactive Ptr AggregatorPad
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
pad
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AggregatorPadIsInactiveMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAggregatorPad a) => O.OverloadedMethod AggregatorPadIsInactiveMethodInfo a signature where
    overloadedMethod = aggregatorPadIsInactive

instance O.OverloadedMethodInfo AggregatorPadIsInactiveMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.AggregatorPad.aggregatorPadIsInactive",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Objects-AggregatorPad.html#v:aggregatorPadIsInactive"
        })


#endif

-- method AggregatorPad::peek_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "AggregatorPad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the pad to get buffer from"
--                 , 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_aggregator_pad_peek_buffer" gst_aggregator_pad_peek_buffer :: 
    Ptr AggregatorPad ->                    -- pad : TInterface (Name {namespace = "GstBase", name = "AggregatorPad"})
    IO (Ptr Gst.Buffer.Buffer)

-- | /No description available in the introspection data./
aggregatorPadPeekBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregatorPad a) =>
    a
    -- ^ /@pad@/: the pad to get buffer from
    -> m (Maybe Gst.Buffer.Buffer)
    -- ^ __Returns:__ A reference to the buffer in /@pad@/ or
    -- NULL if no buffer was queued. You should unref the buffer after
    -- usage.
aggregatorPadPeekBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregatorPad a) =>
a -> m (Maybe Buffer)
aggregatorPadPeekBuffer a
pad = IO (Maybe Buffer) -> m (Maybe Buffer)
forall a. IO a -> m a
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 AggregatorPad
pad' <- a -> IO (Ptr AggregatorPad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Buffer
result <- Ptr AggregatorPad -> IO (Ptr Buffer)
gst_aggregator_pad_peek_buffer Ptr AggregatorPad
pad'
    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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Maybe Buffer -> IO (Maybe Buffer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
maybeResult

#if defined(ENABLE_OVERLOADING)
data AggregatorPadPeekBufferMethodInfo
instance (signature ~ (m (Maybe Gst.Buffer.Buffer)), MonadIO m, IsAggregatorPad a) => O.OverloadedMethod AggregatorPadPeekBufferMethodInfo a signature where
    overloadedMethod = aggregatorPadPeekBuffer

instance O.OverloadedMethodInfo AggregatorPadPeekBufferMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.AggregatorPad.aggregatorPadPeekBuffer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Objects-AggregatorPad.html#v:aggregatorPadPeekBuffer"
        })


#endif

-- method AggregatorPad::pop_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "AggregatorPad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the pad to get buffer from"
--                 , 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_aggregator_pad_pop_buffer" gst_aggregator_pad_pop_buffer :: 
    Ptr AggregatorPad ->                    -- pad : TInterface (Name {namespace = "GstBase", name = "AggregatorPad"})
    IO (Ptr Gst.Buffer.Buffer)

-- | Steal the ref to the buffer currently queued in /@pad@/.
aggregatorPadPopBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregatorPad a) =>
    a
    -- ^ /@pad@/: the pad to get buffer from
    -> m (Maybe Gst.Buffer.Buffer)
    -- ^ __Returns:__ The buffer in /@pad@/ or NULL if no buffer was
    --   queued. You should unref the buffer after usage.
aggregatorPadPopBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregatorPad a) =>
a -> m (Maybe Buffer)
aggregatorPadPopBuffer a
pad = IO (Maybe Buffer) -> m (Maybe Buffer)
forall a. IO a -> m a
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 AggregatorPad
pad' <- a -> IO (Ptr AggregatorPad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Buffer
result <- Ptr AggregatorPad -> IO (Ptr Buffer)
gst_aggregator_pad_pop_buffer Ptr AggregatorPad
pad'
    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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Maybe Buffer -> IO (Maybe Buffer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
maybeResult

#if defined(ENABLE_OVERLOADING)
data AggregatorPadPopBufferMethodInfo
instance (signature ~ (m (Maybe Gst.Buffer.Buffer)), MonadIO m, IsAggregatorPad a) => O.OverloadedMethod AggregatorPadPopBufferMethodInfo a signature where
    overloadedMethod = aggregatorPadPopBuffer

instance O.OverloadedMethodInfo AggregatorPadPopBufferMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.AggregatorPad.aggregatorPadPopBuffer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.26/docs/GI-GstBase-Objects-AggregatorPad.html#v:aggregatorPadPopBuffer"
        })


#endif