{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gst.Objects.Bin.Bin' is an element that can contain other t'GI.Gst.Objects.Element.Element', allowing them to be
-- managed as a group.
-- Pads from the child elements can be ghosted to the bin, see t'GI.Gst.Objects.GhostPad.GhostPad'.
-- This makes the bin look like any other elements and enables creation of
-- higher-level abstraction elements.
-- 
-- A new t'GI.Gst.Objects.Bin.Bin' is created with 'GI.Gst.Objects.Bin.binNew'. Use a t'GI.Gst.Objects.Pipeline.Pipeline' instead if you
-- want to create a toplevel bin because a normal bin doesn\'t have a bus or
-- handle clock distribution of its own.
-- 
-- After the bin has been created you will typically add elements to it with
-- 'GI.Gst.Objects.Bin.binAdd'. You can remove elements with 'GI.Gst.Objects.Bin.binRemove'.
-- 
-- An element can be retrieved from a bin with 'GI.Gst.Objects.Bin.binGetByName', using the
-- elements name. 'GI.Gst.Objects.Bin.binGetByNameRecurseUp' is mainly used for internal
-- purposes and will query the parent bins when the element is not found in the
-- current bin.
-- 
-- An iterator of elements in a bin can be retrieved with
-- 'GI.Gst.Objects.Bin.binIterateElements'. Various other iterators exist to retrieve the
-- elements in a bin.
-- 
-- 'GI.Gst.Objects.Object.objectUnref' is used to drop your reference to the bin.
-- 
-- The [elementAdded]("GI.Gst.Objects.Bin#signal:elementAdded") signal is fired whenever a new element is added to
-- the bin. Likewise the [elementRemoved]("GI.Gst.Objects.Bin#signal:elementRemoved") signal is fired whenever an
-- element is removed from the bin.
-- 
-- == Notes
-- 
-- A t'GI.Gst.Objects.Bin.Bin' internally intercepts every t'GI.Gst.Structs.Message.Message' posted by its children and
-- implements the following default behaviour for each of them:
-- 
-- * GST_MESSAGE_EOS: This message is only posted by sinks in the PLAYING
-- state. If all sinks posted the EOS message, this bin will post and EOS
-- message upwards.
-- 
-- * GST_MESSAGE_SEGMENT_START: Just collected and never forwarded upwards.
-- The messages are used to decide when all elements have completed playback
-- of their segment.
-- 
-- * GST_MESSAGE_SEGMENT_DONE: Is posted by t'GI.Gst.Objects.Bin.Bin' when all elements that posted
-- a SEGMENT_START have posted a SEGMENT_DONE.
-- 
-- * GST_MESSAGE_DURATION_CHANGED: Is posted by an element that detected a change
-- in the stream duration. The default bin behaviour is to clear any
-- cached duration values so that the next duration query will perform
-- a full duration recalculation. The duration change is posted to the
-- application so that it can refetch the new duration with a duration
-- query. Note that these messages can be posted before the bin is
-- prerolled, in which case the duration query might fail.
-- 
-- * GST_MESSAGE_CLOCK_LOST: This message is posted by an element when it
-- can no longer provide a clock. The default bin behaviour is to
-- check if the lost clock was the one provided by the bin. If so and
-- the bin is currently in the PLAYING state, the message is forwarded to
-- the bin parent.
-- This message is also generated when a clock provider is removed from
-- the bin. If this message is received by the application, it should
-- PAUSE the pipeline and set it back to PLAYING to force a new clock
-- distribution.
-- 
-- * GST_MESSAGE_CLOCK_PROVIDE: This message is generated when an element
-- can provide a clock. This mostly happens when a new clock
-- provider is added to the bin. The default behaviour of the bin is to
-- mark the currently selected clock as dirty, which will perform a clock
-- recalculation the next time the bin is asked to provide a clock.
-- This message is never sent tot the application but is forwarded to
-- the parent of the bin.
-- 
-- * OTHERS: posted upwards.
-- 
-- A t'GI.Gst.Objects.Bin.Bin' implements the following default behaviour for answering to a
-- t'GI.Gst.Structs.Query.Query':
-- 
-- * GST_QUERY_DURATION:If the query has been asked before with the same format
-- and the bin is a toplevel bin (ie. has no parent),
-- use the cached previous value. If no previous value was cached, the
-- query is sent to all sink elements in the bin and the MAXIMUM of all
-- values is returned. If the bin is a toplevel bin the value is cached.
-- If no sinks are available in the bin, the query fails.
-- 
-- * GST_QUERY_POSITION:The query is sent to all sink elements in the bin and the
-- MAXIMUM of all values is returned. If no sinks are available in the bin,
-- the query fails.
-- 
-- * OTHERS:the query is forwarded to all sink elements, the result
-- of the first sink that answers the query successfully is returned. If no
-- sink is in the bin, the query fails.
-- 
-- A t'GI.Gst.Objects.Bin.Bin' will by default forward any event sent to it to all sink
-- (@/GST_EVENT_TYPE_DOWNSTREAM/@) or source (@/GST_EVENT_TYPE_UPSTREAM/@) elements
-- depending on the event type.
-- If all the elements return 'P.True', the bin will also return 'P.True', else 'P.False'
-- is returned. If no elements of the required type are in the bin, the event
-- handler will return 'P.True'.

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

module GI.Gst.Objects.Bin
    ( 

-- * Exported types
    Bin(..)                                 ,
    IsBin                                   ,
    toBin                                   ,
    noBin                                   ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveBinMethod                        ,
#endif


-- ** add #method:add#

#if defined(ENABLE_OVERLOADING)
    BinAddMethodInfo                        ,
#endif
    binAdd                                  ,


-- ** findUnlinkedPad #method:findUnlinkedPad#

#if defined(ENABLE_OVERLOADING)
    BinFindUnlinkedPadMethodInfo            ,
#endif
    binFindUnlinkedPad                      ,


-- ** getByInterface #method:getByInterface#

#if defined(ENABLE_OVERLOADING)
    BinGetByInterfaceMethodInfo             ,
#endif
    binGetByInterface                       ,


-- ** getByName #method:getByName#

#if defined(ENABLE_OVERLOADING)
    BinGetByNameMethodInfo                  ,
#endif
    binGetByName                            ,


-- ** getByNameRecurseUp #method:getByNameRecurseUp#

#if defined(ENABLE_OVERLOADING)
    BinGetByNameRecurseUpMethodInfo         ,
#endif
    binGetByNameRecurseUp                   ,


-- ** getSuppressedFlags #method:getSuppressedFlags#

#if defined(ENABLE_OVERLOADING)
    BinGetSuppressedFlagsMethodInfo         ,
#endif
    binGetSuppressedFlags                   ,


-- ** iterateAllByInterface #method:iterateAllByInterface#

#if defined(ENABLE_OVERLOADING)
    BinIterateAllByInterfaceMethodInfo      ,
#endif
    binIterateAllByInterface                ,


-- ** iterateElements #method:iterateElements#

#if defined(ENABLE_OVERLOADING)
    BinIterateElementsMethodInfo            ,
#endif
    binIterateElements                      ,


-- ** iterateRecurse #method:iterateRecurse#

#if defined(ENABLE_OVERLOADING)
    BinIterateRecurseMethodInfo             ,
#endif
    binIterateRecurse                       ,


-- ** iterateSinks #method:iterateSinks#

#if defined(ENABLE_OVERLOADING)
    BinIterateSinksMethodInfo               ,
#endif
    binIterateSinks                         ,


-- ** iterateSorted #method:iterateSorted#

#if defined(ENABLE_OVERLOADING)
    BinIterateSortedMethodInfo              ,
#endif
    binIterateSorted                        ,


-- ** iterateSources #method:iterateSources#

#if defined(ENABLE_OVERLOADING)
    BinIterateSourcesMethodInfo             ,
#endif
    binIterateSources                       ,


-- ** new #method:new#

    binNew                                  ,


-- ** recalculateLatency #method:recalculateLatency#

#if defined(ENABLE_OVERLOADING)
    BinRecalculateLatencyMethodInfo         ,
#endif
    binRecalculateLatency                   ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    BinRemoveMethodInfo                     ,
#endif
    binRemove                               ,


-- ** setSuppressedFlags #method:setSuppressedFlags#

#if defined(ENABLE_OVERLOADING)
    BinSetSuppressedFlagsMethodInfo         ,
#endif
    binSetSuppressedFlags                   ,


-- ** syncChildrenStates #method:syncChildrenStates#

#if defined(ENABLE_OVERLOADING)
    BinSyncChildrenStatesMethodInfo         ,
#endif
    binSyncChildrenStates                   ,




 -- * Properties
-- ** asyncHandling #attr:asyncHandling#
-- | If set to 'P.True', the bin will handle asynchronous state changes.
-- This should be used only if the bin subclass is modifying the state
-- of its children on its own.

#if defined(ENABLE_OVERLOADING)
    BinAsyncHandlingPropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    binAsyncHandling                        ,
#endif
    constructBinAsyncHandling               ,
    getBinAsyncHandling                     ,
    setBinAsyncHandling                     ,


-- ** messageForward #attr:messageForward#
-- | Forward all children messages, even those that would normally be filtered by
-- the bin. This can be interesting when one wants to be notified of the EOS
-- state of individual elements, for example.
-- 
-- The messages are converted to an ELEMENT message with the bin as the
-- source. The structure of the message is named \'GstBinForwarded\' and contains
-- a field named \'message\' of type GST_TYPE_MESSAGE that contains the original
-- forwarded message.

#if defined(ENABLE_OVERLOADING)
    BinMessageForwardPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    binMessageForward                       ,
#endif
    constructBinMessageForward              ,
    getBinMessageForward                    ,
    setBinMessageForward                    ,




 -- * Signals
-- ** deepElementAdded #signal:deepElementAdded#

    BinDeepElementAddedCallback             ,
#if defined(ENABLE_OVERLOADING)
    BinDeepElementAddedSignalInfo           ,
#endif
    C_BinDeepElementAddedCallback           ,
    afterBinDeepElementAdded                ,
    genClosure_BinDeepElementAdded          ,
    mk_BinDeepElementAddedCallback          ,
    noBinDeepElementAddedCallback           ,
    onBinDeepElementAdded                   ,
    wrap_BinDeepElementAddedCallback        ,


-- ** deepElementRemoved #signal:deepElementRemoved#

    BinDeepElementRemovedCallback           ,
#if defined(ENABLE_OVERLOADING)
    BinDeepElementRemovedSignalInfo         ,
#endif
    C_BinDeepElementRemovedCallback         ,
    afterBinDeepElementRemoved              ,
    genClosure_BinDeepElementRemoved        ,
    mk_BinDeepElementRemovedCallback        ,
    noBinDeepElementRemovedCallback         ,
    onBinDeepElementRemoved                 ,
    wrap_BinDeepElementRemovedCallback      ,


-- ** doLatency #signal:doLatency#

    BinDoLatencyCallback                    ,
#if defined(ENABLE_OVERLOADING)
    BinDoLatencySignalInfo                  ,
#endif
    C_BinDoLatencyCallback                  ,
    afterBinDoLatency                       ,
    genClosure_BinDoLatency                 ,
    mk_BinDoLatencyCallback                 ,
    noBinDoLatencyCallback                  ,
    onBinDoLatency                          ,
    wrap_BinDoLatencyCallback               ,


-- ** elementAdded #signal:elementAdded#

    BinElementAddedCallback                 ,
#if defined(ENABLE_OVERLOADING)
    BinElementAddedSignalInfo               ,
#endif
    C_BinElementAddedCallback               ,
    afterBinElementAdded                    ,
    genClosure_BinElementAdded              ,
    mk_BinElementAddedCallback              ,
    noBinElementAddedCallback               ,
    onBinElementAdded                       ,
    wrap_BinElementAddedCallback            ,


-- ** elementRemoved #signal:elementRemoved#

    BinElementRemovedCallback               ,
#if defined(ENABLE_OVERLOADING)
    BinElementRemovedSignalInfo             ,
#endif
    C_BinElementRemovedCallback             ,
    afterBinElementRemoved                  ,
    genClosure_BinElementRemoved            ,
    mk_BinElementRemovedCallback            ,
    noBinElementRemovedCallback             ,
    onBinElementRemoved                     ,
    wrap_BinElementRemovedCallback          ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums
import {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags
import {-# SOURCE #-} qualified GI.Gst.Interfaces.ChildProxy as Gst.ChildProxy
import {-# SOURCE #-} qualified GI.Gst.Objects.Element as Gst.Element
import {-# SOURCE #-} qualified GI.Gst.Objects.Object as Gst.Object
import {-# SOURCE #-} qualified GI.Gst.Objects.Pad as Gst.Pad
import {-# SOURCE #-} qualified GI.Gst.Structs.Iterator as Gst.Iterator

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

instance GObject Bin where
    gobjectType :: IO GType
gobjectType = IO GType
c_gst_bin_get_type
    

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

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

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `Bin`.
noBin :: Maybe Bin
noBin :: Maybe Bin
noBin = Maybe Bin
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveBinMethod (t :: Symbol) (o :: *) :: * where
    ResolveBinMethod "abortState" o = Gst.Element.ElementAbortStateMethodInfo
    ResolveBinMethod "add" o = BinAddMethodInfo
    ResolveBinMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveBinMethod "addPad" o = Gst.Element.ElementAddPadMethodInfo
    ResolveBinMethod "addPropertyDeepNotifyWatch" o = Gst.Element.ElementAddPropertyDeepNotifyWatchMethodInfo
    ResolveBinMethod "addPropertyNotifyWatch" o = Gst.Element.ElementAddPropertyNotifyWatchMethodInfo
    ResolveBinMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveBinMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveBinMethod "callAsync" o = Gst.Element.ElementCallAsyncMethodInfo
    ResolveBinMethod "changeState" o = Gst.Element.ElementChangeStateMethodInfo
    ResolveBinMethod "childAdded" o = Gst.ChildProxy.ChildProxyChildAddedMethodInfo
    ResolveBinMethod "childRemoved" o = Gst.ChildProxy.ChildProxyChildRemovedMethodInfo
    ResolveBinMethod "continueState" o = Gst.Element.ElementContinueStateMethodInfo
    ResolveBinMethod "createAllPads" o = Gst.Element.ElementCreateAllPadsMethodInfo
    ResolveBinMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveBinMethod "findUnlinkedPad" o = BinFindUnlinkedPadMethodInfo
    ResolveBinMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveBinMethod "foreachPad" o = Gst.Element.ElementForeachPadMethodInfo
    ResolveBinMethod "foreachSinkPad" o = Gst.Element.ElementForeachSinkPadMethodInfo
    ResolveBinMethod "foreachSrcPad" o = Gst.Element.ElementForeachSrcPadMethodInfo
    ResolveBinMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveBinMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveBinMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveBinMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveBinMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveBinMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveBinMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveBinMethod "isLockedState" o = Gst.Element.ElementIsLockedStateMethodInfo
    ResolveBinMethod "iterateAllByInterface" o = BinIterateAllByInterfaceMethodInfo
    ResolveBinMethod "iterateElements" o = BinIterateElementsMethodInfo
    ResolveBinMethod "iteratePads" o = Gst.Element.ElementIteratePadsMethodInfo
    ResolveBinMethod "iterateRecurse" o = BinIterateRecurseMethodInfo
    ResolveBinMethod "iterateSinkPads" o = Gst.Element.ElementIterateSinkPadsMethodInfo
    ResolveBinMethod "iterateSinks" o = BinIterateSinksMethodInfo
    ResolveBinMethod "iterateSorted" o = BinIterateSortedMethodInfo
    ResolveBinMethod "iterateSources" o = BinIterateSourcesMethodInfo
    ResolveBinMethod "iterateSrcPads" o = Gst.Element.ElementIterateSrcPadsMethodInfo
    ResolveBinMethod "link" o = Gst.Element.ElementLinkMethodInfo
    ResolveBinMethod "linkFiltered" o = Gst.Element.ElementLinkFilteredMethodInfo
    ResolveBinMethod "linkPads" o = Gst.Element.ElementLinkPadsMethodInfo
    ResolveBinMethod "linkPadsFiltered" o = Gst.Element.ElementLinkPadsFilteredMethodInfo
    ResolveBinMethod "linkPadsFull" o = Gst.Element.ElementLinkPadsFullMethodInfo
    ResolveBinMethod "lookup" o = Gst.ChildProxy.ChildProxyLookupMethodInfo
    ResolveBinMethod "lostState" o = Gst.Element.ElementLostStateMethodInfo
    ResolveBinMethod "messageFull" o = Gst.Element.ElementMessageFullMethodInfo
    ResolveBinMethod "messageFullWithDetails" o = Gst.Element.ElementMessageFullWithDetailsMethodInfo
    ResolveBinMethod "noMorePads" o = Gst.Element.ElementNoMorePadsMethodInfo
    ResolveBinMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveBinMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveBinMethod "postMessage" o = Gst.Element.ElementPostMessageMethodInfo
    ResolveBinMethod "provideClock" o = Gst.Element.ElementProvideClockMethodInfo
    ResolveBinMethod "query" o = Gst.Element.ElementQueryMethodInfo
    ResolveBinMethod "queryConvert" o = Gst.Element.ElementQueryConvertMethodInfo
    ResolveBinMethod "queryDuration" o = Gst.Element.ElementQueryDurationMethodInfo
    ResolveBinMethod "queryPosition" o = Gst.Element.ElementQueryPositionMethodInfo
    ResolveBinMethod "recalculateLatency" o = BinRecalculateLatencyMethodInfo
    ResolveBinMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveBinMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveBinMethod "releaseRequestPad" o = Gst.Element.ElementReleaseRequestPadMethodInfo
    ResolveBinMethod "remove" o = BinRemoveMethodInfo
    ResolveBinMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveBinMethod "removePad" o = Gst.Element.ElementRemovePadMethodInfo
    ResolveBinMethod "removePropertyNotifyWatch" o = Gst.Element.ElementRemovePropertyNotifyWatchMethodInfo
    ResolveBinMethod "requestPad" o = Gst.Element.ElementRequestPadMethodInfo
    ResolveBinMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveBinMethod "seek" o = Gst.Element.ElementSeekMethodInfo
    ResolveBinMethod "seekSimple" o = Gst.Element.ElementSeekSimpleMethodInfo
    ResolveBinMethod "sendEvent" o = Gst.Element.ElementSendEventMethodInfo
    ResolveBinMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveBinMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveBinMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveBinMethod "syncChildrenStates" o = BinSyncChildrenStatesMethodInfo
    ResolveBinMethod "syncStateWithParent" o = Gst.Element.ElementSyncStateWithParentMethodInfo
    ResolveBinMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveBinMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveBinMethod "unlink" o = Gst.Element.ElementUnlinkMethodInfo
    ResolveBinMethod "unlinkPads" o = Gst.Element.ElementUnlinkPadsMethodInfo
    ResolveBinMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveBinMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveBinMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveBinMethod "getBaseTime" o = Gst.Element.ElementGetBaseTimeMethodInfo
    ResolveBinMethod "getBus" o = Gst.Element.ElementGetBusMethodInfo
    ResolveBinMethod "getByInterface" o = BinGetByInterfaceMethodInfo
    ResolveBinMethod "getByName" o = BinGetByNameMethodInfo
    ResolveBinMethod "getByNameRecurseUp" o = BinGetByNameRecurseUpMethodInfo
    ResolveBinMethod "getChildByIndex" o = Gst.ChildProxy.ChildProxyGetChildByIndexMethodInfo
    ResolveBinMethod "getChildByName" o = Gst.ChildProxy.ChildProxyGetChildByNameMethodInfo
    ResolveBinMethod "getChildrenCount" o = Gst.ChildProxy.ChildProxyGetChildrenCountMethodInfo
    ResolveBinMethod "getClock" o = Gst.Element.ElementGetClockMethodInfo
    ResolveBinMethod "getCompatiblePad" o = Gst.Element.ElementGetCompatiblePadMethodInfo
    ResolveBinMethod "getCompatiblePadTemplate" o = Gst.Element.ElementGetCompatiblePadTemplateMethodInfo
    ResolveBinMethod "getContext" o = Gst.Element.ElementGetContextMethodInfo
    ResolveBinMethod "getContextUnlocked" o = Gst.Element.ElementGetContextUnlockedMethodInfo
    ResolveBinMethod "getContexts" o = Gst.Element.ElementGetContextsMethodInfo
    ResolveBinMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveBinMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveBinMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveBinMethod "getFactory" o = Gst.Element.ElementGetFactoryMethodInfo
    ResolveBinMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveBinMethod "getMetadata" o = Gst.Element.ElementGetMetadataMethodInfo
    ResolveBinMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveBinMethod "getPadTemplate" o = Gst.Element.ElementGetPadTemplateMethodInfo
    ResolveBinMethod "getPadTemplateList" o = Gst.Element.ElementGetPadTemplateListMethodInfo
    ResolveBinMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveBinMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveBinMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveBinMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveBinMethod "getRequestPad" o = Gst.Element.ElementGetRequestPadMethodInfo
    ResolveBinMethod "getStartTime" o = Gst.Element.ElementGetStartTimeMethodInfo
    ResolveBinMethod "getState" o = Gst.Element.ElementGetStateMethodInfo
    ResolveBinMethod "getStaticPad" o = Gst.Element.ElementGetStaticPadMethodInfo
    ResolveBinMethod "getSuppressedFlags" o = BinGetSuppressedFlagsMethodInfo
    ResolveBinMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveBinMethod "setBaseTime" o = Gst.Element.ElementSetBaseTimeMethodInfo
    ResolveBinMethod "setBus" o = Gst.Element.ElementSetBusMethodInfo
    ResolveBinMethod "setClock" o = Gst.Element.ElementSetClockMethodInfo
    ResolveBinMethod "setContext" o = Gst.Element.ElementSetContextMethodInfo
    ResolveBinMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveBinMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveBinMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveBinMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveBinMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveBinMethod "setLockedState" o = Gst.Element.ElementSetLockedStateMethodInfo
    ResolveBinMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveBinMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveBinMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveBinMethod "setStartTime" o = Gst.Element.ElementSetStartTimeMethodInfo
    ResolveBinMethod "setState" o = Gst.Element.ElementSetStateMethodInfo
    ResolveBinMethod "setSuppressedFlags" o = BinSetSuppressedFlagsMethodInfo
    ResolveBinMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal Bin::deep-element-added
-- | Will be emitted after the element was added to sub_bin.
-- 
-- /Since: 1.10/
type BinDeepElementAddedCallback =
    Bin
    -- ^ /@subBin@/: the t'GI.Gst.Objects.Bin.Bin' the element was added to
    -> Gst.Element.Element
    -- ^ /@element@/: the t'GI.Gst.Objects.Element.Element' that was added to /@subBin@/
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `BinDeepElementAddedCallback`@.
noBinDeepElementAddedCallback :: Maybe BinDeepElementAddedCallback
noBinDeepElementAddedCallback :: Maybe BinDeepElementAddedCallback
noBinDeepElementAddedCallback = Maybe BinDeepElementAddedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_BinDeepElementAddedCallback =
    Ptr () ->                               -- object
    Ptr Bin ->
    Ptr Gst.Element.Element ->
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_BinDeepElementAdded :: MonadIO m => BinDeepElementAddedCallback -> m (GClosure C_BinDeepElementAddedCallback)
genClosure_BinDeepElementAdded :: BinDeepElementAddedCallback
-> m (GClosure C_BinDeepElementAddedCallback)
genClosure_BinDeepElementAdded cb :: BinDeepElementAddedCallback
cb = IO (GClosure C_BinDeepElementAddedCallback)
-> m (GClosure C_BinDeepElementAddedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_BinDeepElementAddedCallback)
 -> m (GClosure C_BinDeepElementAddedCallback))
-> IO (GClosure C_BinDeepElementAddedCallback)
-> m (GClosure C_BinDeepElementAddedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BinDeepElementAddedCallback
cb' = BinDeepElementAddedCallback -> C_BinDeepElementAddedCallback
wrap_BinDeepElementAddedCallback BinDeepElementAddedCallback
cb
    C_BinDeepElementAddedCallback
-> IO (FunPtr C_BinDeepElementAddedCallback)
mk_BinDeepElementAddedCallback C_BinDeepElementAddedCallback
cb' IO (FunPtr C_BinDeepElementAddedCallback)
-> (FunPtr C_BinDeepElementAddedCallback
    -> IO (GClosure C_BinDeepElementAddedCallback))
-> IO (GClosure C_BinDeepElementAddedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_BinDeepElementAddedCallback
-> IO (GClosure C_BinDeepElementAddedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `BinDeepElementAddedCallback` into a `C_BinDeepElementAddedCallback`.
wrap_BinDeepElementAddedCallback ::
    BinDeepElementAddedCallback ->
    C_BinDeepElementAddedCallback
wrap_BinDeepElementAddedCallback :: BinDeepElementAddedCallback -> C_BinDeepElementAddedCallback
wrap_BinDeepElementAddedCallback _cb :: BinDeepElementAddedCallback
_cb _ subBin :: Ptr Bin
subBin element :: Ptr Element
element _ = do
    Bin
subBin' <- ((ManagedPtr Bin -> Bin) -> Ptr Bin -> IO Bin
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Bin -> Bin
Bin) Ptr Bin
subBin
    Element
element' <- ((ManagedPtr Element -> Element) -> Ptr Element -> IO Element
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Element -> Element
Gst.Element.Element) Ptr Element
element
    BinDeepElementAddedCallback
_cb  Bin
subBin' Element
element'


-- | Connect a signal handler for the [deepElementAdded](#signal:deepElementAdded) 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' bin #deepElementAdded callback
-- @
-- 
-- 
onBinDeepElementAdded :: (IsBin a, MonadIO m) => a -> BinDeepElementAddedCallback -> m SignalHandlerId
onBinDeepElementAdded :: a -> BinDeepElementAddedCallback -> m SignalHandlerId
onBinDeepElementAdded obj :: a
obj cb :: BinDeepElementAddedCallback
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 cb' :: C_BinDeepElementAddedCallback
cb' = BinDeepElementAddedCallback -> C_BinDeepElementAddedCallback
wrap_BinDeepElementAddedCallback BinDeepElementAddedCallback
cb
    FunPtr C_BinDeepElementAddedCallback
cb'' <- C_BinDeepElementAddedCallback
-> IO (FunPtr C_BinDeepElementAddedCallback)
mk_BinDeepElementAddedCallback C_BinDeepElementAddedCallback
cb'
    a
-> Text
-> FunPtr C_BinDeepElementAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "deep-element-added" FunPtr C_BinDeepElementAddedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [deepElementAdded](#signal:deepElementAdded) 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' bin #deepElementAdded callback
-- @
-- 
-- 
afterBinDeepElementAdded :: (IsBin a, MonadIO m) => a -> BinDeepElementAddedCallback -> m SignalHandlerId
afterBinDeepElementAdded :: a -> BinDeepElementAddedCallback -> m SignalHandlerId
afterBinDeepElementAdded obj :: a
obj cb :: BinDeepElementAddedCallback
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 cb' :: C_BinDeepElementAddedCallback
cb' = BinDeepElementAddedCallback -> C_BinDeepElementAddedCallback
wrap_BinDeepElementAddedCallback BinDeepElementAddedCallback
cb
    FunPtr C_BinDeepElementAddedCallback
cb'' <- C_BinDeepElementAddedCallback
-> IO (FunPtr C_BinDeepElementAddedCallback)
mk_BinDeepElementAddedCallback C_BinDeepElementAddedCallback
cb'
    a
-> Text
-> FunPtr C_BinDeepElementAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "deep-element-added" FunPtr C_BinDeepElementAddedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data BinDeepElementAddedSignalInfo
instance SignalInfo BinDeepElementAddedSignalInfo where
    type HaskellCallbackType BinDeepElementAddedSignalInfo = BinDeepElementAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_BinDeepElementAddedCallback cb
        cb'' <- mk_BinDeepElementAddedCallback cb'
        connectSignalFunPtr obj "deep-element-added" cb'' connectMode detail

#endif

-- signal Bin::deep-element-removed
-- | Will be emitted after the element was removed from sub_bin.
-- 
-- /Since: 1.10/
type BinDeepElementRemovedCallback =
    Bin
    -- ^ /@subBin@/: the t'GI.Gst.Objects.Bin.Bin' the element was removed from
    -> Gst.Element.Element
    -- ^ /@element@/: the t'GI.Gst.Objects.Element.Element' that was removed from /@subBin@/
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `BinDeepElementRemovedCallback`@.
noBinDeepElementRemovedCallback :: Maybe BinDeepElementRemovedCallback
noBinDeepElementRemovedCallback :: Maybe BinDeepElementAddedCallback
noBinDeepElementRemovedCallback = Maybe BinDeepElementAddedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_BinDeepElementRemovedCallback =
    Ptr () ->                               -- object
    Ptr Bin ->
    Ptr Gst.Element.Element ->
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_BinDeepElementRemoved :: MonadIO m => BinDeepElementRemovedCallback -> m (GClosure C_BinDeepElementRemovedCallback)
genClosure_BinDeepElementRemoved :: BinDeepElementAddedCallback
-> m (GClosure C_BinDeepElementAddedCallback)
genClosure_BinDeepElementRemoved cb :: BinDeepElementAddedCallback
cb = IO (GClosure C_BinDeepElementAddedCallback)
-> m (GClosure C_BinDeepElementAddedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_BinDeepElementAddedCallback)
 -> m (GClosure C_BinDeepElementAddedCallback))
-> IO (GClosure C_BinDeepElementAddedCallback)
-> m (GClosure C_BinDeepElementAddedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BinDeepElementAddedCallback
cb' = BinDeepElementAddedCallback -> C_BinDeepElementAddedCallback
wrap_BinDeepElementRemovedCallback BinDeepElementAddedCallback
cb
    C_BinDeepElementAddedCallback
-> IO (FunPtr C_BinDeepElementAddedCallback)
mk_BinDeepElementRemovedCallback C_BinDeepElementAddedCallback
cb' IO (FunPtr C_BinDeepElementAddedCallback)
-> (FunPtr C_BinDeepElementAddedCallback
    -> IO (GClosure C_BinDeepElementAddedCallback))
-> IO (GClosure C_BinDeepElementAddedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_BinDeepElementAddedCallback
-> IO (GClosure C_BinDeepElementAddedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `BinDeepElementRemovedCallback` into a `C_BinDeepElementRemovedCallback`.
wrap_BinDeepElementRemovedCallback ::
    BinDeepElementRemovedCallback ->
    C_BinDeepElementRemovedCallback
wrap_BinDeepElementRemovedCallback :: BinDeepElementAddedCallback -> C_BinDeepElementAddedCallback
wrap_BinDeepElementRemovedCallback _cb :: BinDeepElementAddedCallback
_cb _ subBin :: Ptr Bin
subBin element :: Ptr Element
element _ = do
    Bin
subBin' <- ((ManagedPtr Bin -> Bin) -> Ptr Bin -> IO Bin
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Bin -> Bin
Bin) Ptr Bin
subBin
    Element
element' <- ((ManagedPtr Element -> Element) -> Ptr Element -> IO Element
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Element -> Element
Gst.Element.Element) Ptr Element
element
    BinDeepElementAddedCallback
_cb  Bin
subBin' Element
element'


-- | Connect a signal handler for the [deepElementRemoved](#signal:deepElementRemoved) 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' bin #deepElementRemoved callback
-- @
-- 
-- 
onBinDeepElementRemoved :: (IsBin a, MonadIO m) => a -> BinDeepElementRemovedCallback -> m SignalHandlerId
onBinDeepElementRemoved :: a -> BinDeepElementAddedCallback -> m SignalHandlerId
onBinDeepElementRemoved obj :: a
obj cb :: BinDeepElementAddedCallback
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 cb' :: C_BinDeepElementAddedCallback
cb' = BinDeepElementAddedCallback -> C_BinDeepElementAddedCallback
wrap_BinDeepElementRemovedCallback BinDeepElementAddedCallback
cb
    FunPtr C_BinDeepElementAddedCallback
cb'' <- C_BinDeepElementAddedCallback
-> IO (FunPtr C_BinDeepElementAddedCallback)
mk_BinDeepElementRemovedCallback C_BinDeepElementAddedCallback
cb'
    a
-> Text
-> FunPtr C_BinDeepElementAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "deep-element-removed" FunPtr C_BinDeepElementAddedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [deepElementRemoved](#signal:deepElementRemoved) 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' bin #deepElementRemoved callback
-- @
-- 
-- 
afterBinDeepElementRemoved :: (IsBin a, MonadIO m) => a -> BinDeepElementRemovedCallback -> m SignalHandlerId
afterBinDeepElementRemoved :: a -> BinDeepElementAddedCallback -> m SignalHandlerId
afterBinDeepElementRemoved obj :: a
obj cb :: BinDeepElementAddedCallback
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 cb' :: C_BinDeepElementAddedCallback
cb' = BinDeepElementAddedCallback -> C_BinDeepElementAddedCallback
wrap_BinDeepElementRemovedCallback BinDeepElementAddedCallback
cb
    FunPtr C_BinDeepElementAddedCallback
cb'' <- C_BinDeepElementAddedCallback
-> IO (FunPtr C_BinDeepElementAddedCallback)
mk_BinDeepElementRemovedCallback C_BinDeepElementAddedCallback
cb'
    a
-> Text
-> FunPtr C_BinDeepElementAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "deep-element-removed" FunPtr C_BinDeepElementAddedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data BinDeepElementRemovedSignalInfo
instance SignalInfo BinDeepElementRemovedSignalInfo where
    type HaskellCallbackType BinDeepElementRemovedSignalInfo = BinDeepElementRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_BinDeepElementRemovedCallback cb
        cb'' <- mk_BinDeepElementRemovedCallback cb'
        connectSignalFunPtr obj "deep-element-removed" cb'' connectMode detail

#endif

-- signal Bin::do-latency
-- | Will be emitted when the bin needs to perform latency calculations. This
-- signal is only emitted for toplevel bins or when async-handling is
-- enabled.
-- 
-- Only one signal handler is invoked. If no signals are connected, the
-- default handler is invoked, which will query and distribute the lowest
-- possible latency to all sinks.
-- 
-- Connect to this signal if the default latency calculations are not
-- sufficient, like when you need different latencies for different sinks in
-- the same pipeline.
type BinDoLatencyCallback =
    IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `BinDoLatencyCallback`@.
noBinDoLatencyCallback :: Maybe BinDoLatencyCallback
noBinDoLatencyCallback :: Maybe BinDoLatencyCallback
noBinDoLatencyCallback = Maybe BinDoLatencyCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_BinDoLatencyCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO CInt

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

-- | Wrap the callback into a `GClosure`.
genClosure_BinDoLatency :: MonadIO m => BinDoLatencyCallback -> m (GClosure C_BinDoLatencyCallback)
genClosure_BinDoLatency :: BinDoLatencyCallback -> m (GClosure C_BinDoLatencyCallback)
genClosure_BinDoLatency cb :: BinDoLatencyCallback
cb = IO (GClosure C_BinDoLatencyCallback)
-> m (GClosure C_BinDoLatencyCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_BinDoLatencyCallback)
 -> m (GClosure C_BinDoLatencyCallback))
-> IO (GClosure C_BinDoLatencyCallback)
-> m (GClosure C_BinDoLatencyCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BinDoLatencyCallback
cb' = BinDoLatencyCallback -> C_BinDoLatencyCallback
wrap_BinDoLatencyCallback BinDoLatencyCallback
cb
    C_BinDoLatencyCallback -> IO (FunPtr C_BinDoLatencyCallback)
mk_BinDoLatencyCallback C_BinDoLatencyCallback
cb' IO (FunPtr C_BinDoLatencyCallback)
-> (FunPtr C_BinDoLatencyCallback
    -> IO (GClosure C_BinDoLatencyCallback))
-> IO (GClosure C_BinDoLatencyCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_BinDoLatencyCallback
-> IO (GClosure C_BinDoLatencyCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `BinDoLatencyCallback` into a `C_BinDoLatencyCallback`.
wrap_BinDoLatencyCallback ::
    BinDoLatencyCallback ->
    C_BinDoLatencyCallback
wrap_BinDoLatencyCallback :: BinDoLatencyCallback -> C_BinDoLatencyCallback
wrap_BinDoLatencyCallback _cb :: BinDoLatencyCallback
_cb _ _ = do
    Bool
result <- BinDoLatencyCallback
_cb 
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [doLatency](#signal:doLatency) 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' bin #doLatency callback
-- @
-- 
-- 
onBinDoLatency :: (IsBin a, MonadIO m) => a -> BinDoLatencyCallback -> m SignalHandlerId
onBinDoLatency :: a -> BinDoLatencyCallback -> m SignalHandlerId
onBinDoLatency obj :: a
obj cb :: BinDoLatencyCallback
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 cb' :: C_BinDoLatencyCallback
cb' = BinDoLatencyCallback -> C_BinDoLatencyCallback
wrap_BinDoLatencyCallback BinDoLatencyCallback
cb
    FunPtr C_BinDoLatencyCallback
cb'' <- C_BinDoLatencyCallback -> IO (FunPtr C_BinDoLatencyCallback)
mk_BinDoLatencyCallback C_BinDoLatencyCallback
cb'
    a
-> Text
-> FunPtr C_BinDoLatencyCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "do-latency" FunPtr C_BinDoLatencyCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [doLatency](#signal:doLatency) 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' bin #doLatency callback
-- @
-- 
-- 
afterBinDoLatency :: (IsBin a, MonadIO m) => a -> BinDoLatencyCallback -> m SignalHandlerId
afterBinDoLatency :: a -> BinDoLatencyCallback -> m SignalHandlerId
afterBinDoLatency obj :: a
obj cb :: BinDoLatencyCallback
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 cb' :: C_BinDoLatencyCallback
cb' = BinDoLatencyCallback -> C_BinDoLatencyCallback
wrap_BinDoLatencyCallback BinDoLatencyCallback
cb
    FunPtr C_BinDoLatencyCallback
cb'' <- C_BinDoLatencyCallback -> IO (FunPtr C_BinDoLatencyCallback)
mk_BinDoLatencyCallback C_BinDoLatencyCallback
cb'
    a
-> Text
-> FunPtr C_BinDoLatencyCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "do-latency" FunPtr C_BinDoLatencyCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data BinDoLatencySignalInfo
instance SignalInfo BinDoLatencySignalInfo where
    type HaskellCallbackType BinDoLatencySignalInfo = BinDoLatencyCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_BinDoLatencyCallback cb
        cb'' <- mk_BinDoLatencyCallback cb'
        connectSignalFunPtr obj "do-latency" cb'' connectMode detail

#endif

-- signal Bin::element-added
-- | Will be emitted after the element was added to the bin.
type BinElementAddedCallback =
    Gst.Element.Element
    -- ^ /@element@/: the t'GI.Gst.Objects.Element.Element' that was added to the bin
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `BinElementAddedCallback`@.
noBinElementAddedCallback :: Maybe BinElementAddedCallback
noBinElementAddedCallback :: Maybe BinElementAddedCallback
noBinElementAddedCallback = Maybe BinElementAddedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_BinElementAddedCallback =
    Ptr () ->                               -- object
    Ptr Gst.Element.Element ->
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_BinElementAdded :: MonadIO m => BinElementAddedCallback -> m (GClosure C_BinElementAddedCallback)
genClosure_BinElementAdded :: BinElementAddedCallback -> m (GClosure C_BinElementAddedCallback)
genClosure_BinElementAdded cb :: BinElementAddedCallback
cb = IO (GClosure C_BinElementAddedCallback)
-> m (GClosure C_BinElementAddedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_BinElementAddedCallback)
 -> m (GClosure C_BinElementAddedCallback))
-> IO (GClosure C_BinElementAddedCallback)
-> m (GClosure C_BinElementAddedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BinElementAddedCallback
cb' = BinElementAddedCallback -> C_BinElementAddedCallback
wrap_BinElementAddedCallback BinElementAddedCallback
cb
    C_BinElementAddedCallback -> IO (FunPtr C_BinElementAddedCallback)
mk_BinElementAddedCallback C_BinElementAddedCallback
cb' IO (FunPtr C_BinElementAddedCallback)
-> (FunPtr C_BinElementAddedCallback
    -> IO (GClosure C_BinElementAddedCallback))
-> IO (GClosure C_BinElementAddedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_BinElementAddedCallback
-> IO (GClosure C_BinElementAddedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `BinElementAddedCallback` into a `C_BinElementAddedCallback`.
wrap_BinElementAddedCallback ::
    BinElementAddedCallback ->
    C_BinElementAddedCallback
wrap_BinElementAddedCallback :: BinElementAddedCallback -> C_BinElementAddedCallback
wrap_BinElementAddedCallback _cb :: BinElementAddedCallback
_cb _ element :: Ptr Element
element _ = do
    Element
element' <- ((ManagedPtr Element -> Element) -> Ptr Element -> IO Element
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Element -> Element
Gst.Element.Element) Ptr Element
element
    BinElementAddedCallback
_cb  Element
element'


-- | Connect a signal handler for the [elementAdded](#signal:elementAdded) 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' bin #elementAdded callback
-- @
-- 
-- 
onBinElementAdded :: (IsBin a, MonadIO m) => a -> BinElementAddedCallback -> m SignalHandlerId
onBinElementAdded :: a -> BinElementAddedCallback -> m SignalHandlerId
onBinElementAdded obj :: a
obj cb :: BinElementAddedCallback
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 cb' :: C_BinElementAddedCallback
cb' = BinElementAddedCallback -> C_BinElementAddedCallback
wrap_BinElementAddedCallback BinElementAddedCallback
cb
    FunPtr C_BinElementAddedCallback
cb'' <- C_BinElementAddedCallback -> IO (FunPtr C_BinElementAddedCallback)
mk_BinElementAddedCallback C_BinElementAddedCallback
cb'
    a
-> Text
-> FunPtr C_BinElementAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "element-added" FunPtr C_BinElementAddedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [elementAdded](#signal:elementAdded) 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' bin #elementAdded callback
-- @
-- 
-- 
afterBinElementAdded :: (IsBin a, MonadIO m) => a -> BinElementAddedCallback -> m SignalHandlerId
afterBinElementAdded :: a -> BinElementAddedCallback -> m SignalHandlerId
afterBinElementAdded obj :: a
obj cb :: BinElementAddedCallback
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 cb' :: C_BinElementAddedCallback
cb' = BinElementAddedCallback -> C_BinElementAddedCallback
wrap_BinElementAddedCallback BinElementAddedCallback
cb
    FunPtr C_BinElementAddedCallback
cb'' <- C_BinElementAddedCallback -> IO (FunPtr C_BinElementAddedCallback)
mk_BinElementAddedCallback C_BinElementAddedCallback
cb'
    a
-> Text
-> FunPtr C_BinElementAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "element-added" FunPtr C_BinElementAddedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data BinElementAddedSignalInfo
instance SignalInfo BinElementAddedSignalInfo where
    type HaskellCallbackType BinElementAddedSignalInfo = BinElementAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_BinElementAddedCallback cb
        cb'' <- mk_BinElementAddedCallback cb'
        connectSignalFunPtr obj "element-added" cb'' connectMode detail

#endif

-- signal Bin::element-removed
-- | Will be emitted after the element was removed from the bin.
type BinElementRemovedCallback =
    Gst.Element.Element
    -- ^ /@element@/: the t'GI.Gst.Objects.Element.Element' that was removed from the bin
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `BinElementRemovedCallback`@.
noBinElementRemovedCallback :: Maybe BinElementRemovedCallback
noBinElementRemovedCallback :: Maybe BinElementAddedCallback
noBinElementRemovedCallback = Maybe BinElementAddedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_BinElementRemovedCallback =
    Ptr () ->                               -- object
    Ptr Gst.Element.Element ->
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_BinElementRemoved :: MonadIO m => BinElementRemovedCallback -> m (GClosure C_BinElementRemovedCallback)
genClosure_BinElementRemoved :: BinElementAddedCallback -> m (GClosure C_BinElementAddedCallback)
genClosure_BinElementRemoved cb :: BinElementAddedCallback
cb = IO (GClosure C_BinElementAddedCallback)
-> m (GClosure C_BinElementAddedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_BinElementAddedCallback)
 -> m (GClosure C_BinElementAddedCallback))
-> IO (GClosure C_BinElementAddedCallback)
-> m (GClosure C_BinElementAddedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BinElementAddedCallback
cb' = BinElementAddedCallback -> C_BinElementAddedCallback
wrap_BinElementRemovedCallback BinElementAddedCallback
cb
    C_BinElementAddedCallback -> IO (FunPtr C_BinElementAddedCallback)
mk_BinElementRemovedCallback C_BinElementAddedCallback
cb' IO (FunPtr C_BinElementAddedCallback)
-> (FunPtr C_BinElementAddedCallback
    -> IO (GClosure C_BinElementAddedCallback))
-> IO (GClosure C_BinElementAddedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_BinElementAddedCallback
-> IO (GClosure C_BinElementAddedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `BinElementRemovedCallback` into a `C_BinElementRemovedCallback`.
wrap_BinElementRemovedCallback ::
    BinElementRemovedCallback ->
    C_BinElementRemovedCallback
wrap_BinElementRemovedCallback :: BinElementAddedCallback -> C_BinElementAddedCallback
wrap_BinElementRemovedCallback _cb :: BinElementAddedCallback
_cb _ element :: Ptr Element
element _ = do
    Element
element' <- ((ManagedPtr Element -> Element) -> Ptr Element -> IO Element
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Element -> Element
Gst.Element.Element) Ptr Element
element
    BinElementAddedCallback
_cb  Element
element'


-- | Connect a signal handler for the [elementRemoved](#signal:elementRemoved) 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' bin #elementRemoved callback
-- @
-- 
-- 
onBinElementRemoved :: (IsBin a, MonadIO m) => a -> BinElementRemovedCallback -> m SignalHandlerId
onBinElementRemoved :: a -> BinElementAddedCallback -> m SignalHandlerId
onBinElementRemoved obj :: a
obj cb :: BinElementAddedCallback
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 cb' :: C_BinElementAddedCallback
cb' = BinElementAddedCallback -> C_BinElementAddedCallback
wrap_BinElementRemovedCallback BinElementAddedCallback
cb
    FunPtr C_BinElementAddedCallback
cb'' <- C_BinElementAddedCallback -> IO (FunPtr C_BinElementAddedCallback)
mk_BinElementRemovedCallback C_BinElementAddedCallback
cb'
    a
-> Text
-> FunPtr C_BinElementAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "element-removed" FunPtr C_BinElementAddedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [elementRemoved](#signal:elementRemoved) 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' bin #elementRemoved callback
-- @
-- 
-- 
afterBinElementRemoved :: (IsBin a, MonadIO m) => a -> BinElementRemovedCallback -> m SignalHandlerId
afterBinElementRemoved :: a -> BinElementAddedCallback -> m SignalHandlerId
afterBinElementRemoved obj :: a
obj cb :: BinElementAddedCallback
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 cb' :: C_BinElementAddedCallback
cb' = BinElementAddedCallback -> C_BinElementAddedCallback
wrap_BinElementRemovedCallback BinElementAddedCallback
cb
    FunPtr C_BinElementAddedCallback
cb'' <- C_BinElementAddedCallback -> IO (FunPtr C_BinElementAddedCallback)
mk_BinElementRemovedCallback C_BinElementAddedCallback
cb'
    a
-> Text
-> FunPtr C_BinElementAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "element-removed" FunPtr C_BinElementAddedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data BinElementRemovedSignalInfo
instance SignalInfo BinElementRemovedSignalInfo where
    type HaskellCallbackType BinElementRemovedSignalInfo = BinElementRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_BinElementRemovedCallback cb
        cb'' <- mk_BinElementRemovedCallback cb'
        connectSignalFunPtr obj "element-removed" cb'' connectMode detail

#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data BinAsyncHandlingPropertyInfo
instance AttrInfo BinAsyncHandlingPropertyInfo where
    type AttrAllowedOps BinAsyncHandlingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BinAsyncHandlingPropertyInfo = IsBin
    type AttrSetTypeConstraint BinAsyncHandlingPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint BinAsyncHandlingPropertyInfo = (~) Bool
    type AttrTransferType BinAsyncHandlingPropertyInfo = Bool
    type AttrGetType BinAsyncHandlingPropertyInfo = Bool
    type AttrLabel BinAsyncHandlingPropertyInfo = "async-handling"
    type AttrOrigin BinAsyncHandlingPropertyInfo = Bin
    attrGet = getBinAsyncHandling
    attrSet = setBinAsyncHandling
    attrTransfer _ v = do
        return v
    attrConstruct = constructBinAsyncHandling
    attrClear = undefined
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data BinMessageForwardPropertyInfo
instance AttrInfo BinMessageForwardPropertyInfo where
    type AttrAllowedOps BinMessageForwardPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BinMessageForwardPropertyInfo = IsBin
    type AttrSetTypeConstraint BinMessageForwardPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint BinMessageForwardPropertyInfo = (~) Bool
    type AttrTransferType BinMessageForwardPropertyInfo = Bool
    type AttrGetType BinMessageForwardPropertyInfo = Bool
    type AttrLabel BinMessageForwardPropertyInfo = "message-forward"
    type AttrOrigin BinMessageForwardPropertyInfo = Bin
    attrGet = getBinMessageForward
    attrSet = setBinMessageForward
    attrTransfer _ v = do
        return v
    attrConstruct = constructBinMessageForward
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Bin
type instance O.AttributeList Bin = BinAttributeList
type BinAttributeList = ('[ '("asyncHandling", BinAsyncHandlingPropertyInfo), '("messageForward", BinMessageForwardPropertyInfo), '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
binAsyncHandling :: AttrLabelProxy "asyncHandling"
binAsyncHandling = AttrLabelProxy

binMessageForward :: AttrLabelProxy "messageForward"
binMessageForward = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Bin = BinSignalList
type BinSignalList = ('[ '("childAdded", Gst.ChildProxy.ChildProxyChildAddedSignalInfo), '("childRemoved", Gst.ChildProxy.ChildProxyChildRemovedSignalInfo), '("deepElementAdded", BinDeepElementAddedSignalInfo), '("deepElementRemoved", BinDeepElementRemovedSignalInfo), '("deepNotify", Gst.Object.ObjectDeepNotifySignalInfo), '("doLatency", BinDoLatencySignalInfo), '("elementAdded", BinElementAddedSignalInfo), '("elementRemoved", BinElementRemovedSignalInfo), '("noMorePads", Gst.Element.ElementNoMorePadsSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("padAdded", Gst.Element.ElementPadAddedSignalInfo), '("padRemoved", Gst.Element.ElementPadRemovedSignalInfo)] :: [(Symbol, *)])

#endif

-- method Bin::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the new bin"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Bin" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_bin_new" gst_bin_new :: 
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Bin)

-- | Creates a new bin with the given name.
binNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@name@/: the name of the new bin
    -> m Bin
    -- ^ __Returns:__ a new t'GI.Gst.Objects.Bin.Bin'
binNew :: Maybe Text -> m Bin
binNew name :: Maybe Text
name = IO Bin -> m Bin
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bin -> m Bin) -> IO Bin -> m Bin
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeName <- case Maybe Text
name of
        Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just jName :: Text
jName -> do
            Ptr CChar
jName' <- Text -> IO (Ptr CChar)
textToCString Text
jName
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jName'
    Ptr Bin
result <- Ptr CChar -> IO (Ptr Bin)
gst_bin_new Ptr CChar
maybeName
    Text -> Ptr Bin -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "binNew" Ptr Bin
result
    Bin
result' <- ((ManagedPtr Bin -> Bin) -> Ptr Bin -> IO Bin
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Bin -> Bin
Bin) Ptr Bin
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeName
    Bin -> IO Bin
forall (m :: * -> *) a. Monad m => a -> m a
return Bin
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Bin::add
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Bin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBin" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstElement to add"
--                 , 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_bin_add" gst_bin_add :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    Ptr Gst.Element.Element ->              -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO CInt

-- | Adds the given element to the bin.  Sets the element\'s parent, and thus
-- takes ownership of the element. An element can only be added to one bin.
-- 
-- If the element\'s pads are linked to other pads, the pads will be unlinked
-- before the element is added to the bin.
-- 
-- > When you add an element to an already-running pipeline, you will have to
-- > take care to set the state of the newly-added element to the desired
-- > state (usually PLAYING or PAUSED, same you set the pipeline to originally)
-- > with 'GI.Gst.Objects.Element.elementSetState', or use 'GI.Gst.Objects.Element.elementSyncStateWithParent'.
-- > The bin or pipeline will not take care of this for you.
-- 
-- MT safe.
binAdd ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a, Gst.Element.IsElement b) =>
    a
    -- ^ /@bin@/: a t'GI.Gst.Objects.Bin.Bin'
    -> b
    -- ^ /@element@/: the t'GI.Gst.Objects.Element.Element' to add
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the element could be added, 'P.False' if
    -- the bin does not want to accept the element.
binAdd :: a -> b -> m Bool
binAdd bin :: a
bin element :: b
element = BinDoLatencyCallback -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (BinDoLatencyCallback -> m Bool) -> BinDoLatencyCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    Ptr Element
element' <- b -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
element
    CInt
result <- Ptr Bin -> Ptr Element -> IO CInt
gst_bin_add Ptr Bin
bin' Ptr Element
element'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
element
    Bool -> BinDoLatencyCallback
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BinAddMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsBin a, Gst.Element.IsElement b) => O.MethodInfo BinAddMethodInfo a signature where
    overloadedMethod = binAdd

#endif

-- method Bin::find_unlinked_pad
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Bin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "bin in which to look for elements with unlinked pads"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "direction"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadDirection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether to look for an unlinked source or sink pad"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Pad" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_bin_find_unlinked_pad" gst_bin_find_unlinked_pad :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    CUInt ->                                -- direction : TInterface (Name {namespace = "Gst", name = "PadDirection"})
    IO (Ptr Gst.Pad.Pad)

-- | Recursively looks for elements with an unlinked pad of the given
-- direction within the specified bin and returns an unlinked pad
-- if one is found, or 'P.Nothing' otherwise. If a pad is found, the caller
-- owns a reference to it and should use 'GI.Gst.Objects.Object.objectUnref' on the
-- pad when it is not needed any longer.
binFindUnlinkedPad ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a) =>
    a
    -- ^ /@bin@/: bin in which to look for elements with unlinked pads
    -> Gst.Enums.PadDirection
    -- ^ /@direction@/: whether to look for an unlinked source or sink pad
    -> m (Maybe Gst.Pad.Pad)
    -- ^ __Returns:__ unlinked pad of the given
    -- direction, 'P.Nothing'.
binFindUnlinkedPad :: a -> PadDirection -> m (Maybe Pad)
binFindUnlinkedPad bin :: a
bin direction :: PadDirection
direction = IO (Maybe Pad) -> m (Maybe Pad)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pad) -> m (Maybe Pad))
-> IO (Maybe Pad) -> m (Maybe Pad)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    let direction' :: CUInt
direction' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PadDirection -> Int) -> PadDirection -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PadDirection -> Int
forall a. Enum a => a -> Int
fromEnum) PadDirection
direction
    Ptr Pad
result <- Ptr Bin -> CUInt -> IO (Ptr Pad)
gst_bin_find_unlinked_pad Ptr Bin
bin' CUInt
direction'
    Maybe Pad
maybeResult <- Ptr Pad -> (Ptr Pad -> IO Pad) -> IO (Maybe Pad)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Pad
result ((Ptr Pad -> IO Pad) -> IO (Maybe Pad))
-> (Ptr Pad -> IO Pad) -> IO (Maybe Pad)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Pad
result' -> do
        Pad
result'' <- ((ManagedPtr Pad -> Pad) -> Ptr Pad -> IO Pad
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pad -> Pad
Gst.Pad.Pad) Ptr Pad
result'
        Pad -> IO Pad
forall (m :: * -> *) a. Monad m => a -> m a
return Pad
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    Maybe Pad -> IO (Maybe Pad)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pad
maybeResult

#if defined(ENABLE_OVERLOADING)
data BinFindUnlinkedPadMethodInfo
instance (signature ~ (Gst.Enums.PadDirection -> m (Maybe Gst.Pad.Pad)), MonadIO m, IsBin a) => O.MethodInfo BinFindUnlinkedPadMethodInfo a signature where
    overloadedMethod = binFindUnlinkedPad

#endif

-- method Bin::get_by_interface
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Bin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBin" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iface"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GType of an interface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Element" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_bin_get_by_interface" gst_bin_get_by_interface :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    CGType ->                               -- iface : TBasicType TGType
    IO (Ptr Gst.Element.Element)

-- | Looks for an element inside the bin that implements the given
-- interface. If such an element is found, it returns the element.
-- You can cast this element to the given interface afterwards.  If you want
-- all elements that implement the interface, use
-- 'GI.Gst.Objects.Bin.binIterateAllByInterface'. This function recurses into child bins.
-- 
-- MT safe.  Caller owns returned reference.
binGetByInterface ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a) =>
    a
    -- ^ /@bin@/: a t'GI.Gst.Objects.Bin.Bin'
    -> GType
    -- ^ /@iface@/: the t'GType' of an interface
    -> m (Maybe Gst.Element.Element)
    -- ^ __Returns:__ A t'GI.Gst.Objects.Element.Element' inside the bin
    -- implementing the interface
binGetByInterface :: a -> GType -> m (Maybe Element)
binGetByInterface bin :: a
bin iface :: GType
iface = IO (Maybe Element) -> m (Maybe Element)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Element) -> m (Maybe Element))
-> IO (Maybe Element) -> m (Maybe Element)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    let iface' :: CGType
iface' = GType -> CGType
gtypeToCGType GType
iface
    Ptr Element
result <- Ptr Bin -> CGType -> IO (Ptr Element)
gst_bin_get_by_interface Ptr Bin
bin' CGType
iface'
    Maybe Element
maybeResult <- Ptr Element -> (Ptr Element -> IO Element) -> IO (Maybe Element)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Element
result ((Ptr Element -> IO Element) -> IO (Maybe Element))
-> (Ptr Element -> IO Element) -> IO (Maybe Element)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Element
result' -> do
        Element
result'' <- ((ManagedPtr Element -> Element) -> Ptr Element -> IO Element
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Element -> Element
Gst.Element.Element) Ptr Element
result'
        Element -> IO Element
forall (m :: * -> *) a. Monad m => a -> m a
return Element
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    Maybe Element -> IO (Maybe Element)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Element
maybeResult

#if defined(ENABLE_OVERLOADING)
data BinGetByInterfaceMethodInfo
instance (signature ~ (GType -> m (Maybe Gst.Element.Element)), MonadIO m, IsBin a) => O.MethodInfo BinGetByInterfaceMethodInfo a signature where
    overloadedMethod = binGetByInterface

#endif

-- method Bin::get_by_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Bin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBin" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the element name to search for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Element" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_bin_get_by_name" gst_bin_get_by_name :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Gst.Element.Element)

-- | Gets the element with the given name from a bin. This
-- function recurses into child bins.
-- 
-- Returns 'P.Nothing' if no element with the given name is found in the bin.
-- 
-- MT safe.  Caller owns returned reference.
binGetByName ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a) =>
    a
    -- ^ /@bin@/: a t'GI.Gst.Objects.Bin.Bin'
    -> T.Text
    -- ^ /@name@/: the element name to search for
    -> m (Maybe Gst.Element.Element)
    -- ^ __Returns:__ the t'GI.Gst.Objects.Element.Element' with the given
    -- name, or 'P.Nothing'
binGetByName :: a -> Text -> m (Maybe Element)
binGetByName bin :: a
bin name :: Text
name = IO (Maybe Element) -> m (Maybe Element)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Element) -> m (Maybe Element))
-> IO (Maybe Element) -> m (Maybe Element)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    Ptr CChar
name' <- Text -> IO (Ptr CChar)
textToCString Text
name
    Ptr Element
result <- Ptr Bin -> Ptr CChar -> IO (Ptr Element)
gst_bin_get_by_name Ptr Bin
bin' Ptr CChar
name'
    Maybe Element
maybeResult <- Ptr Element -> (Ptr Element -> IO Element) -> IO (Maybe Element)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Element
result ((Ptr Element -> IO Element) -> IO (Maybe Element))
-> (Ptr Element -> IO Element) -> IO (Maybe Element)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Element
result' -> do
        Element
result'' <- ((ManagedPtr Element -> Element) -> Ptr Element -> IO Element
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Element -> Element
Gst.Element.Element) Ptr Element
result'
        Element -> IO Element
forall (m :: * -> *) a. Monad m => a -> m a
return Element
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
name'
    Maybe Element -> IO (Maybe Element)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Element
maybeResult

#if defined(ENABLE_OVERLOADING)
data BinGetByNameMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gst.Element.Element)), MonadIO m, IsBin a) => O.MethodInfo BinGetByNameMethodInfo a signature where
    overloadedMethod = binGetByName

#endif

-- method Bin::get_by_name_recurse_up
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Bin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBin" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the element name to search for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Element" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_bin_get_by_name_recurse_up" gst_bin_get_by_name_recurse_up :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Gst.Element.Element)

-- | Gets the element with the given name from this bin. If the
-- element is not found, a recursion is performed on the parent bin.
-- 
-- Returns 'P.Nothing' if:
-- 
-- * no element with the given name is found in the bin
-- 
-- 
-- MT safe.  Caller owns returned reference.
binGetByNameRecurseUp ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a) =>
    a
    -- ^ /@bin@/: a t'GI.Gst.Objects.Bin.Bin'
    -> T.Text
    -- ^ /@name@/: the element name to search for
    -> m (Maybe Gst.Element.Element)
    -- ^ __Returns:__ the t'GI.Gst.Objects.Element.Element' with the given
    -- name, or 'P.Nothing'
binGetByNameRecurseUp :: a -> Text -> m (Maybe Element)
binGetByNameRecurseUp bin :: a
bin name :: Text
name = IO (Maybe Element) -> m (Maybe Element)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Element) -> m (Maybe Element))
-> IO (Maybe Element) -> m (Maybe Element)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    Ptr CChar
name' <- Text -> IO (Ptr CChar)
textToCString Text
name
    Ptr Element
result <- Ptr Bin -> Ptr CChar -> IO (Ptr Element)
gst_bin_get_by_name_recurse_up Ptr Bin
bin' Ptr CChar
name'
    Maybe Element
maybeResult <- Ptr Element -> (Ptr Element -> IO Element) -> IO (Maybe Element)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Element
result ((Ptr Element -> IO Element) -> IO (Maybe Element))
-> (Ptr Element -> IO Element) -> IO (Maybe Element)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Element
result' -> do
        Element
result'' <- ((ManagedPtr Element -> Element) -> Ptr Element -> IO Element
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Element -> Element
Gst.Element.Element) Ptr Element
result'
        Element -> IO Element
forall (m :: * -> *) a. Monad m => a -> m a
return Element
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
name'
    Maybe Element -> IO (Maybe Element)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Element
maybeResult

#if defined(ENABLE_OVERLOADING)
data BinGetByNameRecurseUpMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gst.Element.Element)), MonadIO m, IsBin a) => O.MethodInfo BinGetByNameRecurseUpMethodInfo a signature where
    overloadedMethod = binGetByNameRecurseUp

#endif

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

foreign import ccall "gst_bin_get_suppressed_flags" gst_bin_get_suppressed_flags :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    IO CUInt

-- | Return the suppressed flags of the bin.
-- 
-- MT safe.
-- 
-- /Since: 1.10/
binGetSuppressedFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a) =>
    a
    -- ^ /@bin@/: a t'GI.Gst.Objects.Bin.Bin'
    -> m [Gst.Flags.ElementFlags]
    -- ^ __Returns:__ the bin\'s suppressed t'GI.Gst.Flags.ElementFlags'.
binGetSuppressedFlags :: a -> m [ElementFlags]
binGetSuppressedFlags bin :: a
bin = IO [ElementFlags] -> m [ElementFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ElementFlags] -> m [ElementFlags])
-> IO [ElementFlags] -> m [ElementFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    CUInt
result <- Ptr Bin -> IO CUInt
gst_bin_get_suppressed_flags Ptr Bin
bin'
    let result' :: [ElementFlags]
result' = CUInt -> [ElementFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    [ElementFlags] -> IO [ElementFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [ElementFlags]
result'

#if defined(ENABLE_OVERLOADING)
data BinGetSuppressedFlagsMethodInfo
instance (signature ~ (m [Gst.Flags.ElementFlags]), MonadIO m, IsBin a) => O.MethodInfo BinGetSuppressedFlagsMethodInfo a signature where
    overloadedMethod = binGetSuppressedFlags

#endif

-- method Bin::iterate_all_by_interface
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Bin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBin" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iface"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GType of an interface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Iterator" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_bin_iterate_all_by_interface" gst_bin_iterate_all_by_interface :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    CGType ->                               -- iface : TBasicType TGType
    IO (Ptr Gst.Iterator.Iterator)

-- | Looks for all elements inside the bin that implements the given
-- interface. You can safely cast all returned elements to the given interface.
-- The function recurses inside child bins. The iterator will yield a series
-- of t'GI.Gst.Objects.Element.Element' that should be unreffed after use.
-- 
-- MT safe.  Caller owns returned value.
binIterateAllByInterface ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a) =>
    a
    -- ^ /@bin@/: a t'GI.Gst.Objects.Bin.Bin'
    -> GType
    -- ^ /@iface@/: the t'GType' of an interface
    -> m (Maybe Gst.Iterator.Iterator)
    -- ^ __Returns:__ a t'GI.Gst.Structs.Iterator.Iterator' of t'GI.Gst.Objects.Element.Element'
    --     for all elements in the bin implementing the given interface,
    --     or 'P.Nothing'
binIterateAllByInterface :: a -> GType -> m (Maybe Iterator)
binIterateAllByInterface bin :: a
bin iface :: GType
iface = IO (Maybe Iterator) -> m (Maybe Iterator)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Iterator) -> m (Maybe Iterator))
-> IO (Maybe Iterator) -> m (Maybe Iterator)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    let iface' :: CGType
iface' = GType -> CGType
gtypeToCGType GType
iface
    Ptr Iterator
result <- Ptr Bin -> CGType -> IO (Ptr Iterator)
gst_bin_iterate_all_by_interface Ptr Bin
bin' CGType
iface'
    Maybe Iterator
maybeResult <- Ptr Iterator
-> (Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Iterator
result ((Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator))
-> (Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Iterator
result' -> do
        Iterator
result'' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Iterator -> Iterator
Gst.Iterator.Iterator) Ptr Iterator
result'
        Iterator -> IO Iterator
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    Maybe Iterator -> IO (Maybe Iterator)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Iterator
maybeResult

#if defined(ENABLE_OVERLOADING)
data BinIterateAllByInterfaceMethodInfo
instance (signature ~ (GType -> m (Maybe Gst.Iterator.Iterator)), MonadIO m, IsBin a) => O.MethodInfo BinIterateAllByInterfaceMethodInfo a signature where
    overloadedMethod = binIterateAllByInterface

#endif

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

foreign import ccall "gst_bin_iterate_elements" gst_bin_iterate_elements :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    IO (Ptr Gst.Iterator.Iterator)

-- | Gets an iterator for the elements in this bin.
-- 
-- MT safe.  Caller owns returned value.
binIterateElements ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a) =>
    a
    -- ^ /@bin@/: a t'GI.Gst.Objects.Bin.Bin'
    -> m (Maybe Gst.Iterator.Iterator)
    -- ^ __Returns:__ a t'GI.Gst.Structs.Iterator.Iterator' of t'GI.Gst.Objects.Element.Element',
    -- or 'P.Nothing'
binIterateElements :: a -> m (Maybe Iterator)
binIterateElements bin :: a
bin = IO (Maybe Iterator) -> m (Maybe Iterator)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Iterator) -> m (Maybe Iterator))
-> IO (Maybe Iterator) -> m (Maybe Iterator)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    Ptr Iterator
result <- Ptr Bin -> IO (Ptr Iterator)
gst_bin_iterate_elements Ptr Bin
bin'
    Maybe Iterator
maybeResult <- Ptr Iterator
-> (Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Iterator
result ((Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator))
-> (Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Iterator
result' -> do
        Iterator
result'' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Iterator -> Iterator
Gst.Iterator.Iterator) Ptr Iterator
result'
        Iterator -> IO Iterator
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    Maybe Iterator -> IO (Maybe Iterator)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Iterator
maybeResult

#if defined(ENABLE_OVERLOADING)
data BinIterateElementsMethodInfo
instance (signature ~ (m (Maybe Gst.Iterator.Iterator)), MonadIO m, IsBin a) => O.MethodInfo BinIterateElementsMethodInfo a signature where
    overloadedMethod = binIterateElements

#endif

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

foreign import ccall "gst_bin_iterate_recurse" gst_bin_iterate_recurse :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    IO (Ptr Gst.Iterator.Iterator)

-- | Gets an iterator for the elements in this bin.
-- This iterator recurses into GstBin children.
-- 
-- MT safe.  Caller owns returned value.
binIterateRecurse ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a) =>
    a
    -- ^ /@bin@/: a t'GI.Gst.Objects.Bin.Bin'
    -> m (Maybe Gst.Iterator.Iterator)
    -- ^ __Returns:__ a t'GI.Gst.Structs.Iterator.Iterator' of t'GI.Gst.Objects.Element.Element',
    -- or 'P.Nothing'
binIterateRecurse :: a -> m (Maybe Iterator)
binIterateRecurse bin :: a
bin = IO (Maybe Iterator) -> m (Maybe Iterator)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Iterator) -> m (Maybe Iterator))
-> IO (Maybe Iterator) -> m (Maybe Iterator)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    Ptr Iterator
result <- Ptr Bin -> IO (Ptr Iterator)
gst_bin_iterate_recurse Ptr Bin
bin'
    Maybe Iterator
maybeResult <- Ptr Iterator
-> (Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Iterator
result ((Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator))
-> (Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Iterator
result' -> do
        Iterator
result'' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Iterator -> Iterator
Gst.Iterator.Iterator) Ptr Iterator
result'
        Iterator -> IO Iterator
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    Maybe Iterator -> IO (Maybe Iterator)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Iterator
maybeResult

#if defined(ENABLE_OVERLOADING)
data BinIterateRecurseMethodInfo
instance (signature ~ (m (Maybe Gst.Iterator.Iterator)), MonadIO m, IsBin a) => O.MethodInfo BinIterateRecurseMethodInfo a signature where
    overloadedMethod = binIterateRecurse

#endif

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

foreign import ccall "gst_bin_iterate_sinks" gst_bin_iterate_sinks :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    IO (Ptr Gst.Iterator.Iterator)

-- | Gets an iterator for all elements in the bin that have the
-- @/GST_ELEMENT_FLAG_SINK/@ flag set.
-- 
-- MT safe.  Caller owns returned value.
binIterateSinks ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a) =>
    a
    -- ^ /@bin@/: a t'GI.Gst.Objects.Bin.Bin'
    -> m (Maybe Gst.Iterator.Iterator)
    -- ^ __Returns:__ a t'GI.Gst.Structs.Iterator.Iterator' of t'GI.Gst.Objects.Element.Element',
    -- or 'P.Nothing'
binIterateSinks :: a -> m (Maybe Iterator)
binIterateSinks bin :: a
bin = IO (Maybe Iterator) -> m (Maybe Iterator)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Iterator) -> m (Maybe Iterator))
-> IO (Maybe Iterator) -> m (Maybe Iterator)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    Ptr Iterator
result <- Ptr Bin -> IO (Ptr Iterator)
gst_bin_iterate_sinks Ptr Bin
bin'
    Maybe Iterator
maybeResult <- Ptr Iterator
-> (Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Iterator
result ((Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator))
-> (Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Iterator
result' -> do
        Iterator
result'' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Iterator -> Iterator
Gst.Iterator.Iterator) Ptr Iterator
result'
        Iterator -> IO Iterator
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    Maybe Iterator -> IO (Maybe Iterator)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Iterator
maybeResult

#if defined(ENABLE_OVERLOADING)
data BinIterateSinksMethodInfo
instance (signature ~ (m (Maybe Gst.Iterator.Iterator)), MonadIO m, IsBin a) => O.MethodInfo BinIterateSinksMethodInfo a signature where
    overloadedMethod = binIterateSinks

#endif

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

foreign import ccall "gst_bin_iterate_sorted" gst_bin_iterate_sorted :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    IO (Ptr Gst.Iterator.Iterator)

-- | Gets an iterator for the elements in this bin in topologically
-- sorted order. This means that the elements are returned from
-- the most downstream elements (sinks) to the sources.
-- 
-- This function is used internally to perform the state changes
-- of the bin elements and for clock selection.
-- 
-- MT safe.  Caller owns returned value.
binIterateSorted ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a) =>
    a
    -- ^ /@bin@/: a t'GI.Gst.Objects.Bin.Bin'
    -> m (Maybe Gst.Iterator.Iterator)
    -- ^ __Returns:__ a t'GI.Gst.Structs.Iterator.Iterator' of t'GI.Gst.Objects.Element.Element',
    -- or 'P.Nothing'
binIterateSorted :: a -> m (Maybe Iterator)
binIterateSorted bin :: a
bin = IO (Maybe Iterator) -> m (Maybe Iterator)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Iterator) -> m (Maybe Iterator))
-> IO (Maybe Iterator) -> m (Maybe Iterator)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    Ptr Iterator
result <- Ptr Bin -> IO (Ptr Iterator)
gst_bin_iterate_sorted Ptr Bin
bin'
    Maybe Iterator
maybeResult <- Ptr Iterator
-> (Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Iterator
result ((Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator))
-> (Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Iterator
result' -> do
        Iterator
result'' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Iterator -> Iterator
Gst.Iterator.Iterator) Ptr Iterator
result'
        Iterator -> IO Iterator
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    Maybe Iterator -> IO (Maybe Iterator)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Iterator
maybeResult

#if defined(ENABLE_OVERLOADING)
data BinIterateSortedMethodInfo
instance (signature ~ (m (Maybe Gst.Iterator.Iterator)), MonadIO m, IsBin a) => O.MethodInfo BinIterateSortedMethodInfo a signature where
    overloadedMethod = binIterateSorted

#endif

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

foreign import ccall "gst_bin_iterate_sources" gst_bin_iterate_sources :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    IO (Ptr Gst.Iterator.Iterator)

-- | Gets an iterator for all elements in the bin that have the
-- @/GST_ELEMENT_FLAG_SOURCE/@ flag set.
-- 
-- MT safe.  Caller owns returned value.
binIterateSources ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a) =>
    a
    -- ^ /@bin@/: a t'GI.Gst.Objects.Bin.Bin'
    -> m (Maybe Gst.Iterator.Iterator)
    -- ^ __Returns:__ a t'GI.Gst.Structs.Iterator.Iterator' of t'GI.Gst.Objects.Element.Element',
    -- or 'P.Nothing'
binIterateSources :: a -> m (Maybe Iterator)
binIterateSources bin :: a
bin = IO (Maybe Iterator) -> m (Maybe Iterator)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Iterator) -> m (Maybe Iterator))
-> IO (Maybe Iterator) -> m (Maybe Iterator)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    Ptr Iterator
result <- Ptr Bin -> IO (Ptr Iterator)
gst_bin_iterate_sources Ptr Bin
bin'
    Maybe Iterator
maybeResult <- Ptr Iterator
-> (Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Iterator
result ((Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator))
-> (Ptr Iterator -> IO Iterator) -> IO (Maybe Iterator)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Iterator
result' -> do
        Iterator
result'' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Iterator -> Iterator
Gst.Iterator.Iterator) Ptr Iterator
result'
        Iterator -> IO Iterator
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    Maybe Iterator -> IO (Maybe Iterator)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Iterator
maybeResult

#if defined(ENABLE_OVERLOADING)
data BinIterateSourcesMethodInfo
instance (signature ~ (m (Maybe Gst.Iterator.Iterator)), MonadIO m, IsBin a) => O.MethodInfo BinIterateSourcesMethodInfo a signature where
    overloadedMethod = binIterateSources

#endif

-- method Bin::recalculate_latency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Bin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBin" , 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_bin_recalculate_latency" gst_bin_recalculate_latency :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    IO CInt

-- | Query /@bin@/ for the current latency using and reconfigures this latency to all the
-- elements with a LATENCY event.
-- 
-- This method is typically called on the pipeline when a @/GST_MESSAGE_LATENCY/@
-- is posted on the bus.
-- 
-- This function simply emits the \'do-latency\' signal so any custom latency
-- calculations will be performed.
binRecalculateLatency ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a) =>
    a
    -- ^ /@bin@/: a t'GI.Gst.Objects.Bin.Bin'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the latency could be queried and reconfigured.
binRecalculateLatency :: a -> m Bool
binRecalculateLatency bin :: a
bin = BinDoLatencyCallback -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (BinDoLatencyCallback -> m Bool) -> BinDoLatencyCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    CInt
result <- Ptr Bin -> IO CInt
gst_bin_recalculate_latency Ptr Bin
bin'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    Bool -> BinDoLatencyCallback
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BinRecalculateLatencyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsBin a) => O.MethodInfo BinRecalculateLatencyMethodInfo a signature where
    overloadedMethod = binRecalculateLatency

#endif

-- method Bin::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Bin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBin" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "element"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstElement to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_bin_remove" gst_bin_remove :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    Ptr Gst.Element.Element ->              -- element : TInterface (Name {namespace = "Gst", name = "Element"})
    IO CInt

-- | Removes the element from the bin, unparenting it as well.
-- Unparenting the element means that the element will be dereferenced,
-- so if the bin holds the only reference to the element, the element
-- will be freed in the process of removing it from the bin.  If you
-- want the element to still exist after removing, you need to call
-- 'GI.Gst.Objects.Object.objectRef' before removing it from the bin.
-- 
-- If the element\'s pads are linked to other pads, the pads will be unlinked
-- before the element is removed from the bin.
-- 
-- MT safe.
binRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a, Gst.Element.IsElement b) =>
    a
    -- ^ /@bin@/: a t'GI.Gst.Objects.Bin.Bin'
    -> b
    -- ^ /@element@/: the t'GI.Gst.Objects.Element.Element' to remove
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the element could be removed, 'P.False' if
    -- the bin does not want to remove the element.
binRemove :: a -> b -> m Bool
binRemove bin :: a
bin element :: b
element = BinDoLatencyCallback -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (BinDoLatencyCallback -> m Bool) -> BinDoLatencyCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    Ptr Element
element' <- b -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
element
    CInt
result <- Ptr Bin -> Ptr Element -> IO CInt
gst_bin_remove Ptr Bin
bin' Ptr Element
element'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
element
    Bool -> BinDoLatencyCallback
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BinRemoveMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsBin a, Gst.Element.IsElement b) => O.MethodInfo BinRemoveMethodInfo a signature where
    overloadedMethod = binRemove

#endif

-- method Bin::set_suppressed_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Bin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBin" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "ElementFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstElementFlags to suppress"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_bin_set_suppressed_flags" gst_bin_set_suppressed_flags :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "ElementFlags"})
    IO ()

-- | Suppress the given flags on the bin. t'GI.Gst.Flags.ElementFlags' of a
-- child element are propagated when it is added to the bin.
-- When suppressed flags are set, those specified flags will
-- not be propagated to the bin.
-- 
-- MT safe.
-- 
-- /Since: 1.10/
binSetSuppressedFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a) =>
    a
    -- ^ /@bin@/: a t'GI.Gst.Objects.Bin.Bin'
    -> [Gst.Flags.ElementFlags]
    -- ^ /@flags@/: the t'GI.Gst.Flags.ElementFlags' to suppress
    -> m ()
binSetSuppressedFlags :: a -> [ElementFlags] -> m ()
binSetSuppressedFlags bin :: a
bin flags :: [ElementFlags]
flags = 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 Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    let flags' :: CUInt
flags' = [ElementFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ElementFlags]
flags
    Ptr Bin -> CUInt -> IO ()
gst_bin_set_suppressed_flags Ptr Bin
bin' CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BinSetSuppressedFlagsMethodInfo
instance (signature ~ ([Gst.Flags.ElementFlags] -> m ()), MonadIO m, IsBin a) => O.MethodInfo BinSetSuppressedFlagsMethodInfo a signature where
    overloadedMethod = binSetSuppressedFlags

#endif

-- method Bin::sync_children_states
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Bin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBin" , 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_bin_sync_children_states" gst_bin_sync_children_states :: 
    Ptr Bin ->                              -- bin : TInterface (Name {namespace = "Gst", name = "Bin"})
    IO CInt

-- | Synchronizes the state of every child of /@bin@/ with the state
-- of /@bin@/. See also 'GI.Gst.Objects.Element.elementSyncStateWithParent'.
-- 
-- /Since: 1.6/
binSyncChildrenStates ::
    (B.CallStack.HasCallStack, MonadIO m, IsBin a) =>
    a
    -- ^ /@bin@/: a t'GI.Gst.Objects.Bin.Bin'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if syncing the state was successful for all children,
    --  otherwise 'P.False'.
binSyncChildrenStates :: a -> m Bool
binSyncChildrenStates bin :: a
bin = BinDoLatencyCallback -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (BinDoLatencyCallback -> m Bool) -> BinDoLatencyCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bin
bin' <- a -> IO (Ptr Bin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bin
    CInt
result <- Ptr Bin -> IO CInt
gst_bin_sync_children_states Ptr Bin
bin'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bin
    Bool -> BinDoLatencyCallback
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BinSyncChildrenStatesMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsBin a) => O.MethodInfo BinSyncChildrenStatesMethodInfo a signature where
    overloadedMethod = binSyncChildrenStates

#endif