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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- 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
--    'GI.GstBase.Objects.AggregatorPad.aggregatorPadPeekBuffer' 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.
-- 
--  * When 'GI.GstBase.Objects.AggregatorPad.aggregatorPadPeekBuffer' or 'GI.GstBase.Objects.AggregatorPad.aggregatorPadHasBuffer'
--    are called, a reference is taken to the returned buffer, which stays
--    valid until either:
-- 
--      - 'GI.GstBase.Objects.AggregatorPad.aggregatorPadPopBuffer' is called, in which case the caller
--        is guaranteed that the buffer they receive is the same as the peeked
--        buffer.
--      - 'GI.GstBase.Objects.AggregatorPad.aggregatorPadDropBuffer' is called, in which case the caller
--        is guaranteed that the dropped buffer is the one that was peeked.
--      - the subclass implementation of t'GI.GstBase.Structs.AggregatorClass.AggregatorClass'.@/aggregate/@ returns.
-- 
--    Subsequent calls to 'GI.GstBase.Objects.AggregatorPad.aggregatorPadPeekBuffer' or
--    'GI.GstBase.Objects.AggregatorPad.aggregatorPadHasBuffer' return \/ check the same buffer that was
--    returned \/ checked, until one of the conditions listed above is met.
-- 
--    Subclasses are only allowed to call these methods from the aggregate
--    thread.
-- 
--  * If the subclass wishes to push a buffer downstream in its aggregate
--    implementation, it should do so through the
--    'GI.GstBase.Objects.Aggregator.aggregatorFinishBuffer' method. This method will take care
--    of sending and ordering mandatory events such as stream start, caps
--    and segment. Buffer lists can also be pushed out with
--    'GI.GstBase.Objects.Aggregator.aggregatorFinishBufferList'.
-- 
--  * 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                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [abortState]("GI.Gst.Objects.Element#g:method:abortState"), [addControlBinding]("GI.Gst.Objects.Object#g:method:addControlBinding"), [addPad]("GI.Gst.Objects.Element#g:method:addPad"), [addPropertyDeepNotifyWatch]("GI.Gst.Objects.Element#g:method:addPropertyDeepNotifyWatch"), [addPropertyNotifyWatch]("GI.Gst.Objects.Element#g:method:addPropertyNotifyWatch"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [callAsync]("GI.Gst.Objects.Element#g:method:callAsync"), [changeState]("GI.Gst.Objects.Element#g:method:changeState"), [continueState]("GI.Gst.Objects.Element#g:method:continueState"), [createAllPads]("GI.Gst.Objects.Element#g:method:createAllPads"), [defaultError]("GI.Gst.Objects.Object#g:method:defaultError"), [finishBuffer]("GI.GstBase.Objects.Aggregator#g:method:finishBuffer"), [finishBufferList]("GI.GstBase.Objects.Aggregator#g:method:finishBufferList"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [foreachPad]("GI.Gst.Objects.Element#g:method:foreachPad"), [foreachSinkPad]("GI.Gst.Objects.Element#g:method:foreachSinkPad"), [foreachSrcPad]("GI.Gst.Objects.Element#g:method:foreachSrcPad"), [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"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isLockedState]("GI.Gst.Objects.Element#g:method:isLockedState"), [iteratePads]("GI.Gst.Objects.Element#g:method:iteratePads"), [iterateSinkPads]("GI.Gst.Objects.Element#g:method:iterateSinkPads"), [iterateSrcPads]("GI.Gst.Objects.Element#g:method:iterateSrcPads"), [link]("GI.Gst.Objects.Element#g:method:link"), [linkFiltered]("GI.Gst.Objects.Element#g:method:linkFiltered"), [linkPads]("GI.Gst.Objects.Element#g:method:linkPads"), [linkPadsFiltered]("GI.Gst.Objects.Element#g:method:linkPadsFiltered"), [linkPadsFull]("GI.Gst.Objects.Element#g:method:linkPadsFull"), [lostState]("GI.Gst.Objects.Element#g:method:lostState"), [messageFull]("GI.Gst.Objects.Element#g:method:messageFull"), [messageFullWithDetails]("GI.Gst.Objects.Element#g:method:messageFullWithDetails"), [negotiate]("GI.GstBase.Objects.Aggregator#g:method:negotiate"), [noMorePads]("GI.Gst.Objects.Element#g:method:noMorePads"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [peekNextSample]("GI.GstBase.Objects.Aggregator#g:method:peekNextSample"), [postMessage]("GI.Gst.Objects.Element#g:method:postMessage"), [provideClock]("GI.Gst.Objects.Element#g:method:provideClock"), [query]("GI.Gst.Objects.Element#g:method:query"), [queryConvert]("GI.Gst.Objects.Element#g:method:queryConvert"), [queryDuration]("GI.Gst.Objects.Element#g:method:queryDuration"), [queryPosition]("GI.Gst.Objects.Element#g:method:queryPosition"), [ref]("GI.Gst.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [releaseRequestPad]("GI.Gst.Objects.Element#g:method:releaseRequestPad"), [removeControlBinding]("GI.Gst.Objects.Object#g:method:removeControlBinding"), [removePad]("GI.Gst.Objects.Element#g:method:removePad"), [removePropertyNotifyWatch]("GI.Gst.Objects.Element#g:method:removePropertyNotifyWatch"), [requestPad]("GI.Gst.Objects.Element#g:method:requestPad"), [requestPadSimple]("GI.Gst.Objects.Element#g:method:requestPadSimple"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [seek]("GI.Gst.Objects.Element#g:method:seek"), [seekSimple]("GI.Gst.Objects.Element#g:method:seekSimple"), [selectedSamples]("GI.GstBase.Objects.Aggregator#g:method:selectedSamples"), [sendEvent]("GI.Gst.Objects.Element#g:method:sendEvent"), [simpleGetNextTime]("GI.GstBase.Objects.Aggregator#g:method:simpleGetNextTime"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [suggestNextSync]("GI.Gst.Objects.Object#g:method:suggestNextSync"), [syncStateWithParent]("GI.Gst.Objects.Element#g:method:syncStateWithParent"), [syncValues]("GI.Gst.Objects.Object#g:method:syncValues"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unlink]("GI.Gst.Objects.Element#g:method:unlink"), [unlinkPads]("GI.Gst.Objects.Element#g:method:unlinkPads"), [unparent]("GI.Gst.Objects.Object#g:method:unparent"), [unref]("GI.Gst.Objects.Object#g:method:unref"), [updateSegment]("GI.GstBase.Objects.Aggregator#g:method:updateSegment"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAllocator]("GI.GstBase.Objects.Aggregator#g:method:getAllocator"), [getBaseTime]("GI.Gst.Objects.Element#g:method:getBaseTime"), [getBufferPool]("GI.GstBase.Objects.Aggregator#g:method:getBufferPool"), [getBus]("GI.Gst.Objects.Element#g:method:getBus"), [getClock]("GI.Gst.Objects.Element#g:method:getClock"), [getCompatiblePad]("GI.Gst.Objects.Element#g:method:getCompatiblePad"), [getCompatiblePadTemplate]("GI.Gst.Objects.Element#g:method:getCompatiblePadTemplate"), [getContext]("GI.Gst.Objects.Element#g:method:getContext"), [getContextUnlocked]("GI.Gst.Objects.Element#g:method:getContextUnlocked"), [getContexts]("GI.Gst.Objects.Element#g:method:getContexts"), [getControlBinding]("GI.Gst.Objects.Object#g:method:getControlBinding"), [getControlRate]("GI.Gst.Objects.Object#g:method:getControlRate"), [getCurrentClockTime]("GI.Gst.Objects.Element#g:method:getCurrentClockTime"), [getCurrentRunningTime]("GI.Gst.Objects.Element#g:method:getCurrentRunningTime"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFactory]("GI.Gst.Objects.Element#g:method:getFactory"), [getGValueArray]("GI.Gst.Objects.Object#g:method:getGValueArray"), [getLatency]("GI.GstBase.Objects.Aggregator#g:method:getLatency"), [getMetadata]("GI.Gst.Objects.Element#g:method:getMetadata"), [getName]("GI.Gst.Objects.Object#g:method:getName"), [getPadTemplate]("GI.Gst.Objects.Element#g:method:getPadTemplate"), [getPadTemplateList]("GI.Gst.Objects.Element#g:method:getPadTemplateList"), [getParent]("GI.Gst.Objects.Object#g:method:getParent"), [getPathString]("GI.Gst.Objects.Object#g:method:getPathString"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRequestPad]("GI.Gst.Objects.Element#g:method:getRequestPad"), [getStartTime]("GI.Gst.Objects.Element#g:method:getStartTime"), [getState]("GI.Gst.Objects.Element#g:method:getState"), [getStaticPad]("GI.Gst.Objects.Element#g:method:getStaticPad"), [getValue]("GI.Gst.Objects.Object#g:method:getValue").
-- 
-- ==== Setters
-- [setBaseTime]("GI.Gst.Objects.Element#g:method:setBaseTime"), [setBus]("GI.Gst.Objects.Element#g:method:setBus"), [setClock]("GI.Gst.Objects.Element#g:method:setClock"), [setContext]("GI.Gst.Objects.Element#g:method:setContext"), [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"), [setLatency]("GI.GstBase.Objects.Aggregator#g:method:setLatency"), [setLockedState]("GI.Gst.Objects.Element#g:method:setLockedState"), [setName]("GI.Gst.Objects.Object#g:method:setName"), [setParent]("GI.Gst.Objects.Object#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSrcCaps]("GI.GstBase.Objects.Aggregator#g:method:setSrcCaps"), [setStartTime]("GI.Gst.Objects.Element#g:method:setStartTime"), [setState]("GI.Gst.Objects.Element#g:method:setState").

#if defined(ENABLE_OVERLOADING)
    ResolveAggregatorMethod                 ,
#endif

-- ** finishBuffer #method:finishBuffer#

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


-- ** finishBufferList #method:finishBufferList#

#if defined(ENABLE_OVERLOADING)
    AggregatorFinishBufferListMethodInfo    ,
#endif
    aggregatorFinishBufferList              ,


-- ** 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                    ,


-- ** negotiate #method:negotiate#

#if defined(ENABLE_OVERLOADING)
    AggregatorNegotiateMethodInfo           ,
#endif
    aggregatorNegotiate                     ,


-- ** peekNextSample #method:peekNextSample#

#if defined(ENABLE_OVERLOADING)
    AggregatorPeekNextSampleMethodInfo      ,
#endif
    aggregatorPeekNextSample                ,


-- ** selectedSamples #method:selectedSamples#

#if defined(ENABLE_OVERLOADING)
    AggregatorSelectedSamplesMethodInfo     ,
#endif
    aggregatorSelectedSamples               ,


-- ** 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             ,


-- ** updateSegment #method:updateSegment#

#if defined(ENABLE_OVERLOADING)
    AggregatorUpdateSegmentMethodInfo       ,
#endif
    aggregatorUpdateSegment                 ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    AggregatorEmitSignalsPropertyInfo       ,
#endif
#if defined(ENABLE_OVERLOADING)
    aggregatorEmitSignals                   ,
#endif
    constructAggregatorEmitSignals          ,
    getAggregatorEmitSignals                ,
    setAggregatorEmitSignals                ,


-- ** 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                  ,


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

#if defined(ENABLE_OVERLOADING)
    AggregatorStartTimeSelectionPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    aggregatorStartTimeSelection            ,
#endif
    constructAggregatorStartTimeSelection   ,
    getAggregatorStartTimeSelection         ,
    setAggregatorStartTimeSelection         ,




 -- * Signals


-- ** samplesSelected #signal:samplesSelected#

    AggregatorSamplesSelectedCallback       ,
#if defined(ENABLE_OVERLOADING)
    AggregatorSamplesSelectedSignalInfo     ,
#endif
    afterAggregatorSamplesSelected          ,
    onAggregatorSamplesSelected             ,




    ) 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.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.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.BufferList as Gst.BufferList
import qualified GI.Gst.Structs.Caps as Gst.Caps
import qualified GI.Gst.Structs.Sample as Gst.Sample
import qualified GI.Gst.Structs.Segment as Gst.Segment
import qualified GI.Gst.Structs.Structure as Gst.Structure
import {-# SOURCE #-} qualified GI.GstBase.Enums as GstBase.Enums
import {-# SOURCE #-} qualified GI.GstBase.Objects.AggregatorPad as GstBase.AggregatorPad

-- | Memory-managed wrapper type.
newtype Aggregator = Aggregator (SP.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)

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

foreign import ccall "gst_aggregator_get_type"
    c_gst_aggregator_get_type :: IO B.Types.GType

instance B.Types.TypedObject Aggregator where
    glibType :: IO GType
glibType = IO GType
c_gst_aggregator_get_type

instance B.Types.GObject Aggregator

-- | Type class for types which can be safely cast to `Aggregator`, for instance with `toAggregator`.
class (SP.GObject o, O.IsDescendantOf Aggregator o) => IsAggregator o
instance (SP.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 :: (MIO.MonadIO m, IsAggregator o) => o -> m Aggregator
toAggregator :: forall (m :: * -> *) o.
(MonadIO m, IsAggregator o) =>
o -> m Aggregator
toAggregator = IO Aggregator -> m Aggregator
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Aggregator -> Aggregator
Aggregator

-- | Convert 'Aggregator' 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 Aggregator) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_aggregator_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Aggregator -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Aggregator
P.Nothing = Ptr GValue -> Ptr Aggregator -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Aggregator
forall a. Ptr a
FP.nullPtr :: FP.Ptr Aggregator)
    gvalueSet_ Ptr GValue
gv (P.Just Aggregator
obj) = Aggregator -> (Ptr Aggregator -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Aggregator
obj (Ptr GValue -> Ptr Aggregator -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Aggregator)
gvalueGet_ Ptr GValue
gv = do
        Ptr Aggregator
ptr <- Ptr GValue -> IO (Ptr Aggregator)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Aggregator)
        if Ptr Aggregator
ptr Ptr Aggregator -> Ptr Aggregator -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Aggregator
forall a. Ptr a
FP.nullPtr
        then Aggregator -> Maybe Aggregator
forall a. a -> Maybe a
P.Just (Aggregator -> Maybe Aggregator)
-> IO Aggregator -> IO (Maybe Aggregator)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
        else Maybe Aggregator -> IO (Maybe Aggregator)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Aggregator
forall a. Maybe a
P.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 "finishBufferList" o = AggregatorFinishBufferListMethodInfo
    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 "negotiate" o = AggregatorNegotiateMethodInfo
    ResolveAggregatorMethod "noMorePads" o = Gst.Element.ElementNoMorePadsMethodInfo
    ResolveAggregatorMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAggregatorMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAggregatorMethod "peekNextSample" o = AggregatorPeekNextSampleMethodInfo
    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 "requestPadSimple" o = Gst.Element.ElementRequestPadSimpleMethodInfo
    ResolveAggregatorMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAggregatorMethod "seek" o = Gst.Element.ElementSeekMethodInfo
    ResolveAggregatorMethod "seekSimple" o = Gst.Element.ElementSeekSimpleMethodInfo
    ResolveAggregatorMethod "selectedSamples" o = AggregatorSelectedSamplesMethodInfo
    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 "updateSegment" o = AggregatorUpdateSegmentMethodInfo
    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 "getCurrentClockTime" o = Gst.Element.ElementGetCurrentClockTimeMethodInfo
    ResolveAggregatorMethod "getCurrentRunningTime" o = Gst.Element.ElementGetCurrentRunningTimeMethodInfo
    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.OverloadedMethod 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

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

#endif

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

#endif

-- signal Aggregator::samples-selected
-- | Signals that the t'GI.GstBase.Objects.Aggregator.Aggregator' subclass has selected the next set
-- of input samples it will aggregate. Handlers may call
-- 'GI.GstBase.Objects.Aggregator.aggregatorPeekNextSample' at that point.
-- 
-- /Since: 1.18/
type AggregatorSamplesSelectedCallback =
    Gst.Segment.Segment
    -- ^ /@segment@/: The t'GI.Gst.Structs.Segment.Segment' the next output buffer is part of
    -> Word64
    -- ^ /@pts@/: The presentation timestamp of the next output buffer
    -> Word64
    -- ^ /@dts@/: The decoding timestamp of the next output buffer
    -> Word64
    -- ^ /@duration@/: The duration of the next output buffer
    -> Maybe Gst.Structure.Structure
    -- ^ /@info@/: a t'GI.Gst.Structs.Structure.Structure' containing additional information
    -> IO ()

type C_AggregatorSamplesSelectedCallback =
    Ptr Aggregator ->                       -- object
    Ptr Gst.Segment.Segment ->
    Word64 ->
    Word64 ->
    Word64 ->
    Ptr Gst.Structure.Structure ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_AggregatorSamplesSelectedCallback :: 
    GObject a => (a -> AggregatorSamplesSelectedCallback) ->
    C_AggregatorSamplesSelectedCallback
wrap_AggregatorSamplesSelectedCallback :: forall a.
GObject a =>
(a -> AggregatorSamplesSelectedCallback)
-> C_AggregatorSamplesSelectedCallback
wrap_AggregatorSamplesSelectedCallback a -> AggregatorSamplesSelectedCallback
gi'cb Ptr Aggregator
gi'selfPtr Ptr Segment
segment Word64
pts Word64
dts Word64
duration Ptr Structure
info Ptr ()
_ = do
    Ptr Segment -> (Segment -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr Segment
segment ((Segment -> IO ()) -> IO ()) -> (Segment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Segment
segment' -> do
        Maybe Structure
maybeInfo <-
            if Ptr Structure
info Ptr Structure -> Ptr Structure -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Structure
forall a. Ptr a
nullPtr
            then Maybe Structure -> IO (Maybe Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Structure
forall a. Maybe a
Nothing
            else do
                Ptr Structure
-> (Structure -> IO (Maybe Structure)) -> IO (Maybe Structure)
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr Structure
info ((Structure -> IO (Maybe Structure)) -> IO (Maybe Structure))
-> (Structure -> IO (Maybe Structure)) -> IO (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ \Structure
info' -> do
                    Maybe Structure -> IO (Maybe Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Structure -> IO (Maybe Structure))
-> Maybe Structure -> IO (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ Structure -> Maybe Structure
forall a. a -> Maybe a
Just Structure
info'
        Ptr Aggregator -> (Aggregator -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Aggregator
gi'selfPtr ((Aggregator -> IO ()) -> IO ()) -> (Aggregator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Aggregator
gi'self -> a -> AggregatorSamplesSelectedCallback
gi'cb (Aggregator -> a
Coerce.coerce Aggregator
gi'self)  Segment
segment' Word64
pts Word64
dts Word64
duration Maybe Structure
maybeInfo


-- | Connect a signal handler for the [samplesSelected](#signal:samplesSelected) 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' aggregator #samplesSelected callback
-- @
-- 
-- 
onAggregatorSamplesSelected :: (IsAggregator a, MonadIO m) => a -> ((?self :: a) => AggregatorSamplesSelectedCallback) -> m SignalHandlerId
onAggregatorSamplesSelected :: forall a (m :: * -> *).
(IsAggregator a, MonadIO m) =>
a
-> ((?self::a) => AggregatorSamplesSelectedCallback)
-> m SignalHandlerId
onAggregatorSamplesSelected a
obj (?self::a) => AggregatorSamplesSelectedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
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 -> AggregatorSamplesSelectedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => AggregatorSamplesSelectedCallback
AggregatorSamplesSelectedCallback
cb
    let wrapped' :: C_AggregatorSamplesSelectedCallback
wrapped' = (a -> AggregatorSamplesSelectedCallback)
-> C_AggregatorSamplesSelectedCallback
forall a.
GObject a =>
(a -> AggregatorSamplesSelectedCallback)
-> C_AggregatorSamplesSelectedCallback
wrap_AggregatorSamplesSelectedCallback a -> AggregatorSamplesSelectedCallback
wrapped
    FunPtr C_AggregatorSamplesSelectedCallback
wrapped'' <- C_AggregatorSamplesSelectedCallback
-> IO (FunPtr C_AggregatorSamplesSelectedCallback)
mk_AggregatorSamplesSelectedCallback C_AggregatorSamplesSelectedCallback
wrapped'
    a
-> Text
-> FunPtr C_AggregatorSamplesSelectedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"samples-selected" FunPtr C_AggregatorSamplesSelectedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [samplesSelected](#signal:samplesSelected) 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' aggregator #samplesSelected 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.
-- 
afterAggregatorSamplesSelected :: (IsAggregator a, MonadIO m) => a -> ((?self :: a) => AggregatorSamplesSelectedCallback) -> m SignalHandlerId
afterAggregatorSamplesSelected :: forall a (m :: * -> *).
(IsAggregator a, MonadIO m) =>
a
-> ((?self::a) => AggregatorSamplesSelectedCallback)
-> m SignalHandlerId
afterAggregatorSamplesSelected a
obj (?self::a) => AggregatorSamplesSelectedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
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 -> AggregatorSamplesSelectedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => AggregatorSamplesSelectedCallback
AggregatorSamplesSelectedCallback
cb
    let wrapped' :: C_AggregatorSamplesSelectedCallback
wrapped' = (a -> AggregatorSamplesSelectedCallback)
-> C_AggregatorSamplesSelectedCallback
forall a.
GObject a =>
(a -> AggregatorSamplesSelectedCallback)
-> C_AggregatorSamplesSelectedCallback
wrap_AggregatorSamplesSelectedCallback a -> AggregatorSamplesSelectedCallback
wrapped
    FunPtr C_AggregatorSamplesSelectedCallback
wrapped'' <- C_AggregatorSamplesSelectedCallback
-> IO (FunPtr C_AggregatorSamplesSelectedCallback)
mk_AggregatorSamplesSelectedCallback C_AggregatorSamplesSelectedCallback
wrapped'
    a
-> Text
-> FunPtr C_AggregatorSamplesSelectedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"samples-selected" FunPtr C_AggregatorSamplesSelectedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data AggregatorSamplesSelectedSignalInfo
instance SignalInfo AggregatorSamplesSelectedSignalInfo where
    type HaskellCallbackType AggregatorSamplesSelectedSignalInfo = AggregatorSamplesSelectedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_AggregatorSamplesSelectedCallback cb
        cb'' <- mk_AggregatorSamplesSelectedCallback cb'
        connectSignalFunPtr obj "samples-selected" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.Aggregator::samples-selected"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Objects-Aggregator.html#g:signal:samplesSelected"})

#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' aggregator #emitSignals
-- @
getAggregatorEmitSignals :: (MonadIO m, IsAggregator o) => o -> m Bool
getAggregatorEmitSignals :: forall (m :: * -> *) o. (MonadIO m, IsAggregator o) => o -> m Bool
getAggregatorEmitSignals o
obj = IO Bool -> m Bool
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' aggregator [ #emitSignals 'Data.GI.Base.Attributes.:=' value ]
-- @
setAggregatorEmitSignals :: (MonadIO m, IsAggregator o) => o -> Bool -> m ()
setAggregatorEmitSignals :: forall (m :: * -> *) o.
(MonadIO m, IsAggregator o) =>
o -> Bool -> m ()
setAggregatorEmitSignals o
obj Bool
val = IO () -> m ()
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`.
constructAggregatorEmitSignals :: (IsAggregator o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructAggregatorEmitSignals :: forall o (m :: * -> *).
(IsAggregator o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructAggregatorEmitSignals Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 AggregatorEmitSignalsPropertyInfo
instance AttrInfo AggregatorEmitSignalsPropertyInfo where
    type AttrAllowedOps AggregatorEmitSignalsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AggregatorEmitSignalsPropertyInfo = IsAggregator
    type AttrSetTypeConstraint AggregatorEmitSignalsPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint AggregatorEmitSignalsPropertyInfo = (~) Bool
    type AttrTransferType AggregatorEmitSignalsPropertyInfo = Bool
    type AttrGetType AggregatorEmitSignalsPropertyInfo = Bool
    type AttrLabel AggregatorEmitSignalsPropertyInfo = "emit-signals"
    type AttrOrigin AggregatorEmitSignalsPropertyInfo = Aggregator
    attrGet = getAggregatorEmitSignals
    attrSet = setAggregatorEmitSignals
    attrTransfer _ v = do
        return v
    attrConstruct = constructAggregatorEmitSignals
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.Aggregator.emitSignals"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Objects-Aggregator.html#g:attr:emitSignals"
        })
#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 :: forall (m :: * -> *) o.
(MonadIO m, IsAggregator o) =>
o -> m Word64
getAggregatorLatency o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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 String
"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 :: forall (m :: * -> *) o.
(MonadIO m, IsAggregator o) =>
o -> Word64 -> m ()
setAggregatorLatency o
obj Word64
val = IO () -> m ()
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 -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"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, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructAggregatorLatency :: forall o (m :: * -> *).
(IsAggregator o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructAggregatorLatency Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.Aggregator.latency"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Objects-Aggregator.html#g:attr:latency"
        })
#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 :: forall (m :: * -> *) o.
(MonadIO m, IsAggregator o) =>
o -> m Word64
getAggregatorMinUpstreamLatency o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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 String
"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 :: forall (m :: * -> *) o.
(MonadIO m, IsAggregator o) =>
o -> Word64 -> m ()
setAggregatorMinUpstreamLatency o
obj Word64
val = IO () -> m ()
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 -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"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, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructAggregatorMinUpstreamLatency :: forall o (m :: * -> *).
(IsAggregator o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructAggregatorMinUpstreamLatency Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.Aggregator.minUpstreamLatency"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Objects-Aggregator.html#g:attr:minUpstreamLatency"
        })
#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 :: forall (m :: * -> *) o.
(MonadIO m, IsAggregator o) =>
o -> m Word64
getAggregatorStartTime o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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 String
"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 :: forall (m :: * -> *) o.
(MonadIO m, IsAggregator o) =>
o -> Word64 -> m ()
setAggregatorStartTime o
obj Word64
val = IO () -> m ()
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 -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"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, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructAggregatorStartTime :: forall o (m :: * -> *).
(IsAggregator o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructAggregatorStartTime Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.Aggregator.startTime"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Objects-Aggregator.html#g:attr:startTime"
        })
#endif

-- VVV Prop "start-time-selection"
   -- Type: TInterface (Name {namespace = "GstBase", name = "AggregatorStartTimeSelection"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@start-time-selection@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' aggregator [ #startTimeSelection 'Data.GI.Base.Attributes.:=' value ]
-- @
setAggregatorStartTimeSelection :: (MonadIO m, IsAggregator o) => o -> GstBase.Enums.AggregatorStartTimeSelection -> m ()
setAggregatorStartTimeSelection :: forall (m :: * -> *) o.
(MonadIO m, IsAggregator o) =>
o -> AggregatorStartTimeSelection -> m ()
setAggregatorStartTimeSelection o
obj AggregatorStartTimeSelection
val = IO () -> m ()
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 -> AggregatorStartTimeSelection -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"start-time-selection" AggregatorStartTimeSelection
val

-- | Construct a `GValueConstruct` with valid value for the “@start-time-selection@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAggregatorStartTimeSelection :: (IsAggregator o, MIO.MonadIO m) => GstBase.Enums.AggregatorStartTimeSelection -> m (GValueConstruct o)
constructAggregatorStartTimeSelection :: forall o (m :: * -> *).
(IsAggregator o, MonadIO m) =>
AggregatorStartTimeSelection -> m (GValueConstruct o)
constructAggregatorStartTimeSelection AggregatorStartTimeSelection
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> AggregatorStartTimeSelection -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"start-time-selection" AggregatorStartTimeSelection
val

#if defined(ENABLE_OVERLOADING)
data AggregatorStartTimeSelectionPropertyInfo
instance AttrInfo AggregatorStartTimeSelectionPropertyInfo where
    type AttrAllowedOps AggregatorStartTimeSelectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AggregatorStartTimeSelectionPropertyInfo = IsAggregator
    type AttrSetTypeConstraint AggregatorStartTimeSelectionPropertyInfo = (~) GstBase.Enums.AggregatorStartTimeSelection
    type AttrTransferTypeConstraint AggregatorStartTimeSelectionPropertyInfo = (~) GstBase.Enums.AggregatorStartTimeSelection
    type AttrTransferType AggregatorStartTimeSelectionPropertyInfo = GstBase.Enums.AggregatorStartTimeSelection
    type AttrGetType AggregatorStartTimeSelectionPropertyInfo = GstBase.Enums.AggregatorStartTimeSelection
    type AttrLabel AggregatorStartTimeSelectionPropertyInfo = "start-time-selection"
    type AttrOrigin AggregatorStartTimeSelectionPropertyInfo = Aggregator
    attrGet = getAggregatorStartTimeSelection
    attrSet = setAggregatorStartTimeSelection
    attrTransfer _ v = do
        return v
    attrConstruct = constructAggregatorStartTimeSelection
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.Aggregator.startTimeSelection"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Objects-Aggregator.html#g:attr:startTimeSelection"
        })
#endif

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

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

aggregatorLatency :: AttrLabelProxy "latency"
aggregatorLatency = AttrLabelProxy

aggregatorMinUpstreamLatency :: AttrLabelProxy "minUpstreamLatency"
aggregatorMinUpstreamLatency = AttrLabelProxy

aggregatorStartTime :: AttrLabelProxy "startTime"
aggregatorStartTime = AttrLabelProxy

aggregatorStartTimeSelection :: AttrLabelProxy "startTimeSelection"
aggregatorStartTimeSelection = 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), '("samplesSelected", AggregatorSamplesSelectedSignalInfo)] :: [(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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregator a) =>
a -> Buffer -> m FlowReturn
aggregatorFinishBuffer a
aggregator 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, GBoxed 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.OverloadedMethod AggregatorFinishBufferMethodInfo a signature where
    overloadedMethod = aggregatorFinishBuffer

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


#endif

-- method Aggregator::finish_buffer_list
-- 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 = "bufferlist"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstBufferList 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_list" gst_aggregator_finish_buffer_list :: 
    Ptr Aggregator ->                       -- aggregator : TInterface (Name {namespace = "GstBase", name = "Aggregator"})
    Ptr Gst.BufferList.BufferList ->        -- bufferlist : TInterface (Name {namespace = "Gst", name = "BufferList"})
    IO CInt

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

#if defined(ENABLE_OVERLOADING)
data AggregatorFinishBufferListMethodInfo
instance (signature ~ (Gst.BufferList.BufferList -> m Gst.Enums.FlowReturn), MonadIO m, IsAggregator a) => O.OverloadedMethod AggregatorFinishBufferListMethodInfo a signature where
    overloadedMethod = aggregatorFinishBufferList

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


#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 = True
--           , 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 = TransferNothing
--           }
--       ]
-- 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 ((Maybe Gst.Allocator.Allocator, Gst.AllocationParams.AllocationParams))
aggregatorGetAllocator :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregator a) =>
a -> m (Maybe Allocator, AllocationParams)
aggregatorGetAllocator a
self = IO (Maybe Allocator, AllocationParams)
-> m (Maybe Allocator, AllocationParams)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Allocator, AllocationParams)
 -> m (Maybe Allocator, AllocationParams))
-> IO (Maybe Allocator, AllocationParams)
-> m (Maybe 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)
callocMem :: IO (Ptr (Ptr Gst.Allocator.Allocator))
    Ptr AllocationParams
params <- Int -> IO (Ptr AllocationParams)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
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
    Maybe Allocator
maybeAllocator' <- Ptr Allocator
-> (Ptr Allocator -> IO Allocator) -> IO (Maybe Allocator)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Allocator
allocator' ((Ptr Allocator -> IO Allocator) -> IO (Maybe Allocator))
-> (Ptr Allocator -> IO Allocator) -> IO (Maybe Allocator)
forall a b. (a -> b) -> a -> b
$ \Ptr Allocator
allocator'' -> do
        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''
        Allocator -> IO Allocator
forall (m :: * -> *) a. Monad m => a -> m a
return Allocator
allocator'''
    AllocationParams
params' <- ((ManagedPtr AllocationParams -> AllocationParams)
-> Ptr AllocationParams -> IO AllocationParams
forall a.
(HasCallStack, GBoxed 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
    (Maybe Allocator, AllocationParams)
-> IO (Maybe Allocator, AllocationParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Allocator
maybeAllocator', AllocationParams
params')

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

instance O.OverloadedMethodInfo AggregatorGetAllocatorMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.Aggregator.aggregatorGetAllocator",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Objects-Aggregator.html#v: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 (Maybe Gst.BufferPool.BufferPool)
    -- ^ __Returns:__ the instance of the t'GI.Gst.Objects.BufferPool.BufferPool' used
    -- by /@trans@/; free it after use it
aggregatorGetBufferPool :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregator a) =>
a -> m (Maybe BufferPool)
aggregatorGetBufferPool a
self = IO (Maybe BufferPool) -> m (Maybe BufferPool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BufferPool) -> m (Maybe BufferPool))
-> IO (Maybe BufferPool) -> m (Maybe 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'
    Maybe BufferPool
maybeResult <- Ptr BufferPool
-> (Ptr BufferPool -> IO BufferPool) -> IO (Maybe BufferPool)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr BufferPool
result ((Ptr BufferPool -> IO BufferPool) -> IO (Maybe BufferPool))
-> (Ptr BufferPool -> IO BufferPool) -> IO (Maybe BufferPool)
forall a b. (a -> b) -> a -> b
$ \Ptr BufferPool
result' -> do
        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'
        BufferPool -> IO BufferPool
forall (m :: * -> *) a. Monad m => a -> m a
return BufferPool
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe BufferPool -> IO (Maybe BufferPool)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BufferPool
maybeResult

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

instance O.OverloadedMethodInfo AggregatorGetBufferPoolMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.Aggregator.aggregatorGetBufferPool",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Objects-Aggregator.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregator a) =>
a -> m Word64
aggregatorGetLatency 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.OverloadedMethod AggregatorGetLatencyMethodInfo a signature where
    overloadedMethod = aggregatorGetLatency

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


#endif

-- method Aggregator::negotiate
-- 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 TBoolean)
-- throws : False
-- Skip return : False

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

-- | Negotiates src pad caps with downstream elements.
-- Unmarks GST_PAD_FLAG_NEED_RECONFIGURE in any case. But marks it again
-- if t'GI.GstBase.Structs.AggregatorClass.AggregatorClass'::@/negotiate/@ fails.
-- 
-- /Since: 1.18/
aggregatorNegotiate ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregator a) =>
    a
    -- ^ /@self@/: a t'GI.GstBase.Objects.Aggregator.Aggregator'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the negotiation succeeded, else 'P.False'.
aggregatorNegotiate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregator a) =>
a -> m Bool
aggregatorNegotiate a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Aggregator
self' <- a -> IO (Ptr Aggregator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Aggregator -> IO CInt
gst_aggregator_negotiate Ptr Aggregator
self'
    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
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AggregatorNegotiateMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAggregator a) => O.OverloadedMethod AggregatorNegotiateMethodInfo a signature where
    overloadedMethod = aggregatorNegotiate

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


#endif

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

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

-- | Use this function to determine what input buffers will be aggregated
-- to produce the next output buffer. This should only be called from
-- a [samplesSelected]("GI.GstBase.Objects.Aggregator#g:signal:samplesSelected") handler, and can be used to precisely
-- control aggregating parameters for a given set of input samples.
-- 
-- /Since: 1.18/
aggregatorPeekNextSample ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregator a, GstBase.AggregatorPad.IsAggregatorPad b) =>
    a
    -> b
    -> m (Maybe Gst.Sample.Sample)
    -- ^ __Returns:__ The sample that is about to be aggregated. It may hold a t'GI.Gst.Structs.Buffer.Buffer'
    --   or a t'GI.Gst.Structs.BufferList.BufferList'. The contents of its info structure is subclass-dependent,
    --   and documented on a subclass basis. The buffers held by the sample are
    --   not writable.
aggregatorPeekNextSample :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAggregator a, IsAggregatorPad b) =>
a -> b -> m (Maybe Sample)
aggregatorPeekNextSample a
self b
pad = IO (Maybe Sample) -> m (Maybe Sample)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Sample) -> m (Maybe Sample))
-> IO (Maybe Sample) -> m (Maybe Sample)
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 AggregatorPad
pad' <- b -> IO (Ptr AggregatorPad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pad
    Ptr Sample
result <- Ptr Aggregator -> Ptr AggregatorPad -> IO (Ptr Sample)
gst_aggregator_peek_next_sample Ptr Aggregator
self' Ptr AggregatorPad
pad'
    Maybe Sample
maybeResult <- Ptr Sample -> (Ptr Sample -> IO Sample) -> IO (Maybe Sample)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Sample
result ((Ptr Sample -> IO Sample) -> IO (Maybe Sample))
-> (Ptr Sample -> IO Sample) -> IO (Maybe Sample)
forall a b. (a -> b) -> a -> b
$ \Ptr Sample
result' -> do
        Sample
result'' <- ((ManagedPtr Sample -> Sample) -> Ptr Sample -> IO Sample
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Sample -> Sample
Gst.Sample.Sample) Ptr Sample
result'
        Sample -> IO Sample
forall (m :: * -> *) a. Monad m => a -> m a
return Sample
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pad
    Maybe Sample -> IO (Maybe Sample)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Sample
maybeResult

#if defined(ENABLE_OVERLOADING)
data AggregatorPeekNextSampleMethodInfo
instance (signature ~ (b -> m (Maybe Gst.Sample.Sample)), MonadIO m, IsAggregator a, GstBase.AggregatorPad.IsAggregatorPad b) => O.OverloadedMethod AggregatorPeekNextSampleMethodInfo a signature where
    overloadedMethod = aggregatorPeekNextSample

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


#endif

-- method Aggregator::selected_samples
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "Aggregator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pts"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The presentation timestamp of the next output buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dts"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The decoding timestamp of the next output buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "duration"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The duration of the next output buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstStructure containing additional information"
--                 , 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_selected_samples" gst_aggregator_selected_samples :: 
    Ptr Aggregator ->                       -- self : TInterface (Name {namespace = "GstBase", name = "Aggregator"})
    Word64 ->                               -- pts : TBasicType TUInt64
    Word64 ->                               -- dts : TBasicType TUInt64
    Word64 ->                               -- duration : TBasicType TUInt64
    Ptr Gst.Structure.Structure ->          -- info : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO ()

-- | Subclasses should call this when they have prepared the
-- buffers they will aggregate for each of their sink pads, but
-- before using any of the properties of the pads that govern
-- *how* aggregation should be performed, for example z-index
-- for video aggregators.
-- 
-- If 'GI.GstBase.Objects.Aggregator.aggregatorUpdateSegment' is used by the subclass,
-- it MUST be called before 'GI.GstBase.Objects.Aggregator.aggregatorSelectedSamples'.
-- 
-- This function MUST only be called from the t'GI.GstBase.Structs.AggregatorClass.AggregatorClass'::@/aggregate/@()
-- function.
-- 
-- /Since: 1.18/
aggregatorSelectedSamples ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregator a) =>
    a
    -> Word64
    -- ^ /@pts@/: The presentation timestamp of the next output buffer
    -> Word64
    -- ^ /@dts@/: The decoding timestamp of the next output buffer
    -> Word64
    -- ^ /@duration@/: The duration of the next output buffer
    -> Maybe (Gst.Structure.Structure)
    -- ^ /@info@/: a t'GI.Gst.Structs.Structure.Structure' containing additional information
    -> m ()
aggregatorSelectedSamples :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregator a) =>
a -> Word64 -> Word64 -> Word64 -> Maybe Structure -> m ()
aggregatorSelectedSamples a
self Word64
pts Word64
dts Word64
duration Maybe Structure
info = 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 Structure
maybeInfo <- case Maybe Structure
info of
        Maybe Structure
Nothing -> Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
forall a. Ptr a
nullPtr
        Just Structure
jInfo -> do
            Ptr Structure
jInfo' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
jInfo
            Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
jInfo'
    Ptr Aggregator
-> Word64 -> Word64 -> Word64 -> Ptr Structure -> IO ()
gst_aggregator_selected_samples Ptr Aggregator
self' Word64
pts Word64
dts Word64
duration Ptr Structure
maybeInfo
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Structure -> (Structure -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Structure
info Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AggregatorSelectedSamplesMethodInfo
instance (signature ~ (Word64 -> Word64 -> Word64 -> Maybe (Gst.Structure.Structure) -> m ()), MonadIO m, IsAggregator a) => O.OverloadedMethod AggregatorSelectedSamplesMethodInfo a signature where
    overloadedMethod = aggregatorSelectedSamples

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


#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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregator a) =>
a -> Word64 -> Word64 -> m ()
aggregatorSetLatency a
self Word64
minLatency 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.OverloadedMethod AggregatorSetLatencyMethodInfo a signature where
    overloadedMethod = aggregatorSetLatency

instance O.OverloadedMethodInfo AggregatorSetLatencyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.Aggregator.aggregatorSetLatency",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Objects-Aggregator.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregator a) =>
a -> Caps -> m ()
aggregatorSetSrcCaps a
self 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.OverloadedMethod AggregatorSetSrcCapsMethodInfo a signature where
    overloadedMethod = aggregatorSetSrcCaps

instance O.OverloadedMethodInfo AggregatorSetSrcCapsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstBase.Objects.Aggregator.aggregatorSetSrcCaps",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstbase-1.0.25/docs/GI-GstBase-Objects-Aggregator.html#v: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.Structs.AggregatorClass.AggregatorClass'::@/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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregator a) =>
a -> m Word64
aggregatorSimpleGetNextTime 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.OverloadedMethod AggregatorSimpleGetNextTimeMethodInfo a signature where
    overloadedMethod = aggregatorSimpleGetNextTime

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


#endif

-- method Aggregator::update_segment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "Aggregator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_update_segment" gst_aggregator_update_segment :: 
    Ptr Aggregator ->                       -- self : TInterface (Name {namespace = "GstBase", name = "Aggregator"})
    Ptr Gst.Segment.Segment ->              -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    IO ()

-- | Subclasses should use this to update the segment on their
-- source pad, instead of directly pushing new segment events
-- downstream.
-- 
-- Subclasses MUST call this before 'GI.GstBase.Objects.Aggregator.aggregatorSelectedSamples',
-- if it is used at all.
-- 
-- /Since: 1.18/
aggregatorUpdateSegment ::
    (B.CallStack.HasCallStack, MonadIO m, IsAggregator a) =>
    a
    -> Gst.Segment.Segment
    -> m ()
aggregatorUpdateSegment :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAggregator a) =>
a -> Segment -> m ()
aggregatorUpdateSegment a
self Segment
segment = 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 Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    Ptr Aggregator -> Ptr Segment -> IO ()
gst_aggregator_update_segment Ptr Aggregator
self' Ptr Segment
segment'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AggregatorUpdateSegmentMethodInfo
instance (signature ~ (Gst.Segment.Segment -> m ()), MonadIO m, IsAggregator a) => O.OverloadedMethod AggregatorUpdateSegmentMethodInfo a signature where
    overloadedMethod = aggregatorUpdateSegment

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


#endif