{-# 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 with the purpose of aggregating their buffers.
-- Control is given to the subclass when all pads have data.
-- 
--  * Base class for mixers and muxers. Subclasses should at least implement
--    the t'GI.GstBase.Structs.AggregatorClass.AggregatorClass'.@/aggregate/@() virtual method.
-- 
--  * Installs a t'GI.Gst.Callbacks.PadChainFunction', a t'GI.Gst.Callbacks.PadEventFullFunction' and a
--    t'GI.Gst.Callbacks.PadQueryFunction' to queue all serialized data packets per sink pad.
--    Subclasses should not overwrite those, but instead implement
--    t'GI.GstBase.Structs.AggregatorClass.AggregatorClass'.@/sink_event/@() and t'GI.GstBase.Structs.AggregatorClass.AggregatorClass'.@/sink_query/@() as
--    needed.
-- 
--  * When data is queued on all pads, the aggregate vmethod is called.
-- 
--  * One can peek at the data on any given GstAggregatorPad with the
--    gst_aggregator_pad_peek_buffer () method, and remove it from the pad
--    with the gst_aggregator_pad_pop_buffer () method. When a buffer
--    has been taken with pop_buffer (), a new buffer can be queued
--    on that pad.
-- 
--  * If the subclass wishes to push a buffer downstream in its aggregate
--    implementation, it should do so through the
--    gst_aggregator_finish_buffer () method. This method will take care
--    of sending and ordering mandatory events such as stream start, caps
--    and segment.
-- 
--  * Same goes for EOS events, which should not be pushed directly by the
--    subclass, it should instead return GST_FLOW_EOS in its aggregate
--    implementation.
-- 
--  * Note that the aggregator logic regarding gap event handling is to turn
--    these into gap buffers with matching PTS and duration. It will also
--    flag these buffers with GST_BUFFER_FLAG_GAP and GST_BUFFER_FLAG_DROPPABLE
--    to ease their identification and subsequent processing.
-- 
--  * Subclasses must use (a subclass of) t'GI.GstBase.Objects.AggregatorPad.AggregatorPad' for both their
--    sink and source pads.
--    See 'GI.Gst.Structs.ElementClass.elementClassAddStaticPadTemplateWithGtype'.
-- 
-- 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.Aggregator
    ( 

-- * Exported types
    Aggregator(..)                          ,
    IsAggregator                            ,
    toAggregator                            ,
    noAggregator                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAggregatorMethod                 ,
#endif


-- ** finishBuffer #method:finishBuffer#

#if defined(ENABLE_OVERLOADING)
    AggregatorFinishBufferMethodInfo        ,
#endif
    aggregatorFinishBuffer                  ,


-- ** getAllocator #method:getAllocator#

#if defined(ENABLE_OVERLOADING)
    AggregatorGetAllocatorMethodInfo        ,
#endif
    aggregatorGetAllocator                  ,


-- ** getBufferPool #method:getBufferPool#

#if defined(ENABLE_OVERLOADING)
    AggregatorGetBufferPoolMethodInfo       ,
#endif
    aggregatorGetBufferPool                 ,


-- ** getLatency #method:getLatency#

#if defined(ENABLE_OVERLOADING)
    AggregatorGetLatencyMethodInfo          ,
#endif
    aggregatorGetLatency                    ,


-- ** setLatency #method:setLatency#

#if defined(ENABLE_OVERLOADING)
    AggregatorSetLatencyMethodInfo          ,
#endif
    aggregatorSetLatency                    ,


-- ** setSrcCaps #method:setSrcCaps#

#if defined(ENABLE_OVERLOADING)
    AggregatorSetSrcCapsMethodInfo          ,
#endif
    aggregatorSetSrcCaps                    ,


-- ** simpleGetNextTime #method:simpleGetNextTime#

#if defined(ENABLE_OVERLOADING)
    AggregatorSimpleGetNextTimeMethodInfo   ,
#endif
    aggregatorSimpleGetNextTime             ,




 -- * Properties
-- ** latency #attr:latency#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    AggregatorLatencyPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    aggregatorLatency                       ,
#endif
    constructAggregatorLatency              ,
    getAggregatorLatency                    ,
    setAggregatorLatency                    ,


-- ** minUpstreamLatency #attr:minUpstreamLatency#
-- | Force minimum upstream latency (in nanoseconds). When sources with a
-- higher latency are expected to be plugged in dynamically after the
-- aggregator has started playing, this allows overriding the minimum
-- latency reported by the initial source(s). This is only taken into
-- account when larger than the actually reported minimum latency.
-- 
-- /Since: 1.16/

#if defined(ENABLE_OVERLOADING)
    AggregatorMinUpstreamLatencyPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    aggregatorMinUpstreamLatency            ,
#endif
    constructAggregatorMinUpstreamLatency   ,
    getAggregatorMinUpstreamLatency         ,
    setAggregatorMinUpstreamLatency         ,


-- ** startTime #attr:startTime#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    AggregatorStartTimePropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    aggregatorStartTime                     ,
#endif
    constructAggregatorStartTime            ,
    getAggregatorStartTime                  ,
    setAggregatorStartTime                  ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gst.Enums as Gst.Enums
import qualified GI.Gst.Objects.Allocator as Gst.Allocator
import qualified GI.Gst.Objects.BufferPool as Gst.BufferPool
import qualified GI.Gst.Objects.Element as Gst.Element
import qualified GI.Gst.Objects.Object as Gst.Object
import qualified GI.Gst.Structs.AllocationParams as Gst.AllocationParams
import qualified GI.Gst.Structs.Buffer as Gst.Buffer
import qualified GI.Gst.Structs.Caps as Gst.Caps

-- | Memory-managed wrapper type.
newtype Aggregator = Aggregator (ManagedPtr Aggregator)
    deriving (Aggregator -> Aggregator -> Bool
(Aggregator -> Aggregator -> Bool)
-> (Aggregator -> Aggregator -> Bool) -> Eq Aggregator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Aggregator -> Aggregator -> Bool
$c/= :: Aggregator -> Aggregator -> Bool
== :: Aggregator -> Aggregator -> Bool
$c== :: Aggregator -> Aggregator -> Bool
Eq)
foreign import ccall "gst_aggregator_get_type"
    c_gst_aggregator_get_type :: IO GType

instance GObject Aggregator where
    gobjectType :: IO GType
gobjectType = IO GType
c_gst_aggregator_get_type
    

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

-- | Type class for types which can be safely cast to `Aggregator`, for instance with `toAggregator`.
class (GObject o, O.IsDescendantOf Aggregator o) => IsAggregator o
instance (GObject o, O.IsDescendantOf Aggregator o) => IsAggregator o

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `Aggregator`.
noAggregator :: Maybe Aggregator
noAggregator :: Maybe Aggregator
noAggregator = Maybe Aggregator
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveAggregatorMethod (t :: Symbol) (o :: *) :: * where
    ResolveAggregatorMethod "abortState" o = Gst.Element.ElementAbortStateMethodInfo
    ResolveAggregatorMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveAggregatorMethod "addPad" o = Gst.Element.ElementAddPadMethodInfo
    ResolveAggregatorMethod "addPropertyDeepNotifyWatch" o = Gst.Element.ElementAddPropertyDeepNotifyWatchMethodInfo
    ResolveAggregatorMethod "addPropertyNotifyWatch" o = Gst.Element.ElementAddPropertyNotifyWatchMethodInfo
    ResolveAggregatorMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAggregatorMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAggregatorMethod "callAsync" o = Gst.Element.ElementCallAsyncMethodInfo
    ResolveAggregatorMethod "changeState" o = Gst.Element.ElementChangeStateMethodInfo
    ResolveAggregatorMethod "continueState" o = Gst.Element.ElementContinueStateMethodInfo
    ResolveAggregatorMethod "createAllPads" o = Gst.Element.ElementCreateAllPadsMethodInfo
    ResolveAggregatorMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveAggregatorMethod "finishBuffer" o = AggregatorFinishBufferMethodInfo
    ResolveAggregatorMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAggregatorMethod "foreachPad" o = Gst.Element.ElementForeachPadMethodInfo
    ResolveAggregatorMethod "foreachSinkPad" o = Gst.Element.ElementForeachSinkPadMethodInfo
    ResolveAggregatorMethod "foreachSrcPad" o = Gst.Element.ElementForeachSrcPadMethodInfo
    ResolveAggregatorMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAggregatorMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAggregatorMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveAggregatorMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveAggregatorMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveAggregatorMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveAggregatorMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAggregatorMethod "isLockedState" o = Gst.Element.ElementIsLockedStateMethodInfo
    ResolveAggregatorMethod "iteratePads" o = Gst.Element.ElementIteratePadsMethodInfo
    ResolveAggregatorMethod "iterateSinkPads" o = Gst.Element.ElementIterateSinkPadsMethodInfo
    ResolveAggregatorMethod "iterateSrcPads" o = Gst.Element.ElementIterateSrcPadsMethodInfo
    ResolveAggregatorMethod "link" o = Gst.Element.ElementLinkMethodInfo
    ResolveAggregatorMethod "linkFiltered" o = Gst.Element.ElementLinkFilteredMethodInfo
    ResolveAggregatorMethod "linkPads" o = Gst.Element.ElementLinkPadsMethodInfo
    ResolveAggregatorMethod "linkPadsFiltered" o = Gst.Element.ElementLinkPadsFilteredMethodInfo
    ResolveAggregatorMethod "linkPadsFull" o = Gst.Element.ElementLinkPadsFullMethodInfo
    ResolveAggregatorMethod "lostState" o = Gst.Element.ElementLostStateMethodInfo
    ResolveAggregatorMethod "messageFull" o = Gst.Element.ElementMessageFullMethodInfo
    ResolveAggregatorMethod "messageFullWithDetails" o = Gst.Element.ElementMessageFullWithDetailsMethodInfo
    ResolveAggregatorMethod "noMorePads" o = Gst.Element.ElementNoMorePadsMethodInfo
    ResolveAggregatorMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAggregatorMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAggregatorMethod "postMessage" o = Gst.Element.ElementPostMessageMethodInfo
    ResolveAggregatorMethod "provideClock" o = Gst.Element.ElementProvideClockMethodInfo
    ResolveAggregatorMethod "query" o = Gst.Element.ElementQueryMethodInfo
    ResolveAggregatorMethod "queryConvert" o = Gst.Element.ElementQueryConvertMethodInfo
    ResolveAggregatorMethod "queryDuration" o = Gst.Element.ElementQueryDurationMethodInfo
    ResolveAggregatorMethod "queryPosition" o = Gst.Element.ElementQueryPositionMethodInfo
    ResolveAggregatorMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveAggregatorMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAggregatorMethod "releaseRequestPad" o = Gst.Element.ElementReleaseRequestPadMethodInfo
    ResolveAggregatorMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveAggregatorMethod "removePad" o = Gst.Element.ElementRemovePadMethodInfo
    ResolveAggregatorMethod "removePropertyNotifyWatch" o = Gst.Element.ElementRemovePropertyNotifyWatchMethodInfo
    ResolveAggregatorMethod "requestPad" o = Gst.Element.ElementRequestPadMethodInfo
    ResolveAggregatorMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAggregatorMethod "seek" o = Gst.Element.ElementSeekMethodInfo
    ResolveAggregatorMethod "seekSimple" o = Gst.Element.ElementSeekSimpleMethodInfo
    ResolveAggregatorMethod "sendEvent" o = Gst.Element.ElementSendEventMethodInfo
    ResolveAggregatorMethod "simpleGetNextTime" o = AggregatorSimpleGetNextTimeMethodInfo
    ResolveAggregatorMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAggregatorMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAggregatorMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveAggregatorMethod "syncStateWithParent" o = Gst.Element.ElementSyncStateWithParentMethodInfo
    ResolveAggregatorMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveAggregatorMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAggregatorMethod "unlink" o = Gst.Element.ElementUnlinkMethodInfo
    ResolveAggregatorMethod "unlinkPads" o = Gst.Element.ElementUnlinkPadsMethodInfo
    ResolveAggregatorMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveAggregatorMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveAggregatorMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAggregatorMethod "getAllocator" o = AggregatorGetAllocatorMethodInfo
    ResolveAggregatorMethod "getBaseTime" o = Gst.Element.ElementGetBaseTimeMethodInfo
    ResolveAggregatorMethod "getBufferPool" o = AggregatorGetBufferPoolMethodInfo
    ResolveAggregatorMethod "getBus" o = Gst.Element.ElementGetBusMethodInfo
    ResolveAggregatorMethod "getClock" o = Gst.Element.ElementGetClockMethodInfo
    ResolveAggregatorMethod "getCompatiblePad" o = Gst.Element.ElementGetCompatiblePadMethodInfo
    ResolveAggregatorMethod "getCompatiblePadTemplate" o = Gst.Element.ElementGetCompatiblePadTemplateMethodInfo
    ResolveAggregatorMethod "getContext" o = Gst.Element.ElementGetContextMethodInfo
    ResolveAggregatorMethod "getContextUnlocked" o = Gst.Element.ElementGetContextUnlockedMethodInfo
    ResolveAggregatorMethod "getContexts" o = Gst.Element.ElementGetContextsMethodInfo
    ResolveAggregatorMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveAggregatorMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveAggregatorMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAggregatorMethod "getFactory" o = Gst.Element.ElementGetFactoryMethodInfo
    ResolveAggregatorMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveAggregatorMethod "getLatency" o = AggregatorGetLatencyMethodInfo
    ResolveAggregatorMethod "getMetadata" o = Gst.Element.ElementGetMetadataMethodInfo
    ResolveAggregatorMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveAggregatorMethod "getPadTemplate" o = Gst.Element.ElementGetPadTemplateMethodInfo
    ResolveAggregatorMethod "getPadTemplateList" o = Gst.Element.ElementGetPadTemplateListMethodInfo
    ResolveAggregatorMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveAggregatorMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveAggregatorMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAggregatorMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAggregatorMethod "getRequestPad" o = Gst.Element.ElementGetRequestPadMethodInfo
    ResolveAggregatorMethod "getStartTime" o = Gst.Element.ElementGetStartTimeMethodInfo
    ResolveAggregatorMethod "getState" o = Gst.Element.ElementGetStateMethodInfo
    ResolveAggregatorMethod "getStaticPad" o = Gst.Element.ElementGetStaticPadMethodInfo
    ResolveAggregatorMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveAggregatorMethod "setBaseTime" o = Gst.Element.ElementSetBaseTimeMethodInfo
    ResolveAggregatorMethod "setBus" o = Gst.Element.ElementSetBusMethodInfo
    ResolveAggregatorMethod "setClock" o = Gst.Element.ElementSetClockMethodInfo
    ResolveAggregatorMethod "setContext" o = Gst.Element.ElementSetContextMethodInfo
    ResolveAggregatorMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveAggregatorMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveAggregatorMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveAggregatorMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAggregatorMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAggregatorMethod "setLatency" o = AggregatorSetLatencyMethodInfo
    ResolveAggregatorMethod "setLockedState" o = Gst.Element.ElementSetLockedStateMethodInfo
    ResolveAggregatorMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveAggregatorMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveAggregatorMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAggregatorMethod "setSrcCaps" o = AggregatorSetSrcCapsMethodInfo
    ResolveAggregatorMethod "setStartTime" o = Gst.Element.ElementSetStartTimeMethodInfo
    ResolveAggregatorMethod "setState" o = Gst.Element.ElementSetStateMethodInfo
    ResolveAggregatorMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "latency"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@latency@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' aggregator #latency
-- @
getAggregatorLatency :: (MonadIO m, IsAggregator o) => o -> m Word64
getAggregatorLatency :: o -> m Word64
getAggregatorLatency obj :: o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj "latency"

-- | Set the value of the “@latency@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' aggregator [ #latency 'Data.GI.Base.Attributes.:=' value ]
-- @
setAggregatorLatency :: (MonadIO m, IsAggregator o) => o -> Word64 -> m ()
setAggregatorLatency :: o -> Word64 -> m ()
setAggregatorLatency obj :: o
obj val :: Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj "latency" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@latency@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAggregatorLatency :: (IsAggregator o) => Word64 -> IO (GValueConstruct o)
constructAggregatorLatency :: Word64 -> IO (GValueConstruct o)
constructAggregatorLatency val :: Word64
val = String -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 "latency" Word64
val

#if defined(ENABLE_OVERLOADING)
data AggregatorLatencyPropertyInfo
instance AttrInfo AggregatorLatencyPropertyInfo where
    type AttrAllowedOps AggregatorLatencyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AggregatorLatencyPropertyInfo = IsAggregator
    type AttrSetTypeConstraint AggregatorLatencyPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint AggregatorLatencyPropertyInfo = (~) Word64
    type AttrTransferType AggregatorLatencyPropertyInfo = Word64
    type AttrGetType AggregatorLatencyPropertyInfo = Word64
    type AttrLabel AggregatorLatencyPropertyInfo = "latency"
    type AttrOrigin AggregatorLatencyPropertyInfo = Aggregator
    attrGet = getAggregatorLatency
    attrSet = setAggregatorLatency
    attrTransfer _ v = do
        return v
    attrConstruct = constructAggregatorLatency
    attrClear = undefined
#endif

-- VVV Prop "min-upstream-latency"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@min-upstream-latency@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' aggregator #minUpstreamLatency
-- @
getAggregatorMinUpstreamLatency :: (MonadIO m, IsAggregator o) => o -> m Word64
getAggregatorMinUpstreamLatency :: o -> m Word64
getAggregatorMinUpstreamLatency obj :: o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj "min-upstream-latency"

-- | Set the value of the “@min-upstream-latency@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' aggregator [ #minUpstreamLatency 'Data.GI.Base.Attributes.:=' value ]
-- @
setAggregatorMinUpstreamLatency :: (MonadIO m, IsAggregator o) => o -> Word64 -> m ()
setAggregatorMinUpstreamLatency :: o -> Word64 -> m ()
setAggregatorMinUpstreamLatency obj :: o
obj val :: Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj "min-upstream-latency" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@min-upstream-latency@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAggregatorMinUpstreamLatency :: (IsAggregator o) => Word64 -> IO (GValueConstruct o)
constructAggregatorMinUpstreamLatency :: Word64 -> IO (GValueConstruct o)
constructAggregatorMinUpstreamLatency val :: Word64
val = String -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 "min-upstream-latency" Word64
val

#if defined(ENABLE_OVERLOADING)
data AggregatorMinUpstreamLatencyPropertyInfo
instance AttrInfo AggregatorMinUpstreamLatencyPropertyInfo where
    type AttrAllowedOps AggregatorMinUpstreamLatencyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AggregatorMinUpstreamLatencyPropertyInfo = IsAggregator
    type AttrSetTypeConstraint AggregatorMinUpstreamLatencyPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint AggregatorMinUpstreamLatencyPropertyInfo = (~) Word64
    type AttrTransferType AggregatorMinUpstreamLatencyPropertyInfo = Word64
    type AttrGetType AggregatorMinUpstreamLatencyPropertyInfo = Word64
    type AttrLabel AggregatorMinUpstreamLatencyPropertyInfo = "min-upstream-latency"
    type AttrOrigin AggregatorMinUpstreamLatencyPropertyInfo = Aggregator
    attrGet = getAggregatorMinUpstreamLatency
    attrSet = setAggregatorMinUpstreamLatency
    attrTransfer _ v = do
        return v
    attrConstruct = constructAggregatorMinUpstreamLatency
    attrClear = undefined
#endif

-- VVV Prop "start-time"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@start-time@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' aggregator #startTime
-- @
getAggregatorStartTime :: (MonadIO m, IsAggregator o) => o -> m Word64
getAggregatorStartTime :: o -> m Word64
getAggregatorStartTime obj :: o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj "start-time"

-- | Set the value of the “@start-time@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' aggregator [ #startTime 'Data.GI.Base.Attributes.:=' value ]
-- @
setAggregatorStartTime :: (MonadIO m, IsAggregator o) => o -> Word64 -> m ()
setAggregatorStartTime :: o -> Word64 -> m ()
setAggregatorStartTime obj :: o
obj val :: Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj "start-time" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@start-time@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAggregatorStartTime :: (IsAggregator o) => Word64 -> IO (GValueConstruct o)
constructAggregatorStartTime :: Word64 -> IO (GValueConstruct o)
constructAggregatorStartTime val :: Word64
val = String -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 "start-time" Word64
val

#if defined(ENABLE_OVERLOADING)
data AggregatorStartTimePropertyInfo
instance AttrInfo AggregatorStartTimePropertyInfo where
    type AttrAllowedOps AggregatorStartTimePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AggregatorStartTimePropertyInfo = IsAggregator
    type AttrSetTypeConstraint AggregatorStartTimePropertyInfo = (~) Word64
    type AttrTransferTypeConstraint AggregatorStartTimePropertyInfo = (~) Word64
    type AttrTransferType AggregatorStartTimePropertyInfo = Word64
    type AttrGetType AggregatorStartTimePropertyInfo = Word64
    type AttrLabel AggregatorStartTimePropertyInfo = "start-time"
    type AttrOrigin AggregatorStartTimePropertyInfo = Aggregator
    attrGet = getAggregatorStartTime
    attrSet = setAggregatorStartTime
    attrTransfer _ v = do
        return v
    attrConstruct = constructAggregatorStartTime
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Aggregator
type instance O.AttributeList Aggregator = AggregatorAttributeList
type AggregatorAttributeList = ('[ '("latency", AggregatorLatencyPropertyInfo), '("minUpstreamLatency", AggregatorMinUpstreamLatencyPropertyInfo), '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo), '("startTime", AggregatorStartTimePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
aggregatorLatency :: AttrLabelProxy "latency"
aggregatorLatency = AttrLabelProxy

aggregatorMinUpstreamLatency :: AttrLabelProxy "minUpstreamLatency"
aggregatorMinUpstreamLatency = AttrLabelProxy

aggregatorStartTime :: AttrLabelProxy "startTime"
aggregatorStartTime = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Aggregator = AggregatorSignalList
type AggregatorSignalList = ('[ '("deepNotify", Gst.Object.ObjectDeepNotifySignalInfo), '("noMorePads", Gst.Element.ElementNoMorePadsSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("padAdded", Gst.Element.ElementPadAddedSignalInfo), '("padRemoved", Gst.Element.ElementPadRemovedSignalInfo)] :: [(Symbol, *)])

#endif

-- method Aggregator::finish_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "aggregator"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "Aggregator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstAggregator" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstBuffer to push."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "FlowReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_aggregator_finish_buffer" gst_aggregator_finish_buffer :: 
    Ptr Aggregator ->                       -- aggregator : TInterface (Name {namespace = "GstBase", name = "Aggregator"})
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO CInt

-- | This method will push the provided output buffer downstream. If needed,
-- mandatory events such as stream-start, caps, and segment events will be
-- sent before pushing the buffer.
aggregatorFinishBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregator a) =>
    a
    -- ^ /@aggregator@/: The t'GI.GstBase.Objects.Aggregator.Aggregator'
    -> Gst.Buffer.Buffer
    -- ^ /@buffer@/: the t'GI.Gst.Structs.Buffer.Buffer' to push.
    -> m Gst.Enums.FlowReturn
aggregatorFinishBuffer :: a -> Buffer -> m FlowReturn
aggregatorFinishBuffer aggregator :: a
aggregator buffer :: Buffer
buffer = IO FlowReturn -> m FlowReturn
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlowReturn -> m FlowReturn) -> IO FlowReturn -> m FlowReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr Aggregator
aggregator' <- a -> IO (Ptr Aggregator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
aggregator
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Buffer
buffer
    CInt
result <- Ptr Aggregator -> Ptr Buffer -> IO CInt
gst_aggregator_finish_buffer Ptr Aggregator
aggregator' Ptr Buffer
buffer'
    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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
aggregator
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    FlowReturn -> IO FlowReturn
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data AggregatorFinishBufferMethodInfo
instance (signature ~ (Gst.Buffer.Buffer -> m Gst.Enums.FlowReturn), MonadIO m, IsAggregator a) => O.MethodInfo AggregatorFinishBufferMethodInfo a signature where
    overloadedMethod = aggregatorFinishBuffer

#endif

-- method Aggregator::get_allocator
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "Aggregator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAggregator" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allocator"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Allocator" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAllocator\nused"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "params"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "AllocationParams" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the\n#GstAllocationParams of @allocator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_aggregator_get_allocator" gst_aggregator_get_allocator :: 
    Ptr Aggregator ->                       -- self : TInterface (Name {namespace = "GstBase", name = "Aggregator"})
    Ptr (Ptr Gst.Allocator.Allocator) ->    -- allocator : TInterface (Name {namespace = "Gst", name = "Allocator"})
    Ptr Gst.AllocationParams.AllocationParams -> -- params : TInterface (Name {namespace = "Gst", name = "AllocationParams"})
    IO ()

-- | Lets t'GI.GstBase.Objects.Aggregator.Aggregator' sub-classes get the memory /@allocator@/
-- acquired by the base class and its /@params@/.
-- 
-- Unref the /@allocator@/ after use it.
aggregatorGetAllocator ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregator a) =>
    a
    -- ^ /@self@/: a t'GI.GstBase.Objects.Aggregator.Aggregator'
    -> m ((Gst.Allocator.Allocator, Gst.AllocationParams.AllocationParams))
aggregatorGetAllocator :: a -> m (Allocator, AllocationParams)
aggregatorGetAllocator self :: a
self = IO (Allocator, AllocationParams) -> m (Allocator, AllocationParams)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Allocator, AllocationParams)
 -> m (Allocator, AllocationParams))
-> IO (Allocator, AllocationParams)
-> m (Allocator, AllocationParams)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Aggregator
self' <- a -> IO (Ptr Aggregator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr (Ptr Allocator)
allocator <- IO (Ptr (Ptr Allocator))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Allocator.Allocator))
    Ptr AllocationParams
params <- Int -> IO (Ptr AllocationParams)
forall a. BoxedObject a => Int -> IO (Ptr a)
callocBoxedBytes 64 :: IO (Ptr Gst.AllocationParams.AllocationParams)
    Ptr Aggregator
-> Ptr (Ptr Allocator) -> Ptr AllocationParams -> IO ()
gst_aggregator_get_allocator Ptr Aggregator
self' Ptr (Ptr Allocator)
allocator Ptr AllocationParams
params
    Ptr Allocator
allocator' <- Ptr (Ptr Allocator) -> IO (Ptr Allocator)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Allocator)
allocator
    Allocator
allocator'' <- ((ManagedPtr Allocator -> Allocator)
-> Ptr Allocator -> IO Allocator
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Allocator -> Allocator
Gst.Allocator.Allocator) Ptr Allocator
allocator'
    AllocationParams
params' <- ((ManagedPtr AllocationParams -> AllocationParams)
-> Ptr AllocationParams -> IO AllocationParams
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AllocationParams -> AllocationParams
Gst.AllocationParams.AllocationParams) Ptr AllocationParams
params
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr (Ptr Allocator) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Allocator)
allocator
    (Allocator, AllocationParams) -> IO (Allocator, AllocationParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (Allocator
allocator'', AllocationParams
params')

#if defined(ENABLE_OVERLOADING)
data AggregatorGetAllocatorMethodInfo
instance (signature ~ (m ((Gst.Allocator.Allocator, Gst.AllocationParams.AllocationParams))), MonadIO m, IsAggregator a) => O.MethodInfo AggregatorGetAllocatorMethodInfo a signature where
    overloadedMethod = aggregatorGetAllocator

#endif

-- method Aggregator::get_buffer_pool
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "Aggregator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAggregator" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "BufferPool" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_aggregator_get_buffer_pool" gst_aggregator_get_buffer_pool :: 
    Ptr Aggregator ->                       -- self : TInterface (Name {namespace = "GstBase", name = "Aggregator"})
    IO (Ptr Gst.BufferPool.BufferPool)

-- | /No description available in the introspection data./
aggregatorGetBufferPool ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregator a) =>
    a
    -- ^ /@self@/: a t'GI.GstBase.Objects.Aggregator.Aggregator'
    -> m Gst.BufferPool.BufferPool
    -- ^ __Returns:__ the instance of the t'GI.Gst.Objects.BufferPool.BufferPool' used
    -- by /@trans@/; free it after use it
aggregatorGetBufferPool :: a -> m BufferPool
aggregatorGetBufferPool self :: a
self = IO BufferPool -> m BufferPool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BufferPool -> m BufferPool) -> IO BufferPool -> m BufferPool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Aggregator
self' <- a -> IO (Ptr Aggregator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr BufferPool
result <- Ptr Aggregator -> IO (Ptr BufferPool)
gst_aggregator_get_buffer_pool Ptr Aggregator
self'
    Text -> Ptr BufferPool -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "aggregatorGetBufferPool" Ptr BufferPool
result
    BufferPool
result' <- ((ManagedPtr BufferPool -> BufferPool)
-> Ptr BufferPool -> IO BufferPool
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BufferPool -> BufferPool
Gst.BufferPool.BufferPool) Ptr BufferPool
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    BufferPool -> IO BufferPool
forall (m :: * -> *) a. Monad m => a -> m a
return BufferPool
result'

#if defined(ENABLE_OVERLOADING)
data AggregatorGetBufferPoolMethodInfo
instance (signature ~ (m Gst.BufferPool.BufferPool), MonadIO m, IsAggregator a) => O.MethodInfo AggregatorGetBufferPoolMethodInfo a signature where
    overloadedMethod = aggregatorGetBufferPool

#endif

-- method Aggregator::get_latency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "Aggregator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAggregator" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_aggregator_get_latency" gst_aggregator_get_latency :: 
    Ptr Aggregator ->                       -- self : TInterface (Name {namespace = "GstBase", name = "Aggregator"})
    IO Word64

-- | Retrieves the latency values reported by /@self@/ in response to the latency
-- query, or 'GI.Gst.Constants.CLOCK_TIME_NONE' if there is not live source connected and the element
-- will not wait for the clock.
-- 
-- Typically only called by subclasses.
aggregatorGetLatency ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregator a) =>
    a
    -- ^ /@self@/: a t'GI.GstBase.Objects.Aggregator.Aggregator'
    -> m Word64
    -- ^ __Returns:__ The latency or 'GI.Gst.Constants.CLOCK_TIME_NONE' if the element does not sync
aggregatorGetLatency :: a -> m Word64
aggregatorGetLatency self :: a
self = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Aggregator
self' <- a -> IO (Ptr Aggregator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word64
result <- Ptr Aggregator -> IO Word64
gst_aggregator_get_latency Ptr Aggregator
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AggregatorGetLatencyMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsAggregator a) => O.MethodInfo AggregatorGetLatencyMethodInfo a signature where
    overloadedMethod = aggregatorGetLatency

#endif

-- method Aggregator::set_latency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "Aggregator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAggregator" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_latency"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "minimum latency" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max_latency"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "maximum latency" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_aggregator_set_latency" gst_aggregator_set_latency :: 
    Ptr Aggregator ->                       -- self : TInterface (Name {namespace = "GstBase", name = "Aggregator"})
    Word64 ->                               -- min_latency : TBasicType TUInt64
    Word64 ->                               -- max_latency : TBasicType TUInt64
    IO ()

-- | Lets t'GI.GstBase.Objects.Aggregator.Aggregator' sub-classes tell the baseclass what their internal
-- latency is. Will also post a LATENCY message on the bus so the pipeline
-- can reconfigure its global latency.
aggregatorSetLatency ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregator a) =>
    a
    -- ^ /@self@/: a t'GI.GstBase.Objects.Aggregator.Aggregator'
    -> Word64
    -- ^ /@minLatency@/: minimum latency
    -> Word64
    -- ^ /@maxLatency@/: maximum latency
    -> m ()
aggregatorSetLatency :: a -> Word64 -> Word64 -> m ()
aggregatorSetLatency self :: a
self minLatency :: Word64
minLatency maxLatency :: Word64
maxLatency = 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 Aggregator
self' <- a -> IO (Ptr Aggregator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Aggregator -> Word64 -> Word64 -> IO ()
gst_aggregator_set_latency Ptr Aggregator
self' Word64
minLatency Word64
maxLatency
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AggregatorSetLatencyMethodInfo
instance (signature ~ (Word64 -> Word64 -> m ()), MonadIO m, IsAggregator a) => O.MethodInfo AggregatorSetLatencyMethodInfo a signature where
    overloadedMethod = aggregatorSetLatency

#endif

-- method Aggregator::set_src_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "Aggregator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstAggregator" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstCaps to set on the src pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_aggregator_set_src_caps" gst_aggregator_set_src_caps :: 
    Ptr Aggregator ->                       -- self : TInterface (Name {namespace = "GstBase", name = "Aggregator"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO ()

-- | Sets the caps to be used on the src pad.
aggregatorSetSrcCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregator a) =>
    a
    -- ^ /@self@/: The t'GI.GstBase.Objects.Aggregator.Aggregator'
    -> Gst.Caps.Caps
    -- ^ /@caps@/: The t'GI.Gst.Structs.Caps.Caps' to set on the src pad.
    -> m ()
aggregatorSetSrcCaps :: a -> Caps -> m ()
aggregatorSetSrcCaps self :: a
self caps :: Caps
caps = 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 Aggregator
self' <- a -> IO (Ptr Aggregator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr Aggregator -> Ptr Caps -> IO ()
gst_aggregator_set_src_caps Ptr Aggregator
self' Ptr Caps
caps'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AggregatorSetSrcCapsMethodInfo
instance (signature ~ (Gst.Caps.Caps -> m ()), MonadIO m, IsAggregator a) => O.MethodInfo AggregatorSetSrcCapsMethodInfo a signature where
    overloadedMethod = aggregatorSetSrcCaps

#endif

-- method Aggregator::simple_get_next_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "Aggregator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstAggregator" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_aggregator_simple_get_next_time" gst_aggregator_simple_get_next_time :: 
    Ptr Aggregator ->                       -- self : TInterface (Name {namespace = "GstBase", name = "Aggregator"})
    IO Word64

-- | This is a simple t'GI.GstBase.Objects.Aggregator.Aggregator'::@/get_next_time/@ implementation that
-- just looks at the t'GI.Gst.Structs.Segment.Segment' on the srcpad of the aggregator and bases
-- the next time on the running time there.
-- 
-- This is the desired behaviour in most cases where you have a live source
-- and you have a dead line based aggregator subclass.
-- 
-- /Since: 1.16/
aggregatorSimpleGetNextTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregator a) =>
    a
    -- ^ /@self@/: A t'GI.GstBase.Objects.Aggregator.Aggregator'
    -> m Word64
    -- ^ __Returns:__ The running time based on the position
aggregatorSimpleGetNextTime :: a -> m Word64
aggregatorSimpleGetNextTime self :: a
self = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Aggregator
self' <- a -> IO (Ptr Aggregator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word64
result <- Ptr Aggregator -> IO Word64
gst_aggregator_simple_get_next_time Ptr Aggregator
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AggregatorSimpleGetNextTimeMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsAggregator a) => O.MethodInfo AggregatorSimpleGetNextTimeMethodInfo a signature where
    overloadedMethod = aggregatorSimpleGetNextTime

#endif