{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Gst.Objects.Element.Element' is linked to other elements via \"pads\", which are extremely
-- light-weight generic link points.
-- 
-- Pads have a t'GI.Gst.Enums.PadDirection', source pads produce data, sink pads consume
-- data.
-- 
-- Pads are typically created from a t'GI.Gst.Objects.PadTemplate.PadTemplate' with
-- 'GI.Gst.Objects.Pad.padNewFromTemplate' and are then added to a t'GI.Gst.Objects.Element.Element'. This usually
-- happens when the element is created but it can also happen dynamically based
-- on the data that the element is processing or based on the pads that the
-- application requests.
-- 
-- Pads without pad templates can be created with 'GI.Gst.Objects.Pad.padNew',
-- which takes a direction and a name as an argument.  If the name is 'P.Nothing',
-- then a guaranteed unique name will be assigned to it.
-- 
-- A t'GI.Gst.Objects.Element.Element' creating a pad will typically use the various
-- gst_pad_set_*@/_function()/@ calls to register callbacks for events, queries or
-- dataflow on the pads.
-- 
-- @/gst_pad_get_parent()/@ will retrieve the t'GI.Gst.Objects.Element.Element' that owns the pad.
-- 
-- After two pads are retrieved from an element by 'GI.Gst.Objects.Element.elementGetStaticPad',
-- the pads can be linked with 'GI.Gst.Objects.Pad.padLink'. (For quick links,
-- you can also use 'GI.Gst.Objects.Element.elementLink', which will make the obvious
-- link for you if it\'s straightforward.). Pads can be unlinked again with
-- 'GI.Gst.Objects.Pad.padUnlink'. 'GI.Gst.Objects.Pad.padGetPeer' can be used to check what the pad is
-- linked to.
-- 
-- Before dataflow is possible on the pads, they need to be activated with
-- 'GI.Gst.Objects.Pad.padSetActive'.
-- 
-- 'GI.Gst.Objects.Pad.padQuery' and 'GI.Gst.Objects.Pad.padPeerQuery' can be used to query various
-- properties of the pad and the stream.
-- 
-- To send a t'GI.Gst.Structs.Event.Event' on a pad, use 'GI.Gst.Objects.Pad.padSendEvent' and
-- 'GI.Gst.Objects.Pad.padPushEvent'. Some events will be sticky on the pad, meaning that
-- after they pass on the pad they can be queried later with
-- 'GI.Gst.Objects.Pad.padGetStickyEvent' and 'GI.Gst.Objects.Pad.padStickyEventsForeach'.
-- 'GI.Gst.Objects.Pad.padGetCurrentCaps' and 'GI.Gst.Objects.Pad.padHasCurrentCaps' are convenience
-- functions to query the current sticky CAPS event on a pad.
-- 
-- GstElements will use 'GI.Gst.Objects.Pad.padPush' and 'GI.Gst.Objects.Pad.padPullRange' to push out
-- or pull in a buffer.
-- 
-- The dataflow, events and queries that happen on a pad can be monitored with
-- probes that can be installed with 'GI.Gst.Objects.Pad.padAddProbe'. 'GI.Gst.Objects.Pad.padIsBlocked'
-- can be used to check if a block probe is installed on the pad.
-- 'GI.Gst.Objects.Pad.padIsBlocking' checks if the blocking probe is currently blocking the
-- pad. 'GI.Gst.Objects.Pad.padRemoveProbe' is used to remove a previously installed probe
-- and unblock blocking probes if any.
-- 
-- Pad have an offset that can be retrieved with 'GI.Gst.Objects.Pad.padGetOffset'. This
-- offset will be applied to the running_time of all data passing over the pad.
-- 'GI.Gst.Objects.Pad.padSetOffset' can be used to change the offset.
-- 
-- Convenience functions exist to start, pause and stop the task on a pad with
-- 'GI.Gst.Objects.Pad.padStartTask', 'GI.Gst.Objects.Pad.padPauseTask' and 'GI.Gst.Objects.Pad.padStopTask'
-- respectively.

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

module GI.Gst.Objects.Pad
    ( 

-- * Exported types
    Pad(..)                                 ,
    IsPad                                   ,
    toPad                                   ,


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

#if defined(ENABLE_OVERLOADING)
    ResolvePadMethod                        ,
#endif


-- ** activateMode #method:activateMode#

#if defined(ENABLE_OVERLOADING)
    PadActivateModeMethodInfo               ,
#endif
    padActivateMode                         ,


-- ** addProbe #method:addProbe#

#if defined(ENABLE_OVERLOADING)
    PadAddProbeMethodInfo                   ,
#endif
    padAddProbe                             ,


-- ** canLink #method:canLink#

#if defined(ENABLE_OVERLOADING)
    PadCanLinkMethodInfo                    ,
#endif
    padCanLink                              ,


-- ** chain #method:chain#

#if defined(ENABLE_OVERLOADING)
    PadChainMethodInfo                      ,
#endif
    padChain                                ,


-- ** chainList #method:chainList#

#if defined(ENABLE_OVERLOADING)
    PadChainListMethodInfo                  ,
#endif
    padChainList                            ,


-- ** checkReconfigure #method:checkReconfigure#

#if defined(ENABLE_OVERLOADING)
    PadCheckReconfigureMethodInfo           ,
#endif
    padCheckReconfigure                     ,


-- ** createStreamId #method:createStreamId#

#if defined(ENABLE_OVERLOADING)
    PadCreateStreamIdMethodInfo             ,
#endif
    padCreateStreamId                       ,


-- ** eventDefault #method:eventDefault#

#if defined(ENABLE_OVERLOADING)
    PadEventDefaultMethodInfo               ,
#endif
    padEventDefault                         ,


-- ** forward #method:forward#

#if defined(ENABLE_OVERLOADING)
    PadForwardMethodInfo                    ,
#endif
    padForward                              ,


-- ** getAllowedCaps #method:getAllowedCaps#

#if defined(ENABLE_OVERLOADING)
    PadGetAllowedCapsMethodInfo             ,
#endif
    padGetAllowedCaps                       ,


-- ** getCurrentCaps #method:getCurrentCaps#

#if defined(ENABLE_OVERLOADING)
    PadGetCurrentCapsMethodInfo             ,
#endif
    padGetCurrentCaps                       ,


-- ** getDirection #method:getDirection#

#if defined(ENABLE_OVERLOADING)
    PadGetDirectionMethodInfo               ,
#endif
    padGetDirection                         ,


-- ** getElementPrivate #method:getElementPrivate#

#if defined(ENABLE_OVERLOADING)
    PadGetElementPrivateMethodInfo          ,
#endif
    padGetElementPrivate                    ,


-- ** getLastFlowReturn #method:getLastFlowReturn#

#if defined(ENABLE_OVERLOADING)
    PadGetLastFlowReturnMethodInfo          ,
#endif
    padGetLastFlowReturn                    ,


-- ** getOffset #method:getOffset#

#if defined(ENABLE_OVERLOADING)
    PadGetOffsetMethodInfo                  ,
#endif
    padGetOffset                            ,


-- ** getPadTemplate #method:getPadTemplate#

#if defined(ENABLE_OVERLOADING)
    PadGetPadTemplateMethodInfo             ,
#endif
    padGetPadTemplate                       ,


-- ** getPadTemplateCaps #method:getPadTemplateCaps#

#if defined(ENABLE_OVERLOADING)
    PadGetPadTemplateCapsMethodInfo         ,
#endif
    padGetPadTemplateCaps                   ,


-- ** getParentElement #method:getParentElement#

#if defined(ENABLE_OVERLOADING)
    PadGetParentElementMethodInfo           ,
#endif
    padGetParentElement                     ,


-- ** getPeer #method:getPeer#

#if defined(ENABLE_OVERLOADING)
    PadGetPeerMethodInfo                    ,
#endif
    padGetPeer                              ,


-- ** getRange #method:getRange#

#if defined(ENABLE_OVERLOADING)
    PadGetRangeMethodInfo                   ,
#endif
    padGetRange                             ,


-- ** getStickyEvent #method:getStickyEvent#

#if defined(ENABLE_OVERLOADING)
    PadGetStickyEventMethodInfo             ,
#endif
    padGetStickyEvent                       ,


-- ** getStream #method:getStream#

#if defined(ENABLE_OVERLOADING)
    PadGetStreamMethodInfo                  ,
#endif
    padGetStream                            ,


-- ** getStreamId #method:getStreamId#

#if defined(ENABLE_OVERLOADING)
    PadGetStreamIdMethodInfo                ,
#endif
    padGetStreamId                          ,


-- ** getTaskState #method:getTaskState#

#if defined(ENABLE_OVERLOADING)
    PadGetTaskStateMethodInfo               ,
#endif
    padGetTaskState                         ,


-- ** hasCurrentCaps #method:hasCurrentCaps#

#if defined(ENABLE_OVERLOADING)
    PadHasCurrentCapsMethodInfo             ,
#endif
    padHasCurrentCaps                       ,


-- ** isActive #method:isActive#

#if defined(ENABLE_OVERLOADING)
    PadIsActiveMethodInfo                   ,
#endif
    padIsActive                             ,


-- ** isBlocked #method:isBlocked#

#if defined(ENABLE_OVERLOADING)
    PadIsBlockedMethodInfo                  ,
#endif
    padIsBlocked                            ,


-- ** isBlocking #method:isBlocking#

#if defined(ENABLE_OVERLOADING)
    PadIsBlockingMethodInfo                 ,
#endif
    padIsBlocking                           ,


-- ** isLinked #method:isLinked#

#if defined(ENABLE_OVERLOADING)
    PadIsLinkedMethodInfo                   ,
#endif
    padIsLinked                             ,


-- ** iterateInternalLinks #method:iterateInternalLinks#

#if defined(ENABLE_OVERLOADING)
    PadIterateInternalLinksMethodInfo       ,
#endif
    padIterateInternalLinks                 ,


-- ** iterateInternalLinksDefault #method:iterateInternalLinksDefault#

#if defined(ENABLE_OVERLOADING)
    PadIterateInternalLinksDefaultMethodInfo,
#endif
    padIterateInternalLinksDefault          ,


-- ** link #method:link#

#if defined(ENABLE_OVERLOADING)
    PadLinkMethodInfo                       ,
#endif
    padLink                                 ,


-- ** linkFull #method:linkFull#

#if defined(ENABLE_OVERLOADING)
    PadLinkFullMethodInfo                   ,
#endif
    padLinkFull                             ,


-- ** linkGetName #method:linkGetName#

    padLinkGetName                          ,


-- ** linkMaybeGhosting #method:linkMaybeGhosting#

#if defined(ENABLE_OVERLOADING)
    PadLinkMaybeGhostingMethodInfo          ,
#endif
    padLinkMaybeGhosting                    ,


-- ** linkMaybeGhostingFull #method:linkMaybeGhostingFull#

#if defined(ENABLE_OVERLOADING)
    PadLinkMaybeGhostingFullMethodInfo      ,
#endif
    padLinkMaybeGhostingFull                ,


-- ** markReconfigure #method:markReconfigure#

#if defined(ENABLE_OVERLOADING)
    PadMarkReconfigureMethodInfo            ,
#endif
    padMarkReconfigure                      ,


-- ** needsReconfigure #method:needsReconfigure#

#if defined(ENABLE_OVERLOADING)
    PadNeedsReconfigureMethodInfo           ,
#endif
    padNeedsReconfigure                     ,


-- ** new #method:new#

    padNew                                  ,


-- ** newFromStaticTemplate #method:newFromStaticTemplate#

    padNewFromStaticTemplate                ,


-- ** newFromTemplate #method:newFromTemplate#

    padNewFromTemplate                      ,


-- ** pauseTask #method:pauseTask#

#if defined(ENABLE_OVERLOADING)
    PadPauseTaskMethodInfo                  ,
#endif
    padPauseTask                            ,


-- ** peerQuery #method:peerQuery#

#if defined(ENABLE_OVERLOADING)
    PadPeerQueryMethodInfo                  ,
#endif
    padPeerQuery                            ,


-- ** peerQueryAcceptCaps #method:peerQueryAcceptCaps#

#if defined(ENABLE_OVERLOADING)
    PadPeerQueryAcceptCapsMethodInfo        ,
#endif
    padPeerQueryAcceptCaps                  ,


-- ** peerQueryCaps #method:peerQueryCaps#

#if defined(ENABLE_OVERLOADING)
    PadPeerQueryCapsMethodInfo              ,
#endif
    padPeerQueryCaps                        ,


-- ** peerQueryConvert #method:peerQueryConvert#

#if defined(ENABLE_OVERLOADING)
    PadPeerQueryConvertMethodInfo           ,
#endif
    padPeerQueryConvert                     ,


-- ** peerQueryDuration #method:peerQueryDuration#

#if defined(ENABLE_OVERLOADING)
    PadPeerQueryDurationMethodInfo          ,
#endif
    padPeerQueryDuration                    ,


-- ** peerQueryPosition #method:peerQueryPosition#

#if defined(ENABLE_OVERLOADING)
    PadPeerQueryPositionMethodInfo          ,
#endif
    padPeerQueryPosition                    ,


-- ** proxyQueryAcceptCaps #method:proxyQueryAcceptCaps#

#if defined(ENABLE_OVERLOADING)
    PadProxyQueryAcceptCapsMethodInfo       ,
#endif
    padProxyQueryAcceptCaps                 ,


-- ** proxyQueryCaps #method:proxyQueryCaps#

#if defined(ENABLE_OVERLOADING)
    PadProxyQueryCapsMethodInfo             ,
#endif
    padProxyQueryCaps                       ,


-- ** pullRange #method:pullRange#

#if defined(ENABLE_OVERLOADING)
    PadPullRangeMethodInfo                  ,
#endif
    padPullRange                            ,


-- ** push #method:push#

#if defined(ENABLE_OVERLOADING)
    PadPushMethodInfo                       ,
#endif
    padPush                                 ,


-- ** pushEvent #method:pushEvent#

#if defined(ENABLE_OVERLOADING)
    PadPushEventMethodInfo                  ,
#endif
    padPushEvent                            ,


-- ** pushList #method:pushList#

#if defined(ENABLE_OVERLOADING)
    PadPushListMethodInfo                   ,
#endif
    padPushList                             ,


-- ** query #method:query#

#if defined(ENABLE_OVERLOADING)
    PadQueryMethodInfo                      ,
#endif
    padQuery                                ,


-- ** queryAcceptCaps #method:queryAcceptCaps#

#if defined(ENABLE_OVERLOADING)
    PadQueryAcceptCapsMethodInfo            ,
#endif
    padQueryAcceptCaps                      ,


-- ** queryCaps #method:queryCaps#

#if defined(ENABLE_OVERLOADING)
    PadQueryCapsMethodInfo                  ,
#endif
    padQueryCaps                            ,


-- ** queryConvert #method:queryConvert#

#if defined(ENABLE_OVERLOADING)
    PadQueryConvertMethodInfo               ,
#endif
    padQueryConvert                         ,


-- ** queryDefault #method:queryDefault#

#if defined(ENABLE_OVERLOADING)
    PadQueryDefaultMethodInfo               ,
#endif
    padQueryDefault                         ,


-- ** queryDuration #method:queryDuration#

#if defined(ENABLE_OVERLOADING)
    PadQueryDurationMethodInfo              ,
#endif
    padQueryDuration                        ,


-- ** queryPosition #method:queryPosition#

#if defined(ENABLE_OVERLOADING)
    PadQueryPositionMethodInfo              ,
#endif
    padQueryPosition                        ,


-- ** removeProbe #method:removeProbe#

#if defined(ENABLE_OVERLOADING)
    PadRemoveProbeMethodInfo                ,
#endif
    padRemoveProbe                          ,


-- ** sendEvent #method:sendEvent#

#if defined(ENABLE_OVERLOADING)
    PadSendEventMethodInfo                  ,
#endif
    padSendEvent                            ,


-- ** setActivateFunctionFull #method:setActivateFunctionFull#

#if defined(ENABLE_OVERLOADING)
    PadSetActivateFunctionFullMethodInfo    ,
#endif
    padSetActivateFunctionFull              ,


-- ** setActivatemodeFunctionFull #method:setActivatemodeFunctionFull#

#if defined(ENABLE_OVERLOADING)
    PadSetActivatemodeFunctionFullMethodInfo,
#endif
    padSetActivatemodeFunctionFull          ,


-- ** setActive #method:setActive#

#if defined(ENABLE_OVERLOADING)
    PadSetActiveMethodInfo                  ,
#endif
    padSetActive                            ,


-- ** setChainFunctionFull #method:setChainFunctionFull#

#if defined(ENABLE_OVERLOADING)
    PadSetChainFunctionFullMethodInfo       ,
#endif
    padSetChainFunctionFull                 ,


-- ** setChainListFunctionFull #method:setChainListFunctionFull#

#if defined(ENABLE_OVERLOADING)
    PadSetChainListFunctionFullMethodInfo   ,
#endif
    padSetChainListFunctionFull             ,


-- ** setElementPrivate #method:setElementPrivate#

#if defined(ENABLE_OVERLOADING)
    PadSetElementPrivateMethodInfo          ,
#endif
    padSetElementPrivate                    ,


-- ** setEventFullFunctionFull #method:setEventFullFunctionFull#

#if defined(ENABLE_OVERLOADING)
    PadSetEventFullFunctionFullMethodInfo   ,
#endif
    padSetEventFullFunctionFull             ,


-- ** setEventFunctionFull #method:setEventFunctionFull#

#if defined(ENABLE_OVERLOADING)
    PadSetEventFunctionFullMethodInfo       ,
#endif
    padSetEventFunctionFull                 ,


-- ** setGetrangeFunctionFull #method:setGetrangeFunctionFull#

#if defined(ENABLE_OVERLOADING)
    PadSetGetrangeFunctionFullMethodInfo    ,
#endif
    padSetGetrangeFunctionFull              ,


-- ** setIterateInternalLinksFunctionFull #method:setIterateInternalLinksFunctionFull#

#if defined(ENABLE_OVERLOADING)
    PadSetIterateInternalLinksFunctionFullMethodInfo,
#endif
    padSetIterateInternalLinksFunctionFull  ,


-- ** setLinkFunctionFull #method:setLinkFunctionFull#

#if defined(ENABLE_OVERLOADING)
    PadSetLinkFunctionFullMethodInfo        ,
#endif
    padSetLinkFunctionFull                  ,


-- ** setOffset #method:setOffset#

#if defined(ENABLE_OVERLOADING)
    PadSetOffsetMethodInfo                  ,
#endif
    padSetOffset                            ,


-- ** setQueryFunctionFull #method:setQueryFunctionFull#

#if defined(ENABLE_OVERLOADING)
    PadSetQueryFunctionFullMethodInfo       ,
#endif
    padSetQueryFunctionFull                 ,


-- ** setUnlinkFunctionFull #method:setUnlinkFunctionFull#

#if defined(ENABLE_OVERLOADING)
    PadSetUnlinkFunctionFullMethodInfo      ,
#endif
    padSetUnlinkFunctionFull                ,


-- ** startTask #method:startTask#

#if defined(ENABLE_OVERLOADING)
    PadStartTaskMethodInfo                  ,
#endif
    padStartTask                            ,


-- ** stickyEventsForeach #method:stickyEventsForeach#

#if defined(ENABLE_OVERLOADING)
    PadStickyEventsForeachMethodInfo        ,
#endif
    padStickyEventsForeach                  ,


-- ** stopTask #method:stopTask#

#if defined(ENABLE_OVERLOADING)
    PadStopTaskMethodInfo                   ,
#endif
    padStopTask                             ,


-- ** storeStickyEvent #method:storeStickyEvent#

#if defined(ENABLE_OVERLOADING)
    PadStoreStickyEventMethodInfo           ,
#endif
    padStoreStickyEvent                     ,


-- ** unlink #method:unlink#

#if defined(ENABLE_OVERLOADING)
    PadUnlinkMethodInfo                     ,
#endif
    padUnlink                               ,


-- ** useFixedCaps #method:useFixedCaps#

#if defined(ENABLE_OVERLOADING)
    PadUseFixedCapsMethodInfo               ,
#endif
    padUseFixedCaps                         ,




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

#if defined(ENABLE_OVERLOADING)
    PadCapsPropertyInfo                     ,
#endif
    getPadCaps                              ,
#if defined(ENABLE_OVERLOADING)
    padCaps                                 ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    PadDirectionPropertyInfo                ,
#endif
    constructPadDirection                   ,
    getPadDirection                         ,
#if defined(ENABLE_OVERLOADING)
    padDirection                            ,
#endif


-- ** offset #attr:offset#
-- | The offset that will be applied to the running time of the pad.
-- 
-- /Since: 1.6/

#if defined(ENABLE_OVERLOADING)
    PadOffsetPropertyInfo                   ,
#endif
    constructPadOffset                      ,
    getPadOffset                            ,
#if defined(ENABLE_OVERLOADING)
    padOffset                               ,
#endif
    setPadOffset                            ,


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

#if defined(ENABLE_OVERLOADING)
    PadTemplatePropertyInfo                 ,
#endif
    clearPadTemplate                        ,
    constructPadTemplate                    ,
    getPadTemplate                          ,
#if defined(ENABLE_OVERLOADING)
    padTemplate                             ,
#endif
    setPadTemplate                          ,




 -- * Signals
-- ** linked #signal:linked#

    C_PadLinkedCallback                     ,
    PadLinkedCallback                       ,
#if defined(ENABLE_OVERLOADING)
    PadLinkedSignalInfo                     ,
#endif
    afterPadLinked                          ,
    genClosure_PadLinked                    ,
    mk_PadLinkedCallback                    ,
    noPadLinkedCallback                     ,
    onPadLinked                             ,
    wrap_PadLinkedCallback                  ,


-- ** unlinked #signal:unlinked#

    C_PadUnlinkedCallback                   ,
    PadUnlinkedCallback                     ,
#if defined(ENABLE_OVERLOADING)
    PadUnlinkedSignalInfo                   ,
#endif
    afterPadUnlinked                        ,
    genClosure_PadUnlinked                  ,
    mk_PadUnlinkedCallback                  ,
    noPadUnlinkedCallback                   ,
    onPadUnlinked                           ,
    wrap_PadUnlinkedCallback                ,




    ) where

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

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

import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gst.Callbacks as Gst.Callbacks
import {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums
import {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags
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.PadTemplate as Gst.PadTemplate
import {-# SOURCE #-} qualified GI.Gst.Objects.Stream as Gst.Stream
import {-# SOURCE #-} qualified GI.Gst.Structs.Buffer as Gst.Buffer
import {-# SOURCE #-} qualified GI.Gst.Structs.BufferList as Gst.BufferList
import {-# SOURCE #-} qualified GI.Gst.Structs.Caps as Gst.Caps
import {-# SOURCE #-} qualified GI.Gst.Structs.Event as Gst.Event
import {-# SOURCE #-} qualified GI.Gst.Structs.Iterator as Gst.Iterator
import {-# SOURCE #-} qualified GI.Gst.Structs.Query as Gst.Query
import {-# SOURCE #-} qualified GI.Gst.Structs.StaticPadTemplate as Gst.StaticPadTemplate

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

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

foreign import ccall "gst_pad_get_type"
    c_gst_pad_get_type :: IO B.Types.GType

instance B.Types.TypedObject Pad where
    glibType :: IO GType
glibType = IO GType
c_gst_pad_get_type

instance B.Types.GObject Pad

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

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

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

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

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

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

#endif

-- signal Pad::linked
-- | Signals that a pad has been linked to the peer pad.
type PadLinkedCallback =
    Pad
    -- ^ /@peer@/: the peer pad that has been connected
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `PadLinkedCallback`@.
noPadLinkedCallback :: Maybe PadLinkedCallback
noPadLinkedCallback :: Maybe PadLinkedCallback
noPadLinkedCallback = Maybe PadLinkedCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_PadLinked :: MonadIO m => PadLinkedCallback -> m (GClosure C_PadLinkedCallback)
genClosure_PadLinked :: PadLinkedCallback -> m (GClosure C_PadLinkedCallback)
genClosure_PadLinked PadLinkedCallback
cb = IO (GClosure C_PadLinkedCallback)
-> m (GClosure C_PadLinkedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_PadLinkedCallback)
 -> m (GClosure C_PadLinkedCallback))
-> IO (GClosure C_PadLinkedCallback)
-> m (GClosure C_PadLinkedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PadLinkedCallback
cb' = PadLinkedCallback -> C_PadLinkedCallback
wrap_PadLinkedCallback PadLinkedCallback
cb
    C_PadLinkedCallback -> IO (FunPtr C_PadLinkedCallback)
mk_PadLinkedCallback C_PadLinkedCallback
cb' IO (FunPtr C_PadLinkedCallback)
-> (FunPtr C_PadLinkedCallback
    -> IO (GClosure C_PadLinkedCallback))
-> IO (GClosure C_PadLinkedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_PadLinkedCallback -> IO (GClosure C_PadLinkedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `PadLinkedCallback` into a `C_PadLinkedCallback`.
wrap_PadLinkedCallback ::
    PadLinkedCallback ->
    C_PadLinkedCallback
wrap_PadLinkedCallback :: PadLinkedCallback -> C_PadLinkedCallback
wrap_PadLinkedCallback PadLinkedCallback
_cb Ptr ()
_ Ptr Pad
peer Ptr ()
_ = do
    Pad
peer' <- ((ManagedPtr Pad -> Pad) -> Ptr Pad -> IO Pad
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Pad -> Pad
Pad) Ptr Pad
peer
    PadLinkedCallback
_cb  Pad
peer'


-- | Connect a signal handler for the [linked](#signal:linked) 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' pad #linked callback
-- @
-- 
-- 
onPadLinked :: (IsPad a, MonadIO m) => a -> PadLinkedCallback -> m SignalHandlerId
onPadLinked :: a -> PadLinkedCallback -> m SignalHandlerId
onPadLinked a
obj PadLinkedCallback
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_PadLinkedCallback
cb' = PadLinkedCallback -> C_PadLinkedCallback
wrap_PadLinkedCallback PadLinkedCallback
cb
    FunPtr C_PadLinkedCallback
cb'' <- C_PadLinkedCallback -> IO (FunPtr C_PadLinkedCallback)
mk_PadLinkedCallback C_PadLinkedCallback
cb'
    a
-> Text
-> FunPtr C_PadLinkedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"linked" FunPtr C_PadLinkedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [linked](#signal:linked) 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' pad #linked callback
-- @
-- 
-- 
afterPadLinked :: (IsPad a, MonadIO m) => a -> PadLinkedCallback -> m SignalHandlerId
afterPadLinked :: a -> PadLinkedCallback -> m SignalHandlerId
afterPadLinked a
obj PadLinkedCallback
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_PadLinkedCallback
cb' = PadLinkedCallback -> C_PadLinkedCallback
wrap_PadLinkedCallback PadLinkedCallback
cb
    FunPtr C_PadLinkedCallback
cb'' <- C_PadLinkedCallback -> IO (FunPtr C_PadLinkedCallback)
mk_PadLinkedCallback C_PadLinkedCallback
cb'
    a
-> Text
-> FunPtr C_PadLinkedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"linked" FunPtr C_PadLinkedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PadLinkedSignalInfo
instance SignalInfo PadLinkedSignalInfo where
    type HaskellCallbackType PadLinkedSignalInfo = PadLinkedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PadLinkedCallback cb
        cb'' <- mk_PadLinkedCallback cb'
        connectSignalFunPtr obj "linked" cb'' connectMode detail

#endif

-- signal Pad::unlinked
-- | Signals that a pad has been unlinked from the peer pad.
type PadUnlinkedCallback =
    Pad
    -- ^ /@peer@/: the peer pad that has been disconnected
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `PadUnlinkedCallback`@.
noPadUnlinkedCallback :: Maybe PadUnlinkedCallback
noPadUnlinkedCallback :: Maybe PadLinkedCallback
noPadUnlinkedCallback = Maybe PadLinkedCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_PadUnlinked :: MonadIO m => PadUnlinkedCallback -> m (GClosure C_PadUnlinkedCallback)
genClosure_PadUnlinked :: PadLinkedCallback -> m (GClosure C_PadLinkedCallback)
genClosure_PadUnlinked PadLinkedCallback
cb = IO (GClosure C_PadLinkedCallback)
-> m (GClosure C_PadLinkedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_PadLinkedCallback)
 -> m (GClosure C_PadLinkedCallback))
-> IO (GClosure C_PadLinkedCallback)
-> m (GClosure C_PadLinkedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PadLinkedCallback
cb' = PadLinkedCallback -> C_PadLinkedCallback
wrap_PadUnlinkedCallback PadLinkedCallback
cb
    C_PadLinkedCallback -> IO (FunPtr C_PadLinkedCallback)
mk_PadUnlinkedCallback C_PadLinkedCallback
cb' IO (FunPtr C_PadLinkedCallback)
-> (FunPtr C_PadLinkedCallback
    -> IO (GClosure C_PadLinkedCallback))
-> IO (GClosure C_PadLinkedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_PadLinkedCallback -> IO (GClosure C_PadLinkedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `PadUnlinkedCallback` into a `C_PadUnlinkedCallback`.
wrap_PadUnlinkedCallback ::
    PadUnlinkedCallback ->
    C_PadUnlinkedCallback
wrap_PadUnlinkedCallback :: PadLinkedCallback -> C_PadLinkedCallback
wrap_PadUnlinkedCallback PadLinkedCallback
_cb Ptr ()
_ Ptr Pad
peer Ptr ()
_ = do
    Pad
peer' <- ((ManagedPtr Pad -> Pad) -> Ptr Pad -> IO Pad
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Pad -> Pad
Pad) Ptr Pad
peer
    PadLinkedCallback
_cb  Pad
peer'


-- | Connect a signal handler for the [unlinked](#signal:unlinked) 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' pad #unlinked callback
-- @
-- 
-- 
onPadUnlinked :: (IsPad a, MonadIO m) => a -> PadUnlinkedCallback -> m SignalHandlerId
onPadUnlinked :: a -> PadLinkedCallback -> m SignalHandlerId
onPadUnlinked a
obj PadLinkedCallback
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_PadLinkedCallback
cb' = PadLinkedCallback -> C_PadLinkedCallback
wrap_PadUnlinkedCallback PadLinkedCallback
cb
    FunPtr C_PadLinkedCallback
cb'' <- C_PadLinkedCallback -> IO (FunPtr C_PadLinkedCallback)
mk_PadUnlinkedCallback C_PadLinkedCallback
cb'
    a
-> Text
-> FunPtr C_PadLinkedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"unlinked" FunPtr C_PadLinkedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [unlinked](#signal:unlinked) 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' pad #unlinked callback
-- @
-- 
-- 
afterPadUnlinked :: (IsPad a, MonadIO m) => a -> PadUnlinkedCallback -> m SignalHandlerId
afterPadUnlinked :: a -> PadLinkedCallback -> m SignalHandlerId
afterPadUnlinked a
obj PadLinkedCallback
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_PadLinkedCallback
cb' = PadLinkedCallback -> C_PadLinkedCallback
wrap_PadUnlinkedCallback PadLinkedCallback
cb
    FunPtr C_PadLinkedCallback
cb'' <- C_PadLinkedCallback -> IO (FunPtr C_PadLinkedCallback)
mk_PadUnlinkedCallback C_PadLinkedCallback
cb'
    a
-> Text
-> FunPtr C_PadLinkedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"unlinked" FunPtr C_PadLinkedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PadUnlinkedSignalInfo
instance SignalInfo PadUnlinkedSignalInfo where
    type HaskellCallbackType PadUnlinkedSignalInfo = PadUnlinkedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PadUnlinkedCallback cb
        cb'' <- mk_PadUnlinkedCallback cb'
        connectSignalFunPtr obj "unlinked" cb'' connectMode detail

#endif

-- VVV Prop "caps"
   -- Type: TInterface (Name {namespace = "Gst", name = "Caps"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@caps@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pad #caps
-- @
getPadCaps :: (MonadIO m, IsPad o) => o -> m (Maybe Gst.Caps.Caps)
getPadCaps :: o -> m (Maybe Caps)
getPadCaps o
obj = IO (Maybe Caps) -> m (Maybe Caps)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Caps) -> m (Maybe Caps))
-> IO (Maybe Caps) -> m (Maybe Caps)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Caps -> Caps) -> IO (Maybe Caps)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"caps" ManagedPtr Caps -> Caps
Gst.Caps.Caps

#if defined(ENABLE_OVERLOADING)
data PadCapsPropertyInfo
instance AttrInfo PadCapsPropertyInfo where
    type AttrAllowedOps PadCapsPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PadCapsPropertyInfo = IsPad
    type AttrSetTypeConstraint PadCapsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint PadCapsPropertyInfo = (~) ()
    type AttrTransferType PadCapsPropertyInfo = ()
    type AttrGetType PadCapsPropertyInfo = (Maybe Gst.Caps.Caps)
    type AttrLabel PadCapsPropertyInfo = "caps"
    type AttrOrigin PadCapsPropertyInfo = Pad
    attrGet = getPadCaps
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "direction"
   -- Type: TInterface (Name {namespace = "Gst", name = "PadDirection"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@direction@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pad #direction
-- @
getPadDirection :: (MonadIO m, IsPad o) => o -> m Gst.Enums.PadDirection
getPadDirection :: o -> m PadDirection
getPadDirection o
obj = IO PadDirection -> m PadDirection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PadDirection -> m PadDirection)
-> IO PadDirection -> m PadDirection
forall a b. (a -> b) -> a -> b
$ o -> String -> IO PadDirection
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"direction"

-- | Construct a `GValueConstruct` with valid value for the “@direction@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPadDirection :: (IsPad o, MIO.MonadIO m) => Gst.Enums.PadDirection -> m (GValueConstruct o)
constructPadDirection :: PadDirection -> m (GValueConstruct o)
constructPadDirection PadDirection
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> PadDirection -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"direction" PadDirection
val

#if defined(ENABLE_OVERLOADING)
data PadDirectionPropertyInfo
instance AttrInfo PadDirectionPropertyInfo where
    type AttrAllowedOps PadDirectionPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PadDirectionPropertyInfo = IsPad
    type AttrSetTypeConstraint PadDirectionPropertyInfo = (~) Gst.Enums.PadDirection
    type AttrTransferTypeConstraint PadDirectionPropertyInfo = (~) Gst.Enums.PadDirection
    type AttrTransferType PadDirectionPropertyInfo = Gst.Enums.PadDirection
    type AttrGetType PadDirectionPropertyInfo = Gst.Enums.PadDirection
    type AttrLabel PadDirectionPropertyInfo = "direction"
    type AttrOrigin PadDirectionPropertyInfo = Pad
    attrGet = getPadDirection
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPadDirection
    attrClear = undefined
#endif

-- VVV Prop "offset"
   -- Type: TBasicType TInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@offset@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' pad [ #offset 'Data.GI.Base.Attributes.:=' value ]
-- @
setPadOffset :: (MonadIO m, IsPad o) => o -> Int64 -> m ()
setPadOffset :: o -> Int64 -> m ()
setPadOffset o
obj Int64
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 -> Int64 -> IO ()
forall a. GObject a => a -> String -> Int64 -> IO ()
B.Properties.setObjectPropertyInt64 o
obj String
"offset" Int64
val

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

#if defined(ENABLE_OVERLOADING)
data PadOffsetPropertyInfo
instance AttrInfo PadOffsetPropertyInfo where
    type AttrAllowedOps PadOffsetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PadOffsetPropertyInfo = IsPad
    type AttrSetTypeConstraint PadOffsetPropertyInfo = (~) Int64
    type AttrTransferTypeConstraint PadOffsetPropertyInfo = (~) Int64
    type AttrTransferType PadOffsetPropertyInfo = Int64
    type AttrGetType PadOffsetPropertyInfo = Int64
    type AttrLabel PadOffsetPropertyInfo = "offset"
    type AttrOrigin PadOffsetPropertyInfo = Pad
    attrGet = getPadOffset
    attrSet = setPadOffset
    attrTransfer _ v = do
        return v
    attrConstruct = constructPadOffset
    attrClear = undefined
#endif

-- VVV Prop "template"
   -- Type: TInterface (Name {namespace = "Gst", name = "PadTemplate"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@template@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pad #template
-- @
getPadTemplate :: (MonadIO m, IsPad o) => o -> m (Maybe Gst.PadTemplate.PadTemplate)
getPadTemplate :: o -> m (Maybe PadTemplate)
getPadTemplate o
obj = IO (Maybe PadTemplate) -> m (Maybe PadTemplate)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe PadTemplate) -> m (Maybe PadTemplate))
-> IO (Maybe PadTemplate) -> m (Maybe PadTemplate)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr PadTemplate -> PadTemplate)
-> IO (Maybe PadTemplate)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"template" ManagedPtr PadTemplate -> PadTemplate
Gst.PadTemplate.PadTemplate

-- | Set the value of the “@template@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' pad [ #template 'Data.GI.Base.Attributes.:=' value ]
-- @
setPadTemplate :: (MonadIO m, IsPad o, Gst.PadTemplate.IsPadTemplate a) => o -> a -> m ()
setPadTemplate :: o -> a -> m ()
setPadTemplate o
obj a
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 -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"template" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@template@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPadTemplate :: (IsPad o, MIO.MonadIO m, Gst.PadTemplate.IsPadTemplate a) => a -> m (GValueConstruct o)
constructPadTemplate :: a -> m (GValueConstruct o)
constructPadTemplate a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"template" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@template@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #template
-- @
clearPadTemplate :: (MonadIO m, IsPad o) => o -> m ()
clearPadTemplate :: o -> m ()
clearPadTemplate o
obj = 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 -> Maybe PadTemplate -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"template" (Maybe PadTemplate
forall a. Maybe a
Nothing :: Maybe Gst.PadTemplate.PadTemplate)

#if defined(ENABLE_OVERLOADING)
data PadTemplatePropertyInfo
instance AttrInfo PadTemplatePropertyInfo where
    type AttrAllowedOps PadTemplatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PadTemplatePropertyInfo = IsPad
    type AttrSetTypeConstraint PadTemplatePropertyInfo = Gst.PadTemplate.IsPadTemplate
    type AttrTransferTypeConstraint PadTemplatePropertyInfo = Gst.PadTemplate.IsPadTemplate
    type AttrTransferType PadTemplatePropertyInfo = Gst.PadTemplate.PadTemplate
    type AttrGetType PadTemplatePropertyInfo = (Maybe Gst.PadTemplate.PadTemplate)
    type AttrLabel PadTemplatePropertyInfo = "template"
    type AttrOrigin PadTemplatePropertyInfo = Pad
    attrGet = getPadTemplate
    attrSet = setPadTemplate
    attrTransfer _ v = do
        unsafeCastTo Gst.PadTemplate.PadTemplate v
    attrConstruct = constructPadTemplate
    attrClear = clearPadTemplate
#endif

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

#if defined(ENABLE_OVERLOADING)
padCaps :: AttrLabelProxy "caps"
padCaps = AttrLabelProxy

padDirection :: AttrLabelProxy "direction"
padDirection = AttrLabelProxy

padOffset :: AttrLabelProxy "offset"
padOffset = AttrLabelProxy

padTemplate :: AttrLabelProxy "template"
padTemplate = AttrLabelProxy

#endif

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

#endif

-- method Pad::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the new pad."
--                 , 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 "the #GstPadDirection of the 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_pad_new" gst_pad_new :: 
    CString ->                              -- name : TBasicType TUTF8
    CUInt ->                                -- direction : TInterface (Name {namespace = "Gst", name = "PadDirection"})
    IO (Ptr Pad)

-- | Creates a new pad with the given name in the given direction.
-- If name is 'P.Nothing', a guaranteed unique name (across all pads)
-- will be assigned.
-- This function makes a copy of the name so you can safely free the name.
padNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@name@/: the name of the new pad.
    -> Gst.Enums.PadDirection
    -- ^ /@direction@/: the t'GI.Gst.Enums.PadDirection' of the pad.
    -> m (Maybe Pad)
    -- ^ __Returns:__ a new t'GI.Gst.Objects.Pad.Pad'.
    -- 
    -- MT safe.
padNew :: Maybe Text -> PadDirection -> m (Maybe Pad)
padNew Maybe Text
name 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 CChar
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just 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'
    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 CChar -> CUInt -> IO (Ptr Pad)
gst_pad_new Ptr CChar
maybeName 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
$ \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
newObject ManagedPtr Pad -> Pad
Pad) Ptr Pad
result'
        Pad -> IO Pad
forall (m :: * -> *) a. Monad m => a -> m a
return Pad
result''
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeName
    Maybe Pad -> IO (Maybe Pad)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pad
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Pad::new_from_static_template
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "templ"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "StaticPadTemplate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstStaticPadTemplate to use"
--                 , 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 name of the 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_pad_new_from_static_template" gst_pad_new_from_static_template :: 
    Ptr Gst.StaticPadTemplate.StaticPadTemplate -> -- templ : TInterface (Name {namespace = "Gst", name = "StaticPadTemplate"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Pad)

-- | Creates a new pad with the given name from the given static template.
-- If name is 'P.Nothing', a guaranteed unique name (across all pads)
-- will be assigned.
-- This function makes a copy of the name so you can safely free the name.
padNewFromStaticTemplate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.StaticPadTemplate.StaticPadTemplate
    -- ^ /@templ@/: the t'GI.Gst.Structs.StaticPadTemplate.StaticPadTemplate' to use
    -> T.Text
    -- ^ /@name@/: the name of the pad
    -> m (Maybe Pad)
    -- ^ __Returns:__ a new t'GI.Gst.Objects.Pad.Pad'.
padNewFromStaticTemplate :: StaticPadTemplate -> Text -> m (Maybe Pad)
padNewFromStaticTemplate StaticPadTemplate
templ Text
name = 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 StaticPadTemplate
templ' <- StaticPadTemplate -> IO (Ptr StaticPadTemplate)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr StaticPadTemplate
templ
    Ptr CChar
name' <- Text -> IO (Ptr CChar)
textToCString Text
name
    Ptr Pad
result <- Ptr StaticPadTemplate -> Ptr CChar -> IO (Ptr Pad)
gst_pad_new_from_static_template Ptr StaticPadTemplate
templ' Ptr CChar
name'
    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
$ \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
newObject ManagedPtr Pad -> Pad
Pad) Ptr Pad
result'
        Pad -> IO Pad
forall (m :: * -> *) a. Monad m => a -> m a
return Pad
result''
    StaticPadTemplate -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr StaticPadTemplate
templ
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
name'
    Maybe Pad -> IO (Maybe Pad)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pad
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Pad::new_from_template
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "templ"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadTemplate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the pad template to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the 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_pad_new_from_template" gst_pad_new_from_template :: 
    Ptr Gst.PadTemplate.PadTemplate ->      -- templ : TInterface (Name {namespace = "Gst", name = "PadTemplate"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Pad)

-- | Creates a new pad with the given name from the given template.
-- If name is 'P.Nothing', a guaranteed unique name (across all pads)
-- will be assigned.
-- This function makes a copy of the name so you can safely free the name.
padNewFromTemplate ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.PadTemplate.IsPadTemplate a) =>
    a
    -- ^ /@templ@/: the pad template to use
    -> Maybe (T.Text)
    -- ^ /@name@/: the name of the pad
    -> m (Maybe Pad)
    -- ^ __Returns:__ a new t'GI.Gst.Objects.Pad.Pad'.
padNewFromTemplate :: a -> Maybe Text -> m (Maybe Pad)
padNewFromTemplate a
templ Maybe Text
name = 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 PadTemplate
templ' <- a -> IO (Ptr PadTemplate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
templ
    Ptr CChar
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just 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 Pad
result <- Ptr PadTemplate -> Ptr CChar -> IO (Ptr Pad)
gst_pad_new_from_template Ptr PadTemplate
templ' Ptr CChar
maybeName
    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
$ \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
newObject ManagedPtr Pad -> 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
templ
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeName
    Maybe Pad -> IO (Maybe Pad)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pad
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Pad::activate_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to activate or deactivate."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the requested activation mode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "active"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether or not the pad should be active."
--                 , 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_pad_activate_mode" gst_pad_activate_mode :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gst", name = "PadMode"})
    CInt ->                                 -- active : TBasicType TBoolean
    IO CInt

-- | Activates or deactivates the given pad in /@mode@/ via dispatching to the
-- pad\'s activatemodefunc. For use from within pad activation functions only.
-- 
-- If you don\'t know what this is, you probably don\'t want to call it.
padActivateMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to activate or deactivate.
    -> Gst.Enums.PadMode
    -- ^ /@mode@/: the requested activation mode
    -> Bool
    -- ^ /@active@/: whether or not the pad should be active.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the operation was successful.
    -- 
    -- MT safe.
padActivateMode :: a -> PadMode -> Bool -> m Bool
padActivateMode a
pad PadMode
mode Bool
active = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PadMode -> Int) -> PadMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PadMode -> Int
forall a. Enum a => a -> Int
fromEnum) PadMode
mode
    let active' :: CInt
active' = (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
active
    CInt
result <- Ptr Pad -> CUInt -> CInt -> IO CInt
gst_pad_activate_mode Ptr Pad
pad' CUInt
mode' CInt
active'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadActivateModeMethodInfo
instance (signature ~ (Gst.Enums.PadMode -> Bool -> m Bool), MonadIO m, IsPad a) => O.MethodInfo PadActivateModeMethodInfo a signature where
    overloadedMethod = padActivateMode

#endif

-- method Pad::add_probe
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to add the probe to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mask"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadProbeType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the probe mask" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadProbeCallback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "#GstPadProbeCallback that will be called with notifications of\n          the pad state"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 3
--           , argDestroy = 4
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy_data"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GDestroyNotify for user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TULong)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_add_probe" gst_pad_add_probe :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    CUInt ->                                -- mask : TInterface (Name {namespace = "Gst", name = "PadProbeType"})
    FunPtr Gst.Callbacks.C_PadProbeCallback -> -- callback : TInterface (Name {namespace = "Gst", name = "PadProbeCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy_data : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO CULong

-- | Be notified of different states of pads. The provided callback is called for
-- every state that matches /@mask@/.
-- 
-- Probes are called in groups: First GST_PAD_PROBE_TYPE_BLOCK probes are
-- called, then others, then finally GST_PAD_PROBE_TYPE_IDLE. The only
-- exception here are GST_PAD_PROBE_TYPE_IDLE probes that are called
-- immediately if the pad is already idle while calling 'GI.Gst.Objects.Pad.padAddProbe'.
-- In each of the groups, probes are called in the order in which they were
-- added.
padAddProbe ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to add the probe to
    -> [Gst.Flags.PadProbeType]
    -- ^ /@mask@/: the probe mask
    -> Gst.Callbacks.PadProbeCallback
    -- ^ /@callback@/: t'GI.Gst.Callbacks.PadProbeCallback' that will be called with notifications of
    --           the pad state
    -> m CULong
    -- ^ __Returns:__ an id or 0 if no probe is pending. The id can be used to remove the
    -- probe with 'GI.Gst.Objects.Pad.padRemoveProbe'. When using GST_PAD_PROBE_TYPE_IDLE it can
    -- happen that the probe can be run immediately and if the probe returns
    -- GST_PAD_PROBE_REMOVE this functions returns 0.
    -- 
    -- MT safe.
padAddProbe :: a -> [PadProbeType] -> PadProbeCallback -> m SignalHandlerId
padAddProbe a
pad [PadProbeType]
mask PadProbeCallback
callback = 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
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    let mask' :: CUInt
mask' = [PadProbeType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [PadProbeType]
mask
    FunPtr C_PadProbeCallback
callback' <- C_PadProbeCallback -> IO (FunPtr C_PadProbeCallback)
Gst.Callbacks.mk_PadProbeCallback (Maybe (Ptr (FunPtr C_PadProbeCallback))
-> PadProbeCallback_WithClosures -> C_PadProbeCallback
Gst.Callbacks.wrap_PadProbeCallback Maybe (Ptr (FunPtr C_PadProbeCallback))
forall a. Maybe a
Nothing (PadProbeCallback -> PadProbeCallback_WithClosures
Gst.Callbacks.drop_closures_PadProbeCallback PadProbeCallback
callback))
    let userData :: Ptr ()
userData = FunPtr C_PadProbeCallback -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_PadProbeCallback
callback'
    let destroyData :: FunPtr (Ptr a -> IO ())
destroyData = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    SignalHandlerId
result <- Ptr Pad
-> CUInt
-> FunPtr C_PadProbeCallback
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO SignalHandlerId
gst_pad_add_probe Ptr Pad
pad' CUInt
mask' FunPtr C_PadProbeCallback
callback' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroyData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    SignalHandlerId -> IO SignalHandlerId
forall (m :: * -> *) a. Monad m => a -> m a
return SignalHandlerId
result

#if defined(ENABLE_OVERLOADING)
data PadAddProbeMethodInfo
instance (signature ~ ([Gst.Flags.PadProbeType] -> Gst.Callbacks.PadProbeCallback -> m CULong), MonadIO m, IsPad a) => O.MethodInfo PadAddProbeMethodInfo a signature where
    overloadedMethod = padAddProbe

#endif

-- method Pad::can_link
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "srcpad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source #GstPad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sinkpad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the sink #GstPad." , 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_pad_can_link" gst_pad_can_link :: 
    Ptr Pad ->                              -- srcpad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Pad ->                              -- sinkpad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Checks if the source pad and the sink pad are compatible so they can be
-- linked.
padCanLink ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a, IsPad b) =>
    a
    -- ^ /@srcpad@/: the source t'GI.Gst.Objects.Pad.Pad'.
    -> b
    -- ^ /@sinkpad@/: the sink t'GI.Gst.Objects.Pad.Pad'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pads can be linked.
padCanLink :: a -> b -> m Bool
padCanLink a
srcpad b
sinkpad = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
srcpad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
srcpad
    Ptr Pad
sinkpad' <- b -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
sinkpad
    CInt
result <- Ptr Pad -> Ptr Pad -> IO CInt
gst_pad_can_link Ptr Pad
srcpad' Ptr Pad
sinkpad'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
srcpad
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
sinkpad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadCanLinkMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsPad a, IsPad b) => O.MethodInfo PadCanLinkMethodInfo a signature where
    overloadedMethod = padCanLink

#endif

-- method Pad::chain
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a sink #GstPad, returns GST_FLOW_ERROR if not."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GstBuffer to send, return GST_FLOW_ERROR\n    if not."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "FlowReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_chain" gst_pad_chain :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO CInt

-- | Chain a buffer to /@pad@/.
-- 
-- The function returns @/GST_FLOW_FLUSHING/@ if the pad was flushing.
-- 
-- If the buffer type is not acceptable for /@pad@/ (as negotiated with a
-- preceding GST_EVENT_CAPS event), this function returns
-- @/GST_FLOW_NOT_NEGOTIATED/@.
-- 
-- The function proceeds calling the chain function installed on /@pad@/ (see
-- @/gst_pad_set_chain_function()/@) and the return value of that function is
-- returned to the caller. @/GST_FLOW_NOT_SUPPORTED/@ is returned if /@pad@/ has no
-- chain function.
-- 
-- In all cases, success or failure, the caller loses its reference to /@buffer@/
-- after calling this function.
padChain ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a sink t'GI.Gst.Objects.Pad.Pad', returns GST_FLOW_ERROR if not.
    -> Gst.Buffer.Buffer
    -- ^ /@buffer@/: the t'GI.Gst.Structs.Buffer.Buffer' to send, return GST_FLOW_ERROR
    --     if not.
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn' from the pad.
    -- 
    -- MT safe.
padChain :: a -> Buffer -> m FlowReturn
padChain a
pad Buffer
buffer = IO FlowReturn -> m FlowReturn
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlowReturn -> m FlowReturn) -> IO FlowReturn -> m FlowReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Buffer
buffer
    CInt
result <- Ptr Pad -> Ptr Buffer -> IO CInt
gst_pad_chain Ptr Pad
pad' Ptr Buffer
buffer'
    let result' :: FlowReturn
result' = (Int -> FlowReturn
forall a. Enum a => Int -> a
toEnum (Int -> FlowReturn) -> (CInt -> Int) -> CInt -> FlowReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    FlowReturn -> IO FlowReturn
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

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

#endif

-- method Pad::chain_list
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a sink #GstPad, returns GST_FLOW_ERROR if not."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GstBufferList to send, return GST_FLOW_ERROR\n    if not."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "FlowReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_chain_list" gst_pad_chain_list :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.BufferList.BufferList ->        -- list : TInterface (Name {namespace = "Gst", name = "BufferList"})
    IO CInt

-- | Chain a bufferlist to /@pad@/.
-- 
-- The function returns @/GST_FLOW_FLUSHING/@ if the pad was flushing.
-- 
-- If /@pad@/ was not negotiated properly with a CAPS event, this function
-- returns @/GST_FLOW_NOT_NEGOTIATED/@.
-- 
-- The function proceeds calling the chainlist function installed on /@pad@/ (see
-- @/gst_pad_set_chain_list_function()/@) and the return value of that function is
-- returned to the caller. @/GST_FLOW_NOT_SUPPORTED/@ is returned if /@pad@/ has no
-- chainlist function.
-- 
-- In all cases, success or failure, the caller loses its reference to /@list@/
-- after calling this function.
-- 
-- MT safe.
padChainList ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a sink t'GI.Gst.Objects.Pad.Pad', returns GST_FLOW_ERROR if not.
    -> Gst.BufferList.BufferList
    -- ^ /@list@/: the t'GI.Gst.Structs.BufferList.BufferList' to send, return GST_FLOW_ERROR
    --     if not.
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn' from the pad.
padChainList :: a -> BufferList -> m FlowReturn
padChainList a
pad BufferList
list = IO FlowReturn -> m FlowReturn
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlowReturn -> m FlowReturn) -> IO FlowReturn -> m FlowReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr BufferList
list' <- BufferList -> IO (Ptr BufferList)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed BufferList
list
    CInt
result <- Ptr Pad -> Ptr BufferList -> IO CInt
gst_pad_chain_list Ptr Pad
pad' Ptr BufferList
list'
    let result' :: FlowReturn
result' = (Int -> FlowReturn
forall a. Enum a => Int -> a
toEnum (Int -> FlowReturn) -> (CInt -> Int) -> CInt -> FlowReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    BufferList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BufferList
list
    FlowReturn -> IO FlowReturn
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data PadChainListMethodInfo
instance (signature ~ (Gst.BufferList.BufferList -> m Gst.Enums.FlowReturn), MonadIO m, IsPad a) => O.MethodInfo PadChainListMethodInfo a signature where
    overloadedMethod = padChainList

#endif

-- method Pad::check_reconfigure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to check"
--                 , 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_pad_check_reconfigure" gst_pad_check_reconfigure :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Check and clear the @/GST_PAD_FLAG_NEED_RECONFIGURE/@ flag on /@pad@/ and return 'P.True'
-- if the flag was set.
padCheckReconfigure ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' is the GST_PAD_FLAG_NEED_RECONFIGURE flag was set on /@pad@/.
padCheckReconfigure :: a -> m Bool
padCheckReconfigure a
pad = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CInt
result <- Ptr Pad -> IO CInt
gst_pad_check_reconfigure Ptr Pad
pad'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadCheckReconfigureMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPad a) => O.MethodInfo PadCheckReconfigureMethodInfo a signature where
    overloadedMethod = padCheckReconfigure

#endif

-- method Pad::create_stream_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A source #GstPad" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Parent #GstElement of @pad"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stream_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The stream-id" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_create_stream_id" gst_pad_create_stream_id :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Element.Element ->              -- parent : TInterface (Name {namespace = "Gst", name = "Element"})
    CString ->                              -- stream_id : TBasicType TUTF8
    IO CString

-- | Creates a stream-id for the source t'GI.Gst.Objects.Pad.Pad' /@pad@/ by combining the
-- upstream information with the optional /@streamId@/ of the stream
-- of /@pad@/. /@pad@/ must have a parent t'GI.Gst.Objects.Element.Element' and which must have zero
-- or one sinkpad. /@streamId@/ can only be 'P.Nothing' if the parent element
-- of /@pad@/ has only a single source pad.
-- 
-- This function generates an unique stream-id by getting the upstream
-- stream-start event stream ID and appending /@streamId@/ to it. If the
-- element has no sinkpad it will generate an upstream stream-id by
-- doing an URI query on the element and in the worst case just uses
-- a random number. Source elements that don\'t implement the URI
-- handler interface should ideally generate a unique, deterministic
-- stream-id manually instead.
-- 
-- Since stream IDs are sorted alphabetically, any numbers in the
-- stream ID should be printed with a fixed number of characters,
-- preceded by 0\'s, such as by using the format %03u instead of %u.
padCreateStreamId ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a, Gst.Element.IsElement b) =>
    a
    -- ^ /@pad@/: A source t'GI.Gst.Objects.Pad.Pad'
    -> b
    -- ^ /@parent@/: Parent t'GI.Gst.Objects.Element.Element' of /@pad@/
    -> Maybe (T.Text)
    -- ^ /@streamId@/: The stream-id
    -> m T.Text
    -- ^ __Returns:__ A stream-id for /@pad@/. 'GI.GLib.Functions.free' after usage.
padCreateStreamId :: a -> b -> Maybe Text -> m Text
padCreateStreamId a
pad b
parent Maybe Text
streamId = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Element
parent' <- b -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
parent
    Ptr CChar
maybeStreamId <- case Maybe Text
streamId of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jStreamId -> do
            Ptr CChar
jStreamId' <- Text -> IO (Ptr CChar)
textToCString Text
jStreamId
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jStreamId'
    Ptr CChar
result <- Ptr Pad -> Ptr Element -> Ptr CChar -> IO (Ptr CChar)
gst_pad_create_stream_id Ptr Pad
pad' Ptr Element
parent' Ptr CChar
maybeStreamId
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"padCreateStreamId" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
parent
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeStreamId
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PadCreateStreamIdMethodInfo
instance (signature ~ (b -> Maybe (T.Text) -> m T.Text), MonadIO m, IsPad a, Gst.Element.IsElement b) => O.MethodInfo PadCreateStreamIdMethodInfo a signature where
    overloadedMethod = padCreateStreamId

#endif

-- method Pad::event_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstPad to call the default event handler on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent of @pad or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gst" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstEvent to handle."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_event_default" gst_pad_event_default :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Object.Object ->                -- parent : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.Event.Event ->                  -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    IO CInt

-- | Invokes the default event handler for the given pad.
-- 
-- The EOS event will pause the task associated with /@pad@/ before it is forwarded
-- to all internally linked pads,
-- 
-- The event is sent to all pads internally linked to /@pad@/. This function
-- takes ownership of /@event@/.
padEventDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a, Gst.Object.IsObject b) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' to call the default event handler on.
    -> Maybe (b)
    -- ^ /@parent@/: the parent of /@pad@/ or 'P.Nothing'
    -> Gst.Event.Event
    -- ^ /@event@/: the t'GI.Gst.Structs.Event.Event' to handle.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the event was sent successfully.
padEventDefault :: a -> Maybe b -> Event -> m Bool
padEventDefault a
pad Maybe b
parent Event
event = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Object
maybeParent <- case Maybe b
parent of
        Maybe b
Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just b
jParent -> do
            Ptr Object
jParent' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jParent'
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Event
event
    CInt
result <- Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt
gst_pad_event_default Ptr Pad
pad' Ptr Object
maybeParent Ptr Event
event'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
parent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadEventDefaultMethodInfo
instance (signature ~ (Maybe (b) -> Gst.Event.Event -> m Bool), MonadIO m, IsPad a, Gst.Object.IsObject b) => O.MethodInfo PadEventDefaultMethodInfo a signature where
    overloadedMethod = padEventDefault

#endif

-- method Pad::forward
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "forward"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadForwardFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPadForwardFunction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to @forward"
--                 , 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_pad_forward" gst_pad_forward :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    FunPtr Gst.Callbacks.C_PadForwardFunction -> -- forward : TInterface (Name {namespace = "Gst", name = "PadForwardFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CInt

-- | Calls /@forward@/ for all internally linked pads of /@pad@/. This function deals with
-- dynamically changing internal pads and will make sure that the /@forward@/
-- function is only called once for each pad.
-- 
-- When /@forward@/ returns 'P.True', no further pads will be processed.
padForward ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad'
    -> Gst.Callbacks.PadForwardFunction
    -- ^ /@forward@/: a t'GI.Gst.Callbacks.PadForwardFunction'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if one of the dispatcher functions returned 'P.True'.
padForward :: a -> PadForwardFunction -> m Bool
padForward a
pad PadForwardFunction
forward = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    FunPtr C_PadForwardFunction
forward' <- C_PadForwardFunction -> IO (FunPtr C_PadForwardFunction)
Gst.Callbacks.mk_PadForwardFunction (Maybe (Ptr (FunPtr C_PadForwardFunction))
-> PadForwardFunction_WithClosures -> C_PadForwardFunction
Gst.Callbacks.wrap_PadForwardFunction Maybe (Ptr (FunPtr C_PadForwardFunction))
forall a. Maybe a
Nothing (PadForwardFunction -> PadForwardFunction_WithClosures
Gst.Callbacks.drop_closures_PadForwardFunction PadForwardFunction
forward))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CInt
result <- Ptr Pad -> FunPtr C_PadForwardFunction -> Ptr () -> IO CInt
gst_pad_forward Ptr Pad
pad' FunPtr C_PadForwardFunction
forward' Ptr ()
forall a. Ptr a
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_PadForwardFunction -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_PadForwardFunction
forward'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadForwardMethodInfo
instance (signature ~ (Gst.Callbacks.PadForwardFunction -> m Bool), MonadIO m, IsPad a) => O.MethodInfo PadForwardMethodInfo a signature where
    overloadedMethod = padForward

#endif

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

foreign import ccall "gst_pad_get_allowed_caps" gst_pad_get_allowed_caps :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO (Ptr Gst.Caps.Caps)

-- | Gets the capabilities of the allowed media types that can flow through
-- /@pad@/ and its peer.
-- 
-- The allowed capabilities is calculated as the intersection of the results of
-- calling 'GI.Gst.Objects.Pad.padQueryCaps' on /@pad@/ and its peer. The caller owns a reference
-- on the resulting caps.
padGetAllowedCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad'.
    -> m (Maybe Gst.Caps.Caps)
    -- ^ __Returns:__ the allowed t'GI.Gst.Structs.Caps.Caps' of the
    --     pad link. Unref the caps when you no longer need it. This
    --     function returns 'P.Nothing' when /@pad@/ has no peer.
    -- 
    -- MT safe.
padGetAllowedCaps :: a -> m (Maybe Caps)
padGetAllowedCaps a
pad = IO (Maybe Caps) -> m (Maybe Caps)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Caps) -> m (Maybe Caps))
-> IO (Maybe Caps) -> m (Maybe Caps)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Caps
result <- Ptr Pad -> IO (Ptr Caps)
gst_pad_get_allowed_caps Ptr Pad
pad'
    Maybe Caps
maybeResult <- Ptr Caps -> (Ptr Caps -> IO Caps) -> IO (Maybe Caps)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Caps
result ((Ptr Caps -> IO Caps) -> IO (Maybe Caps))
-> (Ptr Caps -> IO Caps) -> IO (Maybe Caps)
forall a b. (a -> b) -> a -> b
$ \Ptr Caps
result' -> do
        Caps
result'' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
result'
        Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Maybe Caps -> IO (Maybe Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Caps
maybeResult

#if defined(ENABLE_OVERLOADING)
data PadGetAllowedCapsMethodInfo
instance (signature ~ (m (Maybe Gst.Caps.Caps)), MonadIO m, IsPad a) => O.MethodInfo PadGetAllowedCapsMethodInfo a signature where
    overloadedMethod = padGetAllowedCaps

#endif

-- method Pad::get_current_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a  #GstPad to get the current capabilities of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Caps" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_get_current_caps" gst_pad_get_current_caps :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO (Ptr Gst.Caps.Caps)

-- | Gets the capabilities currently configured on /@pad@/ with the last
-- @/GST_EVENT_CAPS/@ event.
padGetCurrentCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a  t'GI.Gst.Objects.Pad.Pad' to get the current capabilities of.
    -> m (Maybe Gst.Caps.Caps)
    -- ^ __Returns:__ the current caps of the pad with
    -- incremented ref-count or 'P.Nothing' when pad has no caps. Unref after usage.
padGetCurrentCaps :: a -> m (Maybe Caps)
padGetCurrentCaps a
pad = IO (Maybe Caps) -> m (Maybe Caps)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Caps) -> m (Maybe Caps))
-> IO (Maybe Caps) -> m (Maybe Caps)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Caps
result <- Ptr Pad -> IO (Ptr Caps)
gst_pad_get_current_caps Ptr Pad
pad'
    Maybe Caps
maybeResult <- Ptr Caps -> (Ptr Caps -> IO Caps) -> IO (Maybe Caps)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Caps
result ((Ptr Caps -> IO Caps) -> IO (Maybe Caps))
-> (Ptr Caps -> IO Caps) -> IO (Maybe Caps)
forall a b. (a -> b) -> a -> b
$ \Ptr Caps
result' -> do
        Caps
result'' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
result'
        Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Maybe Caps -> IO (Maybe Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Caps
maybeResult

#if defined(ENABLE_OVERLOADING)
data PadGetCurrentCapsMethodInfo
instance (signature ~ (m (Maybe Gst.Caps.Caps)), MonadIO m, IsPad a) => O.MethodInfo PadGetCurrentCapsMethodInfo a signature where
    overloadedMethod = padGetCurrentCaps

#endif

-- method Pad::get_direction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad to get the direction of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gst" , name = "PadDirection" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_get_direction" gst_pad_get_direction :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CUInt

-- | Gets the direction of the pad. The direction of the pad is
-- decided at construction time so this function does not take
-- the LOCK.
padGetDirection ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' to get the direction of.
    -> m Gst.Enums.PadDirection
    -- ^ __Returns:__ the t'GI.Gst.Enums.PadDirection' of the pad.
    -- 
    -- MT safe.
padGetDirection :: a -> m PadDirection
padGetDirection a
pad = IO PadDirection -> m PadDirection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PadDirection -> m PadDirection)
-> IO PadDirection -> m PadDirection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CUInt
result <- Ptr Pad -> IO CUInt
gst_pad_get_direction Ptr Pad
pad'
    let result' :: PadDirection
result' = (Int -> PadDirection
forall a. Enum a => Int -> a
toEnum (Int -> PadDirection) -> (CUInt -> Int) -> CUInt -> PadDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    PadDirection -> IO PadDirection
forall (m :: * -> *) a. Monad m => a -> m a
return PadDirection
result'

#if defined(ENABLE_OVERLOADING)
data PadGetDirectionMethodInfo
instance (signature ~ (m Gst.Enums.PadDirection), MonadIO m, IsPad a) => O.MethodInfo PadGetDirectionMethodInfo a signature where
    overloadedMethod = padGetDirection

#endif

-- method Pad::get_element_private
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to get the private data of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_get_element_private" gst_pad_get_element_private :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO (Ptr ())

-- | Gets the private data of a pad.
-- No locking is performed in this function.
padGetElementPrivate ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to get the private data of.
    -> m (Ptr ())
    -- ^ __Returns:__ a @/gpointer/@ to the private data.
padGetElementPrivate :: a -> m (Ptr ())
padGetElementPrivate a
pad = IO (Ptr ()) -> m (Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr ()
result <- Ptr Pad -> IO (Ptr ())
gst_pad_get_element_private Ptr Pad
pad'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data PadGetElementPrivateMethodInfo
instance (signature ~ (m (Ptr ())), MonadIO m, IsPad a) => O.MethodInfo PadGetElementPrivateMethodInfo a signature where
    overloadedMethod = padGetElementPrivate

#endif

-- method Pad::get_last_flow_return
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "FlowReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_get_last_flow_return" gst_pad_get_last_flow_return :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Gets the t'GI.Gst.Enums.FlowReturn' return from the last data passed by this pad.
-- 
-- /Since: 1.4/
padGetLastFlowReturn ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad'
    -> m Gst.Enums.FlowReturn
padGetLastFlowReturn :: a -> m FlowReturn
padGetLastFlowReturn a
pad = IO FlowReturn -> m FlowReturn
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlowReturn -> m FlowReturn) -> IO FlowReturn -> m FlowReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CInt
result <- Ptr Pad -> IO CInt
gst_pad_get_last_flow_return Ptr Pad
pad'
    let result' :: FlowReturn
result' = (Int -> FlowReturn
forall a. Enum a => Int -> a
toEnum (Int -> FlowReturn) -> (CInt -> Int) -> CInt -> FlowReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    FlowReturn -> IO FlowReturn
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data PadGetLastFlowReturnMethodInfo
instance (signature ~ (m Gst.Enums.FlowReturn), MonadIO m, IsPad a) => O.MethodInfo PadGetLastFlowReturnMethodInfo a signature where
    overloadedMethod = padGetLastFlowReturn

#endif

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

foreign import ccall "gst_pad_get_offset" gst_pad_get_offset :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO Int64

-- | Get the offset applied to the running time of /@pad@/. /@pad@/ has to be a source
-- pad.
padGetOffset ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad'
    -> m Int64
    -- ^ __Returns:__ the offset.
padGetOffset :: a -> m Int64
padGetOffset a
pad = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Int64
result <- Ptr Pad -> IO Int64
gst_pad_get_offset Ptr Pad
pad'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data PadGetOffsetMethodInfo
instance (signature ~ (m Int64), MonadIO m, IsPad a) => O.MethodInfo PadGetOffsetMethodInfo a signature where
    overloadedMethod = padGetOffset

#endif

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

foreign import ccall "gst_pad_get_pad_template" gst_pad_get_pad_template :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO (Ptr Gst.PadTemplate.PadTemplate)

-- | Gets the template for /@pad@/.
padGetPadTemplate ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad'.
    -> m (Maybe Gst.PadTemplate.PadTemplate)
    -- ^ __Returns:__ the t'GI.Gst.Objects.PadTemplate.PadTemplate' from which
    --     this pad was instantiated, or 'P.Nothing' if this pad has no
    --     template. Unref after usage.
padGetPadTemplate :: a -> m (Maybe PadTemplate)
padGetPadTemplate a
pad = IO (Maybe PadTemplate) -> m (Maybe PadTemplate)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe PadTemplate) -> m (Maybe PadTemplate))
-> IO (Maybe PadTemplate) -> m (Maybe PadTemplate)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr PadTemplate
result <- Ptr Pad -> IO (Ptr PadTemplate)
gst_pad_get_pad_template Ptr Pad
pad'
    Maybe PadTemplate
maybeResult <- Ptr PadTemplate
-> (Ptr PadTemplate -> IO PadTemplate) -> IO (Maybe PadTemplate)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr PadTemplate
result ((Ptr PadTemplate -> IO PadTemplate) -> IO (Maybe PadTemplate))
-> (Ptr PadTemplate -> IO PadTemplate) -> IO (Maybe PadTemplate)
forall a b. (a -> b) -> a -> b
$ \Ptr PadTemplate
result' -> do
        PadTemplate
result'' <- ((ManagedPtr PadTemplate -> PadTemplate)
-> Ptr PadTemplate -> IO PadTemplate
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr PadTemplate -> PadTemplate
Gst.PadTemplate.PadTemplate) Ptr PadTemplate
result'
        PadTemplate -> IO PadTemplate
forall (m :: * -> *) a. Monad m => a -> m a
return PadTemplate
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Maybe PadTemplate -> IO (Maybe PadTemplate)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PadTemplate
maybeResult

#if defined(ENABLE_OVERLOADING)
data PadGetPadTemplateMethodInfo
instance (signature ~ (m (Maybe Gst.PadTemplate.PadTemplate)), MonadIO m, IsPad a) => O.MethodInfo PadGetPadTemplateMethodInfo a signature where
    overloadedMethod = padGetPadTemplate

#endif

-- method Pad::get_pad_template_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstPad to get the template capabilities from."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Caps" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_get_pad_template_caps" gst_pad_get_pad_template_caps :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO (Ptr Gst.Caps.Caps)

-- | Gets the capabilities for /@pad@/\'s template.
padGetPadTemplateCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' to get the template capabilities from.
    -> m Gst.Caps.Caps
    -- ^ __Returns:__ the t'GI.Gst.Structs.Caps.Caps' of this pad template.
    -- Unref after usage.
padGetPadTemplateCaps :: a -> m Caps
padGetPadTemplateCaps a
pad = IO Caps -> m Caps
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Caps -> m Caps) -> IO Caps -> m Caps
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Caps
result <- Ptr Pad -> IO (Ptr Caps)
gst_pad_get_pad_template_caps Ptr Pad
pad'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"padGetPadTemplateCaps" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data PadGetPadTemplateCapsMethodInfo
instance (signature ~ (m Gst.Caps.Caps), MonadIO m, IsPad a) => O.MethodInfo PadGetPadTemplateCapsMethodInfo a signature where
    overloadedMethod = padGetPadTemplateCaps

#endif

-- method Pad::get_parent_element
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pad" , 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_pad_get_parent_element" gst_pad_get_parent_element :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO (Ptr Gst.Element.Element)

-- | Gets the parent of /@pad@/, cast to a t'GI.Gst.Objects.Element.Element'. If a /@pad@/ has no parent or
-- its parent is not an element, return 'P.Nothing'.
padGetParentElement ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a pad
    -> m (Maybe Gst.Element.Element)
    -- ^ __Returns:__ the parent of the pad. The
    -- caller has a reference on the parent, so unref when you\'re finished
    -- with it.
    -- 
    -- MT safe.
padGetParentElement :: a -> m (Maybe Element)
padGetParentElement a
pad = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Element
result <- Ptr Pad -> IO (Ptr Element)
gst_pad_get_parent_element Ptr Pad
pad'
    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
$ \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
pad
    Maybe Element -> IO (Maybe Element)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Element
maybeResult

#if defined(ENABLE_OVERLOADING)
data PadGetParentElementMethodInfo
instance (signature ~ (m (Maybe Gst.Element.Element)), MonadIO m, IsPad a) => O.MethodInfo PadGetParentElementMethodInfo a signature where
    overloadedMethod = padGetParentElement

#endif

-- method Pad::get_peer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad to get the peer of."
--                 , 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_pad_get_peer" gst_pad_get_peer :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO (Ptr Pad)

-- | Gets the peer of /@pad@/. This function refs the peer pad so
-- you need to unref it after use.
padGetPeer ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' to get the peer of.
    -> m (Maybe Pad)
    -- ^ __Returns:__ the peer t'GI.Gst.Objects.Pad.Pad'. Unref after usage.
    -- 
    -- MT safe.
padGetPeer :: a -> m (Maybe Pad)
padGetPeer a
pad = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Pad
result <- Ptr Pad -> IO (Ptr Pad)
gst_pad_get_peer Ptr Pad
pad'
    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
$ \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
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
pad
    Maybe Pad -> IO (Maybe Pad)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pad
maybeResult

#if defined(ENABLE_OVERLOADING)
data PadGetPeerMethodInfo
instance (signature ~ (m (Maybe Pad)), MonadIO m, IsPad a) => O.MethodInfo PadGetPeerMethodInfo a signature where
    overloadedMethod = padGetPeer

#endif

-- method Pad::get_range
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a src #GstPad, returns #GST_FLOW_ERROR if not."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The start offset of the buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The length of the buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a pointer to hold the #GstBuffer,\n    returns #GST_FLOW_ERROR if %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "FlowReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_get_range" gst_pad_get_range :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Word64 ->                               -- offset : TBasicType TUInt64
    Word32 ->                               -- size : TBasicType TUInt
    Ptr (Ptr Gst.Buffer.Buffer) ->          -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO CInt

-- | When /@pad@/ is flushing this function returns @/GST_FLOW_FLUSHING/@
-- immediately and /@buffer@/ is 'P.Nothing'.
-- 
-- Calls the getrange function of /@pad@/, see t'GI.Gst.Callbacks.PadGetRangeFunction' for a
-- description of a getrange function. If /@pad@/ has no getrange function
-- installed (see @/gst_pad_set_getrange_function()/@) this function returns
-- @/GST_FLOW_NOT_SUPPORTED/@.
-- 
-- If /@buffer@/ points to a variable holding 'P.Nothing', a valid new t'GI.Gst.Structs.Buffer.Buffer' will be
-- placed in /@buffer@/ when this function returns @/GST_FLOW_OK/@. The new buffer
-- must be freed with @/gst_buffer_unref()/@ after usage.
-- 
-- When /@buffer@/ points to a variable that points to a valid t'GI.Gst.Structs.Buffer.Buffer', the
-- buffer will be filled with the result data when this function returns
-- @/GST_FLOW_OK/@. If the provided buffer is larger than /@size@/, only
-- /@size@/ bytes will be filled in the result buffer and its size will be updated
-- accordingly.
-- 
-- Note that less than /@size@/ bytes can be returned in /@buffer@/ when, for example,
-- an EOS condition is near or when /@buffer@/ is not large enough to hold /@size@/
-- bytes. The caller should check the result buffer size to get the result size.
-- 
-- When this function returns any other result value than @/GST_FLOW_OK/@, /@buffer@/
-- will be unchanged.
-- 
-- This is a lowlevel function. Usually 'GI.Gst.Objects.Pad.padPullRange' is used.
padGetRange ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a src t'GI.Gst.Objects.Pad.Pad', returns @/GST_FLOW_ERROR/@ if not.
    -> Word64
    -- ^ /@offset@/: The start offset of the buffer
    -> Word32
    -- ^ /@size@/: The length of the buffer
    -> m ((Gst.Enums.FlowReturn, Gst.Buffer.Buffer))
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn' from the pad.
    -- 
    -- MT safe.
padGetRange :: a -> Word64 -> Word32 -> m (FlowReturn, Buffer)
padGetRange a
pad Word64
offset Word32
size = IO (FlowReturn, Buffer) -> m (FlowReturn, Buffer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FlowReturn, Buffer) -> m (FlowReturn, Buffer))
-> IO (FlowReturn, Buffer) -> m (FlowReturn, Buffer)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr (Ptr Buffer)
buffer <- IO (Ptr (Ptr Buffer))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Buffer.Buffer))
    CInt
result <- Ptr Pad -> Word64 -> Word32 -> Ptr (Ptr Buffer) -> IO CInt
gst_pad_get_range Ptr Pad
pad' Word64
offset Word32
size Ptr (Ptr Buffer)
buffer
    let result' :: FlowReturn
result' = (Int -> FlowReturn
forall a. Enum a => Int -> a
toEnum (Int -> FlowReturn) -> (CInt -> Int) -> CInt -> FlowReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    Ptr Buffer
buffer' <- Ptr (Ptr Buffer) -> IO (Ptr Buffer)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Buffer)
buffer
    Buffer
buffer'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
buffer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Ptr (Ptr Buffer) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Buffer)
buffer
    (FlowReturn, Buffer) -> IO (FlowReturn, Buffer)
forall (m :: * -> *) a. Monad m => a -> m a
return (FlowReturn
result', Buffer
buffer'')

#if defined(ENABLE_OVERLOADING)
data PadGetRangeMethodInfo
instance (signature ~ (Word64 -> Word32 -> m ((Gst.Enums.FlowReturn, Gst.Buffer.Buffer))), MonadIO m, IsPad a) => O.MethodInfo PadGetRangeMethodInfo a signature where
    overloadedMethod = padGetRange

#endif

-- method Pad::get_sticky_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to get the event from."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event_type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "EventType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstEventType that should be retrieved."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the event"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Event" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_get_sticky_event" gst_pad_get_sticky_event :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    CUInt ->                                -- event_type : TInterface (Name {namespace = "Gst", name = "EventType"})
    Word32 ->                               -- idx : TBasicType TUInt
    IO (Ptr Gst.Event.Event)

-- | Returns a new reference of the sticky event of type /@eventType@/
-- from the event.
padGetStickyEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to get the event from.
    -> Gst.Enums.EventType
    -- ^ /@eventType@/: the t'GI.Gst.Enums.EventType' that should be retrieved.
    -> Word32
    -- ^ /@idx@/: the index of the event
    -> m (Maybe Gst.Event.Event)
    -- ^ __Returns:__ a t'GI.Gst.Structs.Event.Event' of type
    -- /@eventType@/ or 'P.Nothing' when no event of /@eventType@/ was on
    -- /@pad@/. Unref after usage.
padGetStickyEvent :: a -> EventType -> Word32 -> m (Maybe Event)
padGetStickyEvent a
pad EventType
eventType Word32
idx = IO (Maybe Event) -> m (Maybe Event)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Event) -> m (Maybe Event))
-> IO (Maybe Event) -> m (Maybe Event)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    let eventType' :: CUInt
eventType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (EventType -> Int) -> EventType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventType -> Int
forall a. Enum a => a -> Int
fromEnum) EventType
eventType
    Ptr Event
result <- Ptr Pad -> CUInt -> Word32 -> IO (Ptr Event)
gst_pad_get_sticky_event Ptr Pad
pad' CUInt
eventType' Word32
idx
    Maybe Event
maybeResult <- Ptr Event -> (Ptr Event -> IO Event) -> IO (Maybe Event)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Event
result ((Ptr Event -> IO Event) -> IO (Maybe Event))
-> (Ptr Event -> IO Event) -> IO (Maybe Event)
forall a b. (a -> b) -> a -> b
$ \Ptr Event
result' -> do
        Event
result'' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Gst.Event.Event) Ptr Event
result'
        Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Maybe Event -> IO (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Event
maybeResult

#if defined(ENABLE_OVERLOADING)
data PadGetStickyEventMethodInfo
instance (signature ~ (Gst.Enums.EventType -> Word32 -> m (Maybe Gst.Event.Event)), MonadIO m, IsPad a) => O.MethodInfo PadGetStickyEventMethodInfo a signature where
    overloadedMethod = padGetStickyEvent

#endif

-- method Pad::get_stream
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A source #GstPad" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Stream" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_get_stream" gst_pad_get_stream :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO (Ptr Gst.Stream.Stream)

-- | Returns the current t'GI.Gst.Objects.Stream.Stream' for the /@pad@/, or 'P.Nothing' if none has been
-- set yet, i.e. the pad has not received a stream-start event yet.
-- 
-- This is a convenience wrapper around 'GI.Gst.Objects.Pad.padGetStickyEvent' and
-- 'GI.Gst.Structs.Event.eventParseStream'.
-- 
-- /Since: 1.10/
padGetStream ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: A source t'GI.Gst.Objects.Pad.Pad'
    -> m (Maybe Gst.Stream.Stream)
    -- ^ __Returns:__ the current t'GI.Gst.Objects.Stream.Stream' for /@pad@/, or 'P.Nothing'.
    --     unref the returned stream when no longer needed.
padGetStream :: a -> m (Maybe Stream)
padGetStream a
pad = IO (Maybe Stream) -> m (Maybe Stream)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Stream) -> m (Maybe Stream))
-> IO (Maybe Stream) -> m (Maybe Stream)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Stream
result <- Ptr Pad -> IO (Ptr Stream)
gst_pad_get_stream Ptr Pad
pad'
    Maybe Stream
maybeResult <- Ptr Stream -> (Ptr Stream -> IO Stream) -> IO (Maybe Stream)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Stream
result ((Ptr Stream -> IO Stream) -> IO (Maybe Stream))
-> (Ptr Stream -> IO Stream) -> IO (Maybe Stream)
forall a b. (a -> b) -> a -> b
$ \Ptr Stream
result' -> do
        Stream
result'' <- ((ManagedPtr Stream -> Stream) -> Ptr Stream -> IO Stream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Stream -> Stream
Gst.Stream.Stream) Ptr Stream
result'
        Stream -> IO Stream
forall (m :: * -> *) a. Monad m => a -> m a
return Stream
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Maybe Stream -> IO (Maybe Stream)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Stream
maybeResult

#if defined(ENABLE_OVERLOADING)
data PadGetStreamMethodInfo
instance (signature ~ (m (Maybe Gst.Stream.Stream)), MonadIO m, IsPad a) => O.MethodInfo PadGetStreamMethodInfo a signature where
    overloadedMethod = padGetStream

#endif

-- method Pad::get_stream_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A source #GstPad" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_get_stream_id" gst_pad_get_stream_id :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CString

-- | Returns the current stream-id for the /@pad@/, or 'P.Nothing' if none has been
-- set yet, i.e. the pad has not received a stream-start event yet.
-- 
-- This is a convenience wrapper around 'GI.Gst.Objects.Pad.padGetStickyEvent' and
-- 'GI.Gst.Structs.Event.eventParseStreamStart'.
-- 
-- The returned stream-id string should be treated as an opaque string, its
-- contents should not be interpreted.
-- 
-- /Since: 1.2/
padGetStreamId ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: A source t'GI.Gst.Objects.Pad.Pad'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a newly-allocated copy of the stream-id for
    --     /@pad@/, or 'P.Nothing'.  'GI.GLib.Functions.free' the returned string when no longer
    --     needed.
padGetStreamId :: a -> m (Maybe Text)
padGetStreamId a
pad = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr CChar
result <- Ptr Pad -> IO (Ptr CChar)
gst_pad_get_stream_id Ptr Pad
pad'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data PadGetStreamIdMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsPad a) => O.MethodInfo PadGetStreamIdMethodInfo a signature where
    overloadedMethod = padGetStreamId

#endif

-- method Pad::get_task_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to get task state from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "TaskState" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_get_task_state" gst_pad_get_task_state :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CUInt

-- | Get /@pad@/ task state. If no task is currently
-- set, @/GST_TASK_STOPPED/@ is returned.
-- 
-- /Since: 1.12/
padGetTaskState ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to get task state from
    -> m Gst.Enums.TaskState
    -- ^ __Returns:__ The current state of /@pad@/\'s task.
padGetTaskState :: a -> m TaskState
padGetTaskState a
pad = IO TaskState -> m TaskState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TaskState -> m TaskState) -> IO TaskState -> m TaskState
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CUInt
result <- Ptr Pad -> IO CUInt
gst_pad_get_task_state Ptr Pad
pad'
    let result' :: TaskState
result' = (Int -> TaskState
forall a. Enum a => Int -> a
toEnum (Int -> TaskState) -> (CUInt -> Int) -> CUInt -> TaskState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    TaskState -> IO TaskState
forall (m :: * -> *) a. Monad m => a -> m a
return TaskState
result'

#if defined(ENABLE_OVERLOADING)
data PadGetTaskStateMethodInfo
instance (signature ~ (m Gst.Enums.TaskState), MonadIO m, IsPad a) => O.MethodInfo PadGetTaskStateMethodInfo a signature where
    overloadedMethod = padGetTaskState

#endif

-- method Pad::has_current_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a  #GstPad to check"
--                 , 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_pad_has_current_caps" gst_pad_has_current_caps :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Check if /@pad@/ has caps set on it with a @/GST_EVENT_CAPS/@ event.
padHasCurrentCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a  t'GI.Gst.Objects.Pad.Pad' to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' when /@pad@/ has caps associated with it.
padHasCurrentCaps :: a -> m Bool
padHasCurrentCaps a
pad = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CInt
result <- Ptr Pad -> IO CInt
gst_pad_has_current_caps Ptr Pad
pad'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadHasCurrentCapsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPad a) => O.MethodInfo PadHasCurrentCapsMethodInfo a signature where
    overloadedMethod = padHasCurrentCaps

#endif

-- method Pad::is_active
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to query"
--                 , 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_pad_is_active" gst_pad_is_active :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Query if a pad is active
padIsActive ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to query
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pad is active.
    -- 
    -- MT safe.
padIsActive :: a -> m Bool
padIsActive a
pad = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CInt
result <- Ptr Pad -> IO CInt
gst_pad_is_active Ptr Pad
pad'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadIsActiveMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPad a) => O.MethodInfo PadIsActiveMethodInfo a signature where
    overloadedMethod = padIsActive

#endif

-- method Pad::is_blocked
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to query"
--                 , 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_pad_is_blocked" gst_pad_is_blocked :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Checks if the pad is blocked or not. This function returns the
-- last requested state of the pad. It is not certain that the pad
-- is actually blocking at this point (see 'GI.Gst.Objects.Pad.padIsBlocking').
padIsBlocked ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to query
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pad is blocked.
    -- 
    -- MT safe.
padIsBlocked :: a -> m Bool
padIsBlocked a
pad = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CInt
result <- Ptr Pad -> IO CInt
gst_pad_is_blocked Ptr Pad
pad'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadIsBlockedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPad a) => O.MethodInfo PadIsBlockedMethodInfo a signature where
    overloadedMethod = padIsBlocked

#endif

-- method Pad::is_blocking
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to query"
--                 , 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_pad_is_blocking" gst_pad_is_blocking :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Checks if the pad is blocking or not. This is a guaranteed state
-- of whether the pad is actually blocking on a t'GI.Gst.Structs.Buffer.Buffer' or a t'GI.Gst.Structs.Event.Event'.
padIsBlocking ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to query
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pad is blocking.
    -- 
    -- MT safe.
padIsBlocking :: a -> m Bool
padIsBlocking a
pad = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CInt
result <- Ptr Pad -> IO CInt
gst_pad_is_blocking Ptr Pad
pad'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadIsBlockingMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPad a) => O.MethodInfo PadIsBlockingMethodInfo a signature where
    overloadedMethod = padIsBlocking

#endif

-- method Pad::is_linked
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pad to check" , 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_pad_is_linked" gst_pad_is_linked :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Checks if a /@pad@/ is linked to another pad or not.
padIsLinked ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: pad to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pad is linked, 'P.False' otherwise.
    -- 
    -- MT safe.
padIsLinked :: a -> m Bool
padIsLinked a
pad = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CInt
result <- Ptr Pad -> IO CInt
gst_pad_is_linked Ptr Pad
pad'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadIsLinkedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPad a) => O.MethodInfo PadIsLinkedMethodInfo a signature where
    overloadedMethod = padIsLinked

#endif

-- method Pad::iterate_internal_links
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the GstPad to get the internal links of."
--                 , 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_pad_iterate_internal_links" gst_pad_iterate_internal_links :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO (Ptr Gst.Iterator.Iterator)

-- | Gets an iterator for the pads to which the given pad is linked to inside
-- of the parent element.
-- 
-- Each t'GI.Gst.Objects.Pad.Pad' element yielded by the iterator will have its refcount increased,
-- so unref after use.
-- 
-- Free-function: gst_iterator_free
padIterateInternalLinks ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the GstPad to get the internal links of.
    -> m (Maybe Gst.Iterator.Iterator)
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Iterator.Iterator' of t'GI.Gst.Objects.Pad.Pad'
    --     or 'P.Nothing' when the pad does not have an iterator function
    --     configured. Use 'GI.Gst.Structs.Iterator.iteratorFree' after usage.
padIterateInternalLinks :: a -> m (Maybe Iterator)
padIterateInternalLinks a
pad = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Iterator
result <- Ptr Pad -> IO (Ptr Iterator)
gst_pad_iterate_internal_links Ptr Pad
pad'
    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
$ \Ptr Iterator
result' -> do
        Iterator
result'' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, GBoxed 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
pad
    Maybe Iterator -> IO (Maybe Iterator)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Iterator
maybeResult

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

#endif

-- method Pad::iterate_internal_links_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to get the internal links of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent of @pad or %NULL"
--                 , 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_pad_iterate_internal_links_default" gst_pad_iterate_internal_links_default :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Object.Object ->                -- parent : TInterface (Name {namespace = "Gst", name = "Object"})
    IO (Ptr Gst.Iterator.Iterator)

-- | Iterate the list of pads to which the given pad is linked to inside of
-- the parent element.
-- This is the default handler, and thus returns an iterator of all of the
-- pads inside the parent element with opposite direction.
-- 
-- The caller must free this iterator after use with 'GI.Gst.Structs.Iterator.iteratorFree'.
padIterateInternalLinksDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a, Gst.Object.IsObject b) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to get the internal links of.
    -> Maybe (b)
    -- ^ /@parent@/: the parent of /@pad@/ or 'P.Nothing'
    -> m (Maybe Gst.Iterator.Iterator)
    -- ^ __Returns:__ a t'GI.Gst.Structs.Iterator.Iterator' of t'GI.Gst.Objects.Pad.Pad', or 'P.Nothing' if /@pad@/
    -- has no parent. Unref each returned pad with 'GI.Gst.Objects.Object.objectUnref'.
padIterateInternalLinksDefault :: a -> Maybe b -> m (Maybe Iterator)
padIterateInternalLinksDefault a
pad Maybe b
parent = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Object
maybeParent <- case Maybe b
parent of
        Maybe b
Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just b
jParent -> do
            Ptr Object
jParent' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jParent'
    Ptr Iterator
result <- Ptr Pad -> Ptr Object -> IO (Ptr Iterator)
gst_pad_iterate_internal_links_default Ptr Pad
pad' Ptr Object
maybeParent
    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
$ \Ptr Iterator
result' -> do
        Iterator
result'' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, GBoxed 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
pad
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
parent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Iterator -> IO (Maybe Iterator)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Iterator
maybeResult

#if defined(ENABLE_OVERLOADING)
data PadIterateInternalLinksDefaultMethodInfo
instance (signature ~ (Maybe (b) -> m (Maybe Gst.Iterator.Iterator)), MonadIO m, IsPad a, Gst.Object.IsObject b) => O.MethodInfo PadIterateInternalLinksDefaultMethodInfo a signature where
    overloadedMethod = padIterateInternalLinksDefault

#endif

-- method Pad::link
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "srcpad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source #GstPad to link."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sinkpad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the sink #GstPad to link."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gst" , name = "PadLinkReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_link" gst_pad_link :: 
    Ptr Pad ->                              -- srcpad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Pad ->                              -- sinkpad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Links the source pad and the sink pad.
padLink ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a, IsPad b) =>
    a
    -- ^ /@srcpad@/: the source t'GI.Gst.Objects.Pad.Pad' to link.
    -> b
    -- ^ /@sinkpad@/: the sink t'GI.Gst.Objects.Pad.Pad' to link.
    -> m Gst.Enums.PadLinkReturn
    -- ^ __Returns:__ A result code indicating if the connection worked or
    --          what went wrong.
    -- 
    -- MT Safe.
padLink :: a -> b -> m PadLinkReturn
padLink a
srcpad b
sinkpad = IO PadLinkReturn -> m PadLinkReturn
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PadLinkReturn -> m PadLinkReturn)
-> IO PadLinkReturn -> m PadLinkReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
srcpad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
srcpad
    Ptr Pad
sinkpad' <- b -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
sinkpad
    CInt
result <- Ptr Pad -> Ptr Pad -> IO CInt
gst_pad_link Ptr Pad
srcpad' Ptr Pad
sinkpad'
    let result' :: PadLinkReturn
result' = (Int -> PadLinkReturn
forall a. Enum a => Int -> a
toEnum (Int -> PadLinkReturn) -> (CInt -> Int) -> CInt -> PadLinkReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
srcpad
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
sinkpad
    PadLinkReturn -> IO PadLinkReturn
forall (m :: * -> *) a. Monad m => a -> m a
return PadLinkReturn
result'

#if defined(ENABLE_OVERLOADING)
data PadLinkMethodInfo
instance (signature ~ (b -> m Gst.Enums.PadLinkReturn), MonadIO m, IsPad a, IsPad b) => O.MethodInfo PadLinkMethodInfo a signature where
    overloadedMethod = padLink

#endif

-- method Pad::link_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "srcpad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source #GstPad to link."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sinkpad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the sink #GstPad to link."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadLinkCheck" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the checks to validate when linking"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gst" , name = "PadLinkReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_link_full" gst_pad_link_full :: 
    Ptr Pad ->                              -- srcpad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Pad ->                              -- sinkpad : TInterface (Name {namespace = "Gst", name = "Pad"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "PadLinkCheck"})
    IO CInt

-- | Links the source pad and the sink pad.
-- 
-- This variant of @/gst_pad_link/@ provides a more granular control on the
-- checks being done when linking. While providing some considerable speedups
-- the caller of this method must be aware that wrong usage of those flags
-- can cause severe issues. Refer to the documentation of t'GI.Gst.Flags.PadLinkCheck'
-- for more information.
-- 
-- MT Safe.
padLinkFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a, IsPad b) =>
    a
    -- ^ /@srcpad@/: the source t'GI.Gst.Objects.Pad.Pad' to link.
    -> b
    -- ^ /@sinkpad@/: the sink t'GI.Gst.Objects.Pad.Pad' to link.
    -> [Gst.Flags.PadLinkCheck]
    -- ^ /@flags@/: the checks to validate when linking
    -> m Gst.Enums.PadLinkReturn
    -- ^ __Returns:__ A result code indicating if the connection worked or
    --          what went wrong.
padLinkFull :: a -> b -> [PadLinkCheck] -> m PadLinkReturn
padLinkFull a
srcpad b
sinkpad [PadLinkCheck]
flags = IO PadLinkReturn -> m PadLinkReturn
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PadLinkReturn -> m PadLinkReturn)
-> IO PadLinkReturn -> m PadLinkReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
srcpad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
srcpad
    Ptr Pad
sinkpad' <- b -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
sinkpad
    let flags' :: CUInt
flags' = [PadLinkCheck] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [PadLinkCheck]
flags
    CInt
result <- Ptr Pad -> Ptr Pad -> CUInt -> IO CInt
gst_pad_link_full Ptr Pad
srcpad' Ptr Pad
sinkpad' CUInt
flags'
    let result' :: PadLinkReturn
result' = (Int -> PadLinkReturn
forall a. Enum a => Int -> a
toEnum (Int -> PadLinkReturn) -> (CInt -> Int) -> CInt -> PadLinkReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
srcpad
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
sinkpad
    PadLinkReturn -> IO PadLinkReturn
forall (m :: * -> *) a. Monad m => a -> m a
return PadLinkReturn
result'

#if defined(ENABLE_OVERLOADING)
data PadLinkFullMethodInfo
instance (signature ~ (b -> [Gst.Flags.PadLinkCheck] -> m Gst.Enums.PadLinkReturn), MonadIO m, IsPad a, IsPad b) => O.MethodInfo PadLinkFullMethodInfo a signature where
    overloadedMethod = padLinkFull

#endif

-- method Pad::link_maybe_ghosting
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sink"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad" , 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_pad_link_maybe_ghosting" gst_pad_link_maybe_ghosting :: 
    Ptr Pad ->                              -- src : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Pad ->                              -- sink : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Links /@src@/ to /@sink@/, creating any t'GI.Gst.Objects.GhostPad.GhostPad'\'s in between as necessary.
-- 
-- This is a convenience function to save having to create and add intermediate
-- t'GI.Gst.Objects.GhostPad.GhostPad'\'s as required for linking across t'GI.Gst.Objects.Bin.Bin' boundaries.
-- 
-- If /@src@/ or /@sink@/ pads don\'t have parent elements or do not share a common
-- ancestor, the link will fail.
-- 
-- /Since: 1.10/
padLinkMaybeGhosting ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a, IsPad b) =>
    a
    -- ^ /@src@/: a t'GI.Gst.Objects.Pad.Pad'
    -> b
    -- ^ /@sink@/: a t'GI.Gst.Objects.Pad.Pad'
    -> m Bool
    -- ^ __Returns:__ whether the link succeeded.
padLinkMaybeGhosting :: a -> b -> m Bool
padLinkMaybeGhosting a
src b
sink = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
src' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr Pad
sink' <- b -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
sink
    CInt
result <- Ptr Pad -> Ptr Pad -> IO CInt
gst_pad_link_maybe_ghosting Ptr Pad
src' Ptr Pad
sink'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
sink
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadLinkMaybeGhostingMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsPad a, IsPad b) => O.MethodInfo PadLinkMaybeGhostingMethodInfo a signature where
    overloadedMethod = padLinkMaybeGhosting

#endif

-- method Pad::link_maybe_ghosting_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sink"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadLinkCheck" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "some #GstPadLinkCheck flags"
--                 , 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_pad_link_maybe_ghosting_full" gst_pad_link_maybe_ghosting_full :: 
    Ptr Pad ->                              -- src : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Pad ->                              -- sink : TInterface (Name {namespace = "Gst", name = "Pad"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "PadLinkCheck"})
    IO CInt

-- | Links /@src@/ to /@sink@/, creating any t'GI.Gst.Objects.GhostPad.GhostPad'\'s in between as necessary.
-- 
-- This is a convenience function to save having to create and add intermediate
-- t'GI.Gst.Objects.GhostPad.GhostPad'\'s as required for linking across t'GI.Gst.Objects.Bin.Bin' boundaries.
-- 
-- If /@src@/ or /@sink@/ pads don\'t have parent elements or do not share a common
-- ancestor, the link will fail.
-- 
-- Calling 'GI.Gst.Objects.Pad.padLinkMaybeGhostingFull' with
-- /@flags@/ == 'GI.Gst.Flags.PadLinkCheckDefault' is the recommended way of linking
-- pads with safety checks applied.
-- 
-- /Since: 1.10/
padLinkMaybeGhostingFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a, IsPad b) =>
    a
    -- ^ /@src@/: a t'GI.Gst.Objects.Pad.Pad'
    -> b
    -- ^ /@sink@/: a t'GI.Gst.Objects.Pad.Pad'
    -> [Gst.Flags.PadLinkCheck]
    -- ^ /@flags@/: some t'GI.Gst.Flags.PadLinkCheck' flags
    -> m Bool
    -- ^ __Returns:__ whether the link succeeded.
padLinkMaybeGhostingFull :: a -> b -> [PadLinkCheck] -> m Bool
padLinkMaybeGhostingFull a
src b
sink [PadLinkCheck]
flags = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
src' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr Pad
sink' <- b -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
sink
    let flags' :: CUInt
flags' = [PadLinkCheck] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [PadLinkCheck]
flags
    CInt
result <- Ptr Pad -> Ptr Pad -> CUInt -> IO CInt
gst_pad_link_maybe_ghosting_full Ptr Pad
src' Ptr Pad
sink' CUInt
flags'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
sink
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadLinkMaybeGhostingFullMethodInfo
instance (signature ~ (b -> [Gst.Flags.PadLinkCheck] -> m Bool), MonadIO m, IsPad a, IsPad b) => O.MethodInfo PadLinkMaybeGhostingFullMethodInfo a signature where
    overloadedMethod = padLinkMaybeGhostingFull

#endif

-- method Pad::mark_reconfigure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to mark"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_mark_reconfigure" gst_pad_mark_reconfigure :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO ()

-- | Mark a pad for needing reconfiguration. The next call to
-- 'GI.Gst.Objects.Pad.padCheckReconfigure' will return 'P.True' after this call.
padMarkReconfigure ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to mark
    -> m ()
padMarkReconfigure :: a -> m ()
padMarkReconfigure a
pad = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Pad -> IO ()
gst_pad_mark_reconfigure Ptr Pad
pad'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadMarkReconfigureMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPad a) => O.MethodInfo PadMarkReconfigureMethodInfo a signature where
    overloadedMethod = padMarkReconfigure

#endif

-- method Pad::needs_reconfigure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to check"
--                 , 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_pad_needs_reconfigure" gst_pad_needs_reconfigure :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Check the @/GST_PAD_FLAG_NEED_RECONFIGURE/@ flag on /@pad@/ and return 'P.True'
-- if the flag was set.
padNeedsReconfigure ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' is the GST_PAD_FLAG_NEED_RECONFIGURE flag is set on /@pad@/.
padNeedsReconfigure :: a -> m Bool
padNeedsReconfigure a
pad = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CInt
result <- Ptr Pad -> IO CInt
gst_pad_needs_reconfigure Ptr Pad
pad'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadNeedsReconfigureMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPad a) => O.MethodInfo PadNeedsReconfigureMethodInfo a signature where
    overloadedMethod = padNeedsReconfigure

#endif

-- method Pad::pause_task
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to pause the task of"
--                 , 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_pad_pause_task" gst_pad_pause_task :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Pause the task of /@pad@/. This function will also wait until the
-- function executed by the task is finished if this function is not
-- called from the task function.
padPauseTask ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to pause the task of
    -> m Bool
    -- ^ __Returns:__ a 'P.True' if the task could be paused or 'P.False' when the pad
    -- has no task.
padPauseTask :: a -> m Bool
padPauseTask a
pad = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CInt
result <- Ptr Pad -> IO CInt
gst_pad_pause_task Ptr Pad
pad'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadPauseTaskMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPad a) => O.MethodInfo PadPauseTaskMethodInfo a signature where
    overloadedMethod = padPauseTask

#endif

-- method Pad::peer_query
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad to invoke the peer query on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstQuery to perform."
--                 , 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_pad_peer_query" gst_pad_peer_query :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Query.Query ->                  -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    IO CInt

-- | Performs 'GI.Gst.Objects.Pad.padQuery' on the peer of /@pad@/.
-- 
-- The caller is responsible for both the allocation and deallocation of
-- the query structure.
padPeerQuery ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' to invoke the peer query on.
    -> Gst.Query.Query
    -- ^ /@query@/: the t'GI.Gst.Structs.Query.Query' to perform.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the query could be performed. This function returns 'P.False'
    -- if /@pad@/ has no peer.
padPeerQuery :: a -> Query -> m Bool
padPeerQuery a
pad Query
query = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    CInt
result <- Ptr Pad -> Ptr Query -> IO CInt
gst_pad_peer_query Ptr Pad
pad' Ptr Query
query'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadPeerQueryMethodInfo
instance (signature ~ (Gst.Query.Query -> m Bool), MonadIO m, IsPad a) => O.MethodInfo PadPeerQueryMethodInfo a signature where
    overloadedMethod = padPeerQuery

#endif

-- method Pad::peer_query_accept_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a  #GstPad to check the peer of"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps to check on the pad"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_peer_query_accept_caps" gst_pad_peer_query_accept_caps :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

-- | Check if the peer of /@pad@/ accepts /@caps@/. If /@pad@/ has no peer, this function
-- returns 'P.True'.
padPeerQueryAcceptCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a  t'GI.Gst.Objects.Pad.Pad' to check the peer of
    -> Gst.Caps.Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps' to check on the pad
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the peer of /@pad@/ can accept the caps or /@pad@/ has no peer.
padPeerQueryAcceptCaps :: a -> Caps -> m Bool
padPeerQueryAcceptCaps a
pad Caps
caps = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    CInt
result <- Ptr Pad -> Ptr Caps -> IO CInt
gst_pad_peer_query_accept_caps Ptr Pad
pad' Ptr Caps
caps'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadPeerQueryAcceptCapsMethodInfo
instance (signature ~ (Gst.Caps.Caps -> m Bool), MonadIO m, IsPad a) => O.MethodInfo PadPeerQueryAcceptCapsMethodInfo a signature where
    overloadedMethod = padPeerQueryAcceptCaps

#endif

-- method Pad::peer_query_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a  #GstPad to get the capabilities of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps filter, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Caps" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_peer_query_caps" gst_pad_peer_query_caps :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Caps.Caps ->                    -- filter : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Gst.Caps.Caps)

-- | Gets the capabilities of the peer connected to this pad. Similar to
-- 'GI.Gst.Objects.Pad.padQueryCaps'.
-- 
-- When called on srcpads /@filter@/ contains the caps that
-- upstream could produce in the order preferred by upstream. When
-- called on sinkpads /@filter@/ contains the caps accepted by
-- downstream in the preferred order. /@filter@/ might be 'P.Nothing' but
-- if it is not 'P.Nothing' the returned caps will be a subset of /@filter@/.
padPeerQueryCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a  t'GI.Gst.Objects.Pad.Pad' to get the capabilities of.
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@filter@/: a t'GI.Gst.Structs.Caps.Caps' filter, or 'P.Nothing'.
    -> m Gst.Caps.Caps
    -- ^ __Returns:__ the caps of the peer pad with incremented
    -- ref-count. When there is no peer pad, this function returns /@filter@/ or,
    -- when /@filter@/ is 'P.Nothing', ANY caps.
padPeerQueryCaps :: a -> Maybe Caps -> m Caps
padPeerQueryCaps a
pad Maybe Caps
filter = IO Caps -> m Caps
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Caps -> m Caps) -> IO Caps -> m Caps
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Caps
maybeFilter <- case Maybe Caps
filter of
        Maybe Caps
Nothing -> Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just Caps
jFilter -> do
            Ptr Caps
jFilter' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jFilter
            Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jFilter'
    Ptr Caps
result <- Ptr Pad -> Ptr Caps -> IO (Ptr Caps)
gst_pad_peer_query_caps Ptr Pad
pad' Ptr Caps
maybeFilter
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"padPeerQueryCaps" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Maybe Caps -> (Caps -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Caps
filter Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data PadPeerQueryCapsMethodInfo
instance (signature ~ (Maybe (Gst.Caps.Caps) -> m Gst.Caps.Caps), MonadIO m, IsPad a) => O.MethodInfo PadPeerQueryCapsMethodInfo a signature where
    overloadedMethod = padPeerQueryCaps

#endif

-- method Pad::peer_query_convert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GstPad, on whose peer pad to invoke the convert query on.\n      Must be a sink pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstFormat to convert from."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_val"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a value to convert."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFormat to convert to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_val"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to the result."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_peer_query_convert" gst_pad_peer_query_convert :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    CUInt ->                                -- src_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- src_val : TBasicType TInt64
    CUInt ->                                -- dest_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- dest_val : TBasicType TInt64
    IO CInt

-- | Queries the peer pad of a given sink pad to convert /@srcVal@/ in /@srcFormat@/
-- to /@destFormat@/.
padPeerQueryConvert ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad', on whose peer pad to invoke the convert query on.
    --       Must be a sink pad.
    -> Gst.Enums.Format
    -- ^ /@srcFormat@/: a t'GI.Gst.Enums.Format' to convert from.
    -> Int64
    -- ^ /@srcVal@/: a value to convert.
    -> Gst.Enums.Format
    -- ^ /@destFormat@/: the t'GI.Gst.Enums.Format' to convert to.
    -> m ((Bool, Int64))
    -- ^ __Returns:__ 'P.True' if the query could be performed.
padPeerQueryConvert :: a -> Format -> Int64 -> Format -> m (Bool, Int64)
padPeerQueryConvert a
pad Format
srcFormat Int64
srcVal Format
destFormat = IO (Bool, Int64) -> m (Bool, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64) -> m (Bool, Int64))
-> IO (Bool, Int64) -> m (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    let srcFormat' :: CUInt
srcFormat' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
srcFormat
    let destFormat' :: CUInt
destFormat' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
destFormat
    Ptr Int64
destVal <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr Pad -> CUInt -> Int64 -> CUInt -> Ptr Int64 -> IO CInt
gst_pad_peer_query_convert Ptr Pad
pad' CUInt
srcFormat' Int64
srcVal CUInt
destFormat' Ptr Int64
destVal
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
destVal' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
destVal
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
destVal
    (Bool, Int64) -> IO (Bool, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
destVal')

#if defined(ENABLE_OVERLOADING)
data PadPeerQueryConvertMethodInfo
instance (signature ~ (Gst.Enums.Format -> Int64 -> Gst.Enums.Format -> m ((Bool, Int64))), MonadIO m, IsPad a) => O.MethodInfo PadPeerQueryConvertMethodInfo a signature where
    overloadedMethod = padPeerQueryConvert

#endif

-- method Pad::peer_query_duration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GstPad on whose peer pad to invoke the duration query on.\n      Must be a sink pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFormat requested"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "duration"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a location in which to store the total\n    duration, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_peer_query_duration" gst_pad_peer_query_duration :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- duration : TBasicType TInt64
    IO CInt

-- | Queries the peer pad of a given sink pad for the total stream duration.
padPeerQueryDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' on whose peer pad to invoke the duration query on.
    --       Must be a sink pad.
    -> Gst.Enums.Format
    -- ^ /@format@/: the t'GI.Gst.Enums.Format' requested
    -> m ((Bool, Int64))
    -- ^ __Returns:__ 'P.True' if the query could be performed.
padPeerQueryDuration :: a -> Format -> m (Bool, Int64)
padPeerQueryDuration a
pad Format
format = IO (Bool, Int64) -> m (Bool, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64) -> m (Bool, Int64))
-> IO (Bool, Int64) -> m (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Int64
duration <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr Pad -> CUInt -> Ptr Int64 -> IO CInt
gst_pad_peer_query_duration Ptr Pad
pad' CUInt
format' Ptr Int64
duration
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
duration' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
duration
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
duration
    (Bool, Int64) -> IO (Bool, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
duration')

#if defined(ENABLE_OVERLOADING)
data PadPeerQueryDurationMethodInfo
instance (signature ~ (Gst.Enums.Format -> m ((Bool, Int64))), MonadIO m, IsPad a) => O.MethodInfo PadPeerQueryDurationMethodInfo a signature where
    overloadedMethod = padPeerQueryDuration

#endif

-- method Pad::peer_query_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GstPad on whose peer to invoke the position query on.\n      Must be a sink pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFormat requested"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cur"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a location in which to store the current\n    position, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_peer_query_position" gst_pad_peer_query_position :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- cur : TBasicType TInt64
    IO CInt

-- | Queries the peer of a given sink pad for the stream position.
padPeerQueryPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' on whose peer to invoke the position query on.
    --       Must be a sink pad.
    -> Gst.Enums.Format
    -- ^ /@format@/: the t'GI.Gst.Enums.Format' requested
    -> m ((Bool, Int64))
    -- ^ __Returns:__ 'P.True' if the query could be performed.
padPeerQueryPosition :: a -> Format -> m (Bool, Int64)
padPeerQueryPosition a
pad Format
format = IO (Bool, Int64) -> m (Bool, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64) -> m (Bool, Int64))
-> IO (Bool, Int64) -> m (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Int64
cur <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr Pad -> CUInt -> Ptr Int64 -> IO CInt
gst_pad_peer_query_position Ptr Pad
pad' CUInt
format' Ptr Int64
cur
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
cur' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
cur
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
cur
    (Bool, Int64) -> IO (Bool, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
cur')

#if defined(ENABLE_OVERLOADING)
data PadPeerQueryPositionMethodInfo
instance (signature ~ (Gst.Enums.Format -> m ((Bool, Int64))), MonadIO m, IsPad a) => O.MethodInfo PadPeerQueryPositionMethodInfo a signature where
    overloadedMethod = padPeerQueryPosition

#endif

-- method Pad::proxy_query_accept_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad to proxy."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an ACCEPT_CAPS #GstQuery."
--                 , 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_pad_proxy_query_accept_caps" gst_pad_proxy_query_accept_caps :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Query.Query ->                  -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    IO CInt

-- | Checks if all internally linked pads of /@pad@/ accepts the caps in /@query@/ and
-- returns the intersection of the results.
-- 
-- This function is useful as a default accept caps query function for an element
-- that can handle any stream format, but requires caps that are acceptable for
-- all opposite pads.
padProxyQueryAcceptCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' to proxy.
    -> Gst.Query.Query
    -- ^ /@query@/: an ACCEPT_CAPS t'GI.Gst.Structs.Query.Query'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@query@/ could be executed
padProxyQueryAcceptCaps :: a -> Query -> m Bool
padProxyQueryAcceptCaps a
pad Query
query = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    CInt
result <- Ptr Pad -> Ptr Query -> IO CInt
gst_pad_proxy_query_accept_caps Ptr Pad
pad' Ptr Query
query'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadProxyQueryAcceptCapsMethodInfo
instance (signature ~ (Gst.Query.Query -> m Bool), MonadIO m, IsPad a) => O.MethodInfo PadProxyQueryAcceptCapsMethodInfo a signature where
    overloadedMethod = padProxyQueryAcceptCaps

#endif

-- method Pad::proxy_query_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad to proxy."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a CAPS #GstQuery." , 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_pad_proxy_query_caps" gst_pad_proxy_query_caps :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Query.Query ->                  -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    IO CInt

-- | Calls 'GI.Gst.Objects.Pad.padQueryCaps' for all internally linked pads of /@pad@/ and returns
-- the intersection of the results.
-- 
-- This function is useful as a default caps query function for an element
-- that can handle any stream format, but requires all its pads to have
-- the same caps.  Two such elements are tee and adder.
padProxyQueryCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' to proxy.
    -> Gst.Query.Query
    -- ^ /@query@/: a CAPS t'GI.Gst.Structs.Query.Query'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@query@/ could be executed
padProxyQueryCaps :: a -> Query -> m Bool
padProxyQueryCaps a
pad Query
query = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    CInt
result <- Ptr Pad -> Ptr Query -> IO CInt
gst_pad_proxy_query_caps Ptr Pad
pad' Ptr Query
query'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadProxyQueryCapsMethodInfo
instance (signature ~ (Gst.Query.Query -> m Bool), MonadIO m, IsPad a) => O.MethodInfo PadProxyQueryCapsMethodInfo a signature where
    overloadedMethod = padProxyQueryCaps

#endif

-- method Pad::pull_range
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a sink #GstPad, returns GST_FLOW_ERROR if not."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The start offset of the buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The length of the buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a pointer to hold the #GstBuffer, returns\n    GST_FLOW_ERROR if %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "FlowReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_pull_range" gst_pad_pull_range :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Word64 ->                               -- offset : TBasicType TUInt64
    Word32 ->                               -- size : TBasicType TUInt
    Ptr (Ptr Gst.Buffer.Buffer) ->          -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO CInt

-- | Pulls a /@buffer@/ from the peer pad or fills up a provided buffer.
-- 
-- This function will first trigger the pad block signal if it was
-- installed.
-- 
-- When /@pad@/ is not linked @/GST_FLOW_NOT_LINKED/@ is returned else this
-- function returns the result of 'GI.Gst.Objects.Pad.padGetRange' on the peer pad.
-- See 'GI.Gst.Objects.Pad.padGetRange' for a list of return values and for the
-- semantics of the arguments of this function.
-- 
-- If /@buffer@/ points to a variable holding 'P.Nothing', a valid new t'GI.Gst.Structs.Buffer.Buffer' will be
-- placed in /@buffer@/ when this function returns @/GST_FLOW_OK/@. The new buffer
-- must be freed with @/gst_buffer_unref()/@ after usage. When this function
-- returns any other result value, /@buffer@/ will still point to 'P.Nothing'.
-- 
-- When /@buffer@/ points to a variable that points to a valid t'GI.Gst.Structs.Buffer.Buffer', the
-- buffer will be filled with the result data when this function returns
-- @/GST_FLOW_OK/@. When this function returns any other result value,
-- /@buffer@/ will be unchanged. If the provided buffer is larger than /@size@/, only
-- /@size@/ bytes will be filled in the result buffer and its size will be updated
-- accordingly.
-- 
-- Note that less than /@size@/ bytes can be returned in /@buffer@/ when, for example,
-- an EOS condition is near or when /@buffer@/ is not large enough to hold /@size@/
-- bytes. The caller should check the result buffer size to get the result size.
padPullRange ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a sink t'GI.Gst.Objects.Pad.Pad', returns GST_FLOW_ERROR if not.
    -> Word64
    -- ^ /@offset@/: The start offset of the buffer
    -> Word32
    -- ^ /@size@/: The length of the buffer
    -> m ((Gst.Enums.FlowReturn, Gst.Buffer.Buffer))
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn' from the peer pad.
    -- 
    -- MT safe.
padPullRange :: a -> Word64 -> Word32 -> m (FlowReturn, Buffer)
padPullRange a
pad Word64
offset Word32
size = IO (FlowReturn, Buffer) -> m (FlowReturn, Buffer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FlowReturn, Buffer) -> m (FlowReturn, Buffer))
-> IO (FlowReturn, Buffer) -> m (FlowReturn, Buffer)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr (Ptr Buffer)
buffer <- IO (Ptr (Ptr Buffer))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Buffer.Buffer))
    CInt
result <- Ptr Pad -> Word64 -> Word32 -> Ptr (Ptr Buffer) -> IO CInt
gst_pad_pull_range Ptr Pad
pad' Word64
offset Word32
size Ptr (Ptr Buffer)
buffer
    let result' :: FlowReturn
result' = (Int -> FlowReturn
forall a. Enum a => Int -> a
toEnum (Int -> FlowReturn) -> (CInt -> Int) -> CInt -> FlowReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    Ptr Buffer
buffer' <- Ptr (Ptr Buffer) -> IO (Ptr Buffer)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Buffer)
buffer
    Buffer
buffer'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
buffer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Ptr (Ptr Buffer) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Buffer)
buffer
    (FlowReturn, Buffer) -> IO (FlowReturn, Buffer)
forall (m :: * -> *) a. Monad m => a -> m a
return (FlowReturn
result', Buffer
buffer'')

#if defined(ENABLE_OVERLOADING)
data PadPullRangeMethodInfo
instance (signature ~ (Word64 -> Word32 -> m ((Gst.Enums.FlowReturn, Gst.Buffer.Buffer))), MonadIO m, IsPad a) => O.MethodInfo PadPullRangeMethodInfo a signature where
    overloadedMethod = padPullRange

#endif

-- method Pad::push
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a source #GstPad, returns #GST_FLOW_ERROR if not."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GstBuffer to push returns GST_FLOW_ERROR\n    if not."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "FlowReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_push" gst_pad_push :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO CInt

-- | Pushes a buffer to the peer of /@pad@/.
-- 
-- This function will call installed block probes before triggering any
-- installed data probes.
-- 
-- The function proceeds calling 'GI.Gst.Objects.Pad.padChain' on the peer pad and returns
-- the value from that function. If /@pad@/ has no peer, @/GST_FLOW_NOT_LINKED/@ will
-- be returned.
-- 
-- In all cases, success or failure, the caller loses its reference to /@buffer@/
-- after calling this function.
padPush ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a source t'GI.Gst.Objects.Pad.Pad', returns @/GST_FLOW_ERROR/@ if not.
    -> Gst.Buffer.Buffer
    -- ^ /@buffer@/: the t'GI.Gst.Structs.Buffer.Buffer' to push returns GST_FLOW_ERROR
    --     if not.
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn' from the peer pad.
    -- 
    -- MT safe.
padPush :: a -> Buffer -> m FlowReturn
padPush a
pad Buffer
buffer = IO FlowReturn -> m FlowReturn
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlowReturn -> m FlowReturn) -> IO FlowReturn -> m FlowReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Buffer
buffer
    CInt
result <- Ptr Pad -> Ptr Buffer -> IO CInt
gst_pad_push Ptr Pad
pad' Ptr Buffer
buffer'
    let result' :: FlowReturn
result' = (Int -> FlowReturn
forall a. Enum a => Int -> a
toEnum (Int -> FlowReturn) -> (CInt -> Int) -> CInt -> FlowReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    FlowReturn -> IO FlowReturn
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

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

#endif

-- method Pad::push_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad to push the event to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gst" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstEvent to send to the pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_push_event" gst_pad_push_event :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Event.Event ->                  -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    IO CInt

-- | Sends the event to the peer of the given pad. This function is
-- mainly used by elements to send events to their peer
-- elements.
-- 
-- This function takes ownership of the provided event so you should
-- @/gst_event_ref()/@ it if you want to reuse the event after this call.
padPushEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' to push the event to.
    -> Gst.Event.Event
    -- ^ /@event@/: the t'GI.Gst.Structs.Event.Event' to send to the pad.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the event was handled.
    -- 
    -- MT safe.
padPushEvent :: a -> Event -> m Bool
padPushEvent a
pad Event
event = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Event
event
    CInt
result <- Ptr Pad -> Ptr Event -> IO CInt
gst_pad_push_event Ptr Pad
pad' Ptr Event
event'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadPushEventMethodInfo
instance (signature ~ (Gst.Event.Event -> m Bool), MonadIO m, IsPad a) => O.MethodInfo PadPushEventMethodInfo a signature where
    overloadedMethod = padPushEvent

#endif

-- method Pad::push_list
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a source #GstPad, returns #GST_FLOW_ERROR if not."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GstBufferList to push returns GST_FLOW_ERROR\n    if not."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "FlowReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_push_list" gst_pad_push_list :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.BufferList.BufferList ->        -- list : TInterface (Name {namespace = "Gst", name = "BufferList"})
    IO CInt

-- | Pushes a buffer list to the peer of /@pad@/.
-- 
-- This function will call installed block probes before triggering any
-- installed data probes.
-- 
-- The function proceeds calling the chain function on the peer pad and returns
-- the value from that function. If /@pad@/ has no peer, @/GST_FLOW_NOT_LINKED/@ will
-- be returned. If the peer pad does not have any installed chainlist function
-- every group buffer of the list will be merged into a normal t'GI.Gst.Structs.Buffer.Buffer' and
-- chained via 'GI.Gst.Objects.Pad.padChain'.
-- 
-- In all cases, success or failure, the caller loses its reference to /@list@/
-- after calling this function.
padPushList ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a source t'GI.Gst.Objects.Pad.Pad', returns @/GST_FLOW_ERROR/@ if not.
    -> Gst.BufferList.BufferList
    -- ^ /@list@/: the t'GI.Gst.Structs.BufferList.BufferList' to push returns GST_FLOW_ERROR
    --     if not.
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn' from the peer pad.
    -- 
    -- MT safe.
padPushList :: a -> BufferList -> m FlowReturn
padPushList a
pad BufferList
list = IO FlowReturn -> m FlowReturn
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlowReturn -> m FlowReturn) -> IO FlowReturn -> m FlowReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr BufferList
list' <- BufferList -> IO (Ptr BufferList)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed BufferList
list
    CInt
result <- Ptr Pad -> Ptr BufferList -> IO CInt
gst_pad_push_list Ptr Pad
pad' Ptr BufferList
list'
    let result' :: FlowReturn
result' = (Int -> FlowReturn
forall a. Enum a => Int -> a
toEnum (Int -> FlowReturn) -> (CInt -> Int) -> CInt -> FlowReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    BufferList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BufferList
list
    FlowReturn -> IO FlowReturn
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data PadPushListMethodInfo
instance (signature ~ (Gst.BufferList.BufferList -> m Gst.Enums.FlowReturn), MonadIO m, IsPad a) => O.MethodInfo PadPushListMethodInfo a signature where
    overloadedMethod = padPushList

#endif

-- method Pad::query
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad to invoke the default query on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstQuery to perform."
--                 , 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_pad_query" gst_pad_query :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Query.Query ->                  -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    IO CInt

-- | Dispatches a query to a pad. The query should have been allocated by the
-- caller via one of the type-specific allocation functions. The element that
-- the pad belongs to is responsible for filling the query with an appropriate
-- response, which should then be parsed with a type-specific query parsing
-- function.
-- 
-- Again, the caller is responsible for both the allocation and deallocation of
-- the query structure.
-- 
-- Please also note that some queries might need a running pipeline to work.
padQuery ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' to invoke the default query on.
    -> Gst.Query.Query
    -- ^ /@query@/: the t'GI.Gst.Structs.Query.Query' to perform.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the query could be performed.
padQuery :: a -> Query -> m Bool
padQuery a
pad Query
query = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    CInt
result <- Ptr Pad -> Ptr Query -> IO CInt
gst_pad_query Ptr Pad
pad' Ptr Query
query'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadQueryMethodInfo
instance (signature ~ (Gst.Query.Query -> m Bool), MonadIO m, IsPad a) => O.MethodInfo PadQueryMethodInfo a signature where
    overloadedMethod = padQuery

#endif

-- method Pad::query_accept_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad to check" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps to check on the pad"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_query_accept_caps" gst_pad_query_accept_caps :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

-- | Check if the given pad accepts the caps.
padQueryAcceptCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' to check
    -> Gst.Caps.Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps' to check on the pad
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pad can accept the caps.
padQueryAcceptCaps :: a -> Caps -> m Bool
padQueryAcceptCaps a
pad Caps
caps = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    CInt
result <- Ptr Pad -> Ptr Caps -> IO CInt
gst_pad_query_accept_caps Ptr Pad
pad' Ptr Caps
caps'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadQueryAcceptCapsMethodInfo
instance (signature ~ (Gst.Caps.Caps -> m Bool), MonadIO m, IsPad a) => O.MethodInfo PadQueryAcceptCapsMethodInfo a signature where
    overloadedMethod = padQueryAcceptCaps

#endif

-- method Pad::query_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a  #GstPad to get the capabilities of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "suggested #GstCaps, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Caps" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_query_caps" gst_pad_query_caps :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Caps.Caps ->                    -- filter : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Gst.Caps.Caps)

-- | Gets the capabilities this pad can produce or consume.
-- Note that this method doesn\'t necessarily return the caps set by sending a
-- 'GI.Gst.Structs.Event.eventNewCaps' - use 'GI.Gst.Objects.Pad.padGetCurrentCaps' for that instead.
-- gst_pad_query_caps returns all possible caps a pad can operate with, using
-- the pad\'s CAPS query function, If the query fails, this function will return
-- /@filter@/, if not 'P.Nothing', otherwise ANY.
-- 
-- When called on sinkpads /@filter@/ contains the caps that
-- upstream could produce in the order preferred by upstream. When
-- called on srcpads /@filter@/ contains the caps accepted by
-- downstream in the preferred order. /@filter@/ might be 'P.Nothing' but
-- if it is not 'P.Nothing' the returned caps will be a subset of /@filter@/.
-- 
-- Note that this function does not return writable t'GI.Gst.Structs.Caps.Caps', use
-- @/gst_caps_make_writable()/@ before modifying the caps.
padQueryCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a  t'GI.Gst.Objects.Pad.Pad' to get the capabilities of.
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@filter@/: suggested t'GI.Gst.Structs.Caps.Caps', or 'P.Nothing'
    -> m Gst.Caps.Caps
    -- ^ __Returns:__ the caps of the pad with incremented ref-count.
padQueryCaps :: a -> Maybe Caps -> m Caps
padQueryCaps a
pad Maybe Caps
filter = IO Caps -> m Caps
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Caps -> m Caps) -> IO Caps -> m Caps
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Caps
maybeFilter <- case Maybe Caps
filter of
        Maybe Caps
Nothing -> Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just Caps
jFilter -> do
            Ptr Caps
jFilter' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jFilter
            Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jFilter'
    Ptr Caps
result <- Ptr Pad -> Ptr Caps -> IO (Ptr Caps)
gst_pad_query_caps Ptr Pad
pad' Ptr Caps
maybeFilter
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"padQueryCaps" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Maybe Caps -> (Caps -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Caps
filter Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data PadQueryCapsMethodInfo
instance (signature ~ (Maybe (Gst.Caps.Caps) -> m Gst.Caps.Caps), MonadIO m, IsPad a) => O.MethodInfo PadQueryCapsMethodInfo a signature where
    overloadedMethod = padQueryCaps

#endif

-- method Pad::query_convert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad to invoke the convert query on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstFormat to convert from."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_val"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a value to convert."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFormat to convert to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_val"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to the result."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_query_convert" gst_pad_query_convert :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    CUInt ->                                -- src_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- src_val : TBasicType TInt64
    CUInt ->                                -- dest_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- dest_val : TBasicType TInt64
    IO CInt

-- | Queries a pad to convert /@srcVal@/ in /@srcFormat@/ to /@destFormat@/.
padQueryConvert ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' to invoke the convert query on.
    -> Gst.Enums.Format
    -- ^ /@srcFormat@/: a t'GI.Gst.Enums.Format' to convert from.
    -> Int64
    -- ^ /@srcVal@/: a value to convert.
    -> Gst.Enums.Format
    -- ^ /@destFormat@/: the t'GI.Gst.Enums.Format' to convert to.
    -> m ((Bool, Int64))
    -- ^ __Returns:__ 'P.True' if the query could be performed.
padQueryConvert :: a -> Format -> Int64 -> Format -> m (Bool, Int64)
padQueryConvert a
pad Format
srcFormat Int64
srcVal Format
destFormat = IO (Bool, Int64) -> m (Bool, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64) -> m (Bool, Int64))
-> IO (Bool, Int64) -> m (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    let srcFormat' :: CUInt
srcFormat' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
srcFormat
    let destFormat' :: CUInt
destFormat' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
destFormat
    Ptr Int64
destVal <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr Pad -> CUInt -> Int64 -> CUInt -> Ptr Int64 -> IO CInt
gst_pad_query_convert Ptr Pad
pad' CUInt
srcFormat' Int64
srcVal CUInt
destFormat' Ptr Int64
destVal
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
destVal' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
destVal
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
destVal
    (Bool, Int64) -> IO (Bool, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
destVal')

#if defined(ENABLE_OVERLOADING)
data PadQueryConvertMethodInfo
instance (signature ~ (Gst.Enums.Format -> Int64 -> Gst.Enums.Format -> m ((Bool, Int64))), MonadIO m, IsPad a) => O.MethodInfo PadQueryConvertMethodInfo a signature where
    overloadedMethod = padQueryConvert

#endif

-- method Pad::query_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstPad to call the default query handler on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent of @pad or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstQuery to handle."
--                 , 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_pad_query_default" gst_pad_query_default :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Object.Object ->                -- parent : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.Query.Query ->                  -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    IO CInt

-- | Invokes the default query handler for the given pad.
-- The query is sent to all pads internally linked to /@pad@/. Note that
-- if there are many possible sink pads that are internally linked to
-- /@pad@/, only one will be sent the query.
-- Multi-sinkpad elements should implement custom query handlers.
padQueryDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a, Gst.Object.IsObject b) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' to call the default query handler on.
    -> Maybe (b)
    -- ^ /@parent@/: the parent of /@pad@/ or 'P.Nothing'
    -> Gst.Query.Query
    -- ^ /@query@/: the t'GI.Gst.Structs.Query.Query' to handle.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the query was performed successfully.
padQueryDefault :: a -> Maybe b -> Query -> m Bool
padQueryDefault a
pad Maybe b
parent Query
query = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Object
maybeParent <- case Maybe b
parent of
        Maybe b
Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just b
jParent -> do
            Ptr Object
jParent' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jParent'
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    CInt
result <- Ptr Pad -> Ptr Object -> Ptr Query -> IO CInt
gst_pad_query_default Ptr Pad
pad' Ptr Object
maybeParent Ptr Query
query'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
parent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadQueryDefaultMethodInfo
instance (signature ~ (Maybe (b) -> Gst.Query.Query -> m Bool), MonadIO m, IsPad a, Gst.Object.IsObject b) => O.MethodInfo PadQueryDefaultMethodInfo a signature where
    overloadedMethod = padQueryDefault

#endif

-- method Pad::query_duration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad to invoke the duration query on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFormat requested"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "duration"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a location in which to store the total\n    duration, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_query_duration" gst_pad_query_duration :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- duration : TBasicType TInt64
    IO CInt

-- | Queries a pad for the total stream duration.
padQueryDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' to invoke the duration query on.
    -> Gst.Enums.Format
    -- ^ /@format@/: the t'GI.Gst.Enums.Format' requested
    -> m ((Bool, Int64))
    -- ^ __Returns:__ 'P.True' if the query could be performed.
padQueryDuration :: a -> Format -> m (Bool, Int64)
padQueryDuration a
pad Format
format = IO (Bool, Int64) -> m (Bool, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64) -> m (Bool, Int64))
-> IO (Bool, Int64) -> m (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Int64
duration <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr Pad -> CUInt -> Ptr Int64 -> IO CInt
gst_pad_query_duration Ptr Pad
pad' CUInt
format' Ptr Int64
duration
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
duration' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
duration
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
duration
    (Bool, Int64) -> IO (Bool, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
duration')

#if defined(ENABLE_OVERLOADING)
data PadQueryDurationMethodInfo
instance (signature ~ (Gst.Enums.Format -> m ((Bool, Int64))), MonadIO m, IsPad a) => O.MethodInfo PadQueryDurationMethodInfo a signature where
    overloadedMethod = padQueryDuration

#endif

-- method Pad::query_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad to invoke the position query on."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFormat requested"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cur"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A location in which to store the current position, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_query_position" gst_pad_query_position :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- cur : TBasicType TInt64
    IO CInt

-- | Queries a pad for the stream position.
padQueryPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' to invoke the position query on.
    -> Gst.Enums.Format
    -- ^ /@format@/: the t'GI.Gst.Enums.Format' requested
    -> m ((Bool, Int64))
    -- ^ __Returns:__ 'P.True' if the query could be performed.
padQueryPosition :: a -> Format -> m (Bool, Int64)
padQueryPosition a
pad Format
format = IO (Bool, Int64) -> m (Bool, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64) -> m (Bool, Int64))
-> IO (Bool, Int64) -> m (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Int64
cur <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr Pad -> CUInt -> Ptr Int64 -> IO CInt
gst_pad_query_position Ptr Pad
pad' CUInt
format' Ptr Int64
cur
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
cur' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
cur
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
cur
    (Bool, Int64) -> IO (Bool, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
cur')

#if defined(ENABLE_OVERLOADING)
data PadQueryPositionMethodInfo
instance (signature ~ (Gst.Enums.Format -> m ((Bool, Int64))), MonadIO m, IsPad a) => O.MethodInfo PadQueryPositionMethodInfo a signature where
    overloadedMethod = padQueryPosition

#endif

-- method Pad::remove_probe
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad with the probe"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TULong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the probe id to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_remove_probe" gst_pad_remove_probe :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    CULong ->                               -- id : TBasicType TULong
    IO ()

-- | Remove the probe with /@id@/ from /@pad@/.
-- 
-- MT safe.
padRemoveProbe ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' with the probe
    -> CULong
    -- ^ /@id@/: the probe id to remove
    -> m ()
padRemoveProbe :: a -> SignalHandlerId -> m ()
padRemoveProbe a
pad SignalHandlerId
id = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Pad -> SignalHandlerId -> IO ()
gst_pad_remove_probe Ptr Pad
pad' SignalHandlerId
id
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadRemoveProbeMethodInfo
instance (signature ~ (CULong -> m ()), MonadIO m, IsPad a) => O.MethodInfo PadRemoveProbeMethodInfo a signature where
    overloadedMethod = padRemoveProbe

#endif

-- method Pad::send_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad to send the event to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gst" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstEvent to send to the pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_send_event" gst_pad_send_event :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Event.Event ->                  -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    IO CInt

-- | Sends the event to the pad. This function can be used
-- by applications to send events in the pipeline.
-- 
-- If /@pad@/ is a source pad, /@event@/ should be an upstream event. If /@pad@/ is a
-- sink pad, /@event@/ should be a downstream event. For example, you would not
-- send a @/GST_EVENT_EOS/@ on a src pad; EOS events only propagate downstream.
-- Furthermore, some downstream events have to be serialized with data flow,
-- like EOS, while some can travel out-of-band, like @/GST_EVENT_FLUSH_START/@. If
-- the event needs to be serialized with data flow, this function will take the
-- pad\'s stream lock while calling its event function.
-- 
-- To find out whether an event type is upstream, downstream, or downstream and
-- serialized, see t'GI.Gst.Flags.EventTypeFlags', 'GI.Gst.Functions.eventTypeGetFlags',
-- @/GST_EVENT_IS_UPSTREAM/@, @/GST_EVENT_IS_DOWNSTREAM/@, and
-- @/GST_EVENT_IS_SERIALIZED/@. Note that in practice that an application or
-- plugin doesn\'t need to bother itself with this information; the core handles
-- all necessary locks and checks.
-- 
-- This function takes ownership of the provided event so you should
-- @/gst_event_ref()/@ it if you want to reuse the event after this call.
padSendEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' to send the event to.
    -> Gst.Event.Event
    -- ^ /@event@/: the t'GI.Gst.Structs.Event.Event' to send to the pad.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the event was handled.
padSendEvent :: a -> Event -> m Bool
padSendEvent a
pad Event
event = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Event
event
    CInt
result <- Ptr Pad -> Ptr Event -> IO CInt
gst_pad_send_event Ptr Pad
pad' Ptr Event
event'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadSendEventMethodInfo
instance (signature ~ (Gst.Event.Event -> m Bool), MonadIO m, IsPad a) => O.MethodInfo PadSendEventMethodInfo a signature where
    overloadedMethod = padSendEvent

#endif

-- method Pad::set_activate_function_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "activate"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "PadActivateFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPadActivateFunction to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user_data passed to @notify"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "notify called when @activate will not be used anymore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_set_activate_function_full" gst_pad_set_activate_function_full :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    FunPtr Gst.Callbacks.C_PadActivateFunction -> -- activate : TInterface (Name {namespace = "Gst", name = "PadActivateFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the given activate function for /@pad@/. The activate function will
-- dispatch to 'GI.Gst.Objects.Pad.padActivateMode' to perform the actual activation.
-- Only makes sense to set on sink pads.
-- 
-- Call this function if your sink pad can start a pull-based task.
padSetActivateFunctionFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad'.
    -> Gst.Callbacks.PadActivateFunction
    -- ^ /@activate@/: the t'GI.Gst.Callbacks.PadActivateFunction' to set.
    -> m ()
padSetActivateFunctionFull :: a -> PadActivateFunction -> m ()
padSetActivateFunctionFull a
pad PadActivateFunction
activate = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    FunPtr C_PadActivateFunction
activate' <- C_PadActivateFunction -> IO (FunPtr C_PadActivateFunction)
Gst.Callbacks.mk_PadActivateFunction (Maybe (Ptr (FunPtr C_PadActivateFunction))
-> PadActivateFunction -> C_PadActivateFunction
Gst.Callbacks.wrap_PadActivateFunction Maybe (Ptr (FunPtr C_PadActivateFunction))
forall a. Maybe a
Nothing PadActivateFunction
activate)
    let userData :: Ptr ()
userData = FunPtr C_PadActivateFunction -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_PadActivateFunction
activate'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr Pad
-> FunPtr C_PadActivateFunction
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gst_pad_set_activate_function_full Ptr Pad
pad' FunPtr C_PadActivateFunction
activate' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadSetActivateFunctionFullMethodInfo
instance (signature ~ (Gst.Callbacks.PadActivateFunction -> m ()), MonadIO m, IsPad a) => O.MethodInfo PadSetActivateFunctionFullMethodInfo a signature where
    overloadedMethod = padSetActivateFunctionFull

#endif

-- method Pad::set_activatemode_function_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "activatemode"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "PadActivateModeFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPadActivateModeFunction to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user_data passed to @notify"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "notify called when @activatemode will not be used anymore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_set_activatemode_function_full" gst_pad_set_activatemode_function_full :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    FunPtr Gst.Callbacks.C_PadActivateModeFunction -> -- activatemode : TInterface (Name {namespace = "Gst", name = "PadActivateModeFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the given activate_mode function for the pad. An activate_mode function
-- prepares the element for data passing.
padSetActivatemodeFunctionFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad'.
    -> Gst.Callbacks.PadActivateModeFunction
    -- ^ /@activatemode@/: the t'GI.Gst.Callbacks.PadActivateModeFunction' to set.
    -> m ()
padSetActivatemodeFunctionFull :: a -> PadActivateModeFunction -> m ()
padSetActivatemodeFunctionFull a
pad PadActivateModeFunction
activatemode = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    FunPtr C_PadActivateModeFunction
activatemode' <- C_PadActivateModeFunction -> IO (FunPtr C_PadActivateModeFunction)
Gst.Callbacks.mk_PadActivateModeFunction (Maybe (Ptr (FunPtr C_PadActivateModeFunction))
-> PadActivateModeFunction -> C_PadActivateModeFunction
Gst.Callbacks.wrap_PadActivateModeFunction Maybe (Ptr (FunPtr C_PadActivateModeFunction))
forall a. Maybe a
Nothing PadActivateModeFunction
activatemode)
    let userData :: Ptr ()
userData = FunPtr C_PadActivateModeFunction -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_PadActivateModeFunction
activatemode'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr Pad
-> FunPtr C_PadActivateModeFunction
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gst_pad_set_activatemode_function_full Ptr Pad
pad' FunPtr C_PadActivateModeFunction
activatemode' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadSetActivatemodeFunctionFullMethodInfo
instance (signature ~ (Gst.Callbacks.PadActivateModeFunction -> m ()), MonadIO m, IsPad a) => O.MethodInfo PadSetActivatemodeFunctionFullMethodInfo a signature where
    overloadedMethod = padSetActivatemodeFunctionFull

#endif

-- method Pad::set_active
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to activate or deactivate."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "active"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether or not the pad should be active."
--                 , 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_pad_set_active" gst_pad_set_active :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    CInt ->                                 -- active : TBasicType TBoolean
    IO CInt

-- | Activates or deactivates the given pad.
-- Normally called from within core state change functions.
-- 
-- If /@active@/, makes sure the pad is active. If it is already active, either in
-- push or pull mode, just return. Otherwise dispatches to the pad\'s activate
-- function to perform the actual activation.
-- 
-- If not /@active@/, calls 'GI.Gst.Objects.Pad.padActivateMode' with the pad\'s current mode
-- and a 'P.False' argument.
padSetActive ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to activate or deactivate.
    -> Bool
    -- ^ /@active@/: whether or not the pad should be active.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the operation was successful.
    -- 
    -- MT safe.
padSetActive :: a -> Bool -> m Bool
padSetActive a
pad Bool
active = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    let active' :: CInt
active' = (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
active
    CInt
result <- Ptr Pad -> CInt -> IO CInt
gst_pad_set_active Ptr Pad
pad' CInt
active'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadSetActiveMethodInfo
instance (signature ~ (Bool -> m Bool), MonadIO m, IsPad a) => O.MethodInfo PadSetActiveMethodInfo a signature where
    overloadedMethod = padSetActive

#endif

-- method Pad::set_chain_function_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a sink #GstPad." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "chain"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadChainFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPadChainFunction to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user_data passed to @notify"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "notify called when @chain will not be used anymore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_set_chain_function_full" gst_pad_set_chain_function_full :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    FunPtr Gst.Callbacks.C_PadChainFunction -> -- chain : TInterface (Name {namespace = "Gst", name = "PadChainFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the given chain function for the pad. The chain function is called to
-- process a t'GI.Gst.Structs.Buffer.Buffer' input buffer. see t'GI.Gst.Callbacks.PadChainFunction' for more details.
padSetChainFunctionFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a sink t'GI.Gst.Objects.Pad.Pad'.
    -> Gst.Callbacks.PadChainFunction
    -- ^ /@chain@/: the t'GI.Gst.Callbacks.PadChainFunction' to set.
    -> m ()
padSetChainFunctionFull :: a -> PadChainFunction -> m ()
padSetChainFunctionFull a
pad PadChainFunction
chain = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    FunPtr C_PadChainFunction
chain' <- C_PadChainFunction -> IO (FunPtr C_PadChainFunction)
Gst.Callbacks.mk_PadChainFunction (Maybe (Ptr (FunPtr C_PadChainFunction))
-> PadChainFunction -> C_PadChainFunction
Gst.Callbacks.wrap_PadChainFunction Maybe (Ptr (FunPtr C_PadChainFunction))
forall a. Maybe a
Nothing PadChainFunction
chain)
    let userData :: Ptr ()
userData = FunPtr C_PadChainFunction -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_PadChainFunction
chain'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr Pad
-> FunPtr C_PadChainFunction
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gst_pad_set_chain_function_full Ptr Pad
pad' FunPtr C_PadChainFunction
chain' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadSetChainFunctionFullMethodInfo
instance (signature ~ (Gst.Callbacks.PadChainFunction -> m ()), MonadIO m, IsPad a) => O.MethodInfo PadSetChainFunctionFullMethodInfo a signature where
    overloadedMethod = padSetChainFunctionFull

#endif

-- method Pad::set_chain_list_function_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a sink #GstPad." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "chainlist"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "PadChainListFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPadChainListFunction to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user_data passed to @notify"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "notify called when @chainlist will not be used anymore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_set_chain_list_function_full" gst_pad_set_chain_list_function_full :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    FunPtr Gst.Callbacks.C_PadChainListFunction -> -- chainlist : TInterface (Name {namespace = "Gst", name = "PadChainListFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the given chain list function for the pad. The chainlist function is
-- called to process a t'GI.Gst.Structs.BufferList.BufferList' input buffer list. See
-- t'GI.Gst.Callbacks.PadChainListFunction' for more details.
padSetChainListFunctionFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a sink t'GI.Gst.Objects.Pad.Pad'.
    -> Gst.Callbacks.PadChainListFunction
    -- ^ /@chainlist@/: the t'GI.Gst.Callbacks.PadChainListFunction' to set.
    -> m ()
padSetChainListFunctionFull :: a -> PadChainListFunction -> m ()
padSetChainListFunctionFull a
pad PadChainListFunction
chainlist = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    FunPtr C_PadChainListFunction
chainlist' <- C_PadChainListFunction -> IO (FunPtr C_PadChainListFunction)
Gst.Callbacks.mk_PadChainListFunction (Maybe (Ptr (FunPtr C_PadChainListFunction))
-> PadChainListFunction -> C_PadChainListFunction
Gst.Callbacks.wrap_PadChainListFunction Maybe (Ptr (FunPtr C_PadChainListFunction))
forall a. Maybe a
Nothing PadChainListFunction
chainlist)
    let userData :: Ptr ()
userData = FunPtr C_PadChainListFunction -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_PadChainListFunction
chainlist'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr Pad
-> FunPtr C_PadChainListFunction
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gst_pad_set_chain_list_function_full Ptr Pad
pad' FunPtr C_PadChainListFunction
chainlist' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadSetChainListFunctionFullMethodInfo
instance (signature ~ (Gst.Callbacks.PadChainListFunction -> m ()), MonadIO m, IsPad a) => O.MethodInfo PadSetChainListFunctionFullMethodInfo a signature where
    overloadedMethod = padSetChainListFunctionFull

#endif

-- method Pad::set_element_private
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to set the private data of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priv"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The private data to attach to the pad."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_set_element_private" gst_pad_set_element_private :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr () ->                               -- priv : TBasicType TPtr
    IO ()

-- | Set the given private data gpointer on the pad.
-- This function can only be used by the element that owns the pad.
-- No locking is performed in this function.
padSetElementPrivate ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to set the private data of.
    -> Ptr ()
    -- ^ /@priv@/: The private data to attach to the pad.
    -> m ()
padSetElementPrivate :: a -> Ptr () -> m ()
padSetElementPrivate a
pad Ptr ()
priv = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Pad -> C_DestroyNotify
gst_pad_set_element_private Ptr Pad
pad' Ptr ()
priv
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadSetElementPrivateMethodInfo
instance (signature ~ (Ptr () -> m ()), MonadIO m, IsPad a) => O.MethodInfo PadSetElementPrivateMethodInfo a signature where
    overloadedMethod = padSetElementPrivate

#endif

-- method Pad::set_event_full_function_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad of either direction."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "PadEventFullFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPadEventFullFunction to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user_data passed to @notify"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "notify called when @event will not be used anymore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_set_event_full_function_full" gst_pad_set_event_full_function_full :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    FunPtr Gst.Callbacks.C_PadEventFullFunction -> -- event : TInterface (Name {namespace = "Gst", name = "PadEventFullFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the given event handler for the pad.
-- 
-- /Since: 1.8/
padSetEventFullFunctionFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' of either direction.
    -> Gst.Callbacks.PadEventFullFunction
    -- ^ /@event@/: the t'GI.Gst.Callbacks.PadEventFullFunction' to set.
    -> m ()
padSetEventFullFunctionFull :: a -> PadEventFullFunction -> m ()
padSetEventFullFunctionFull a
pad PadEventFullFunction
event = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt)
event' <- (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt)
-> IO (FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt))
Gst.Callbacks.mk_PadEventFullFunction (Maybe
  (Ptr (FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt)))
-> PadEventFullFunction
-> Ptr Pad
-> Ptr Object
-> Ptr Event
-> IO CInt
Gst.Callbacks.wrap_PadEventFullFunction Maybe
  (Ptr (FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt)))
forall a. Maybe a
Nothing PadEventFullFunction
event)
    let userData :: Ptr ()
userData = FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt) -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt)
event'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr Pad
-> FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt)
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gst_pad_set_event_full_function_full Ptr Pad
pad' FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt)
event' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadSetEventFullFunctionFullMethodInfo
instance (signature ~ (Gst.Callbacks.PadEventFullFunction -> m ()), MonadIO m, IsPad a) => O.MethodInfo PadSetEventFullFunctionFullMethodInfo a signature where
    overloadedMethod = padSetEventFullFunctionFull

#endif

-- method Pad::set_event_function_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad of either direction."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadEventFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPadEventFunction to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user_data passed to @notify"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "notify called when @event will not be used anymore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_set_event_function_full" gst_pad_set_event_function_full :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    FunPtr Gst.Callbacks.C_PadEventFunction -> -- event : TInterface (Name {namespace = "Gst", name = "PadEventFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the given event handler for the pad.
padSetEventFunctionFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' of either direction.
    -> Gst.Callbacks.PadEventFunction
    -- ^ /@event@/: the t'GI.Gst.Callbacks.PadEventFunction' to set.
    -> m ()
padSetEventFunctionFull :: a -> PadEventFunction -> m ()
padSetEventFunctionFull a
pad PadEventFunction
event = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt)
event' <- (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt)
-> IO (FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt))
Gst.Callbacks.mk_PadEventFunction (Maybe
  (Ptr (FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt)))
-> PadEventFunction
-> Ptr Pad
-> Ptr Object
-> Ptr Event
-> IO CInt
Gst.Callbacks.wrap_PadEventFunction Maybe
  (Ptr (FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt)))
forall a. Maybe a
Nothing PadEventFunction
event)
    let userData :: Ptr ()
userData = FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt) -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt)
event'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr Pad
-> FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt)
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gst_pad_set_event_function_full Ptr Pad
pad' FunPtr (Ptr Pad -> Ptr Object -> Ptr Event -> IO CInt)
event' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadSetEventFunctionFullMethodInfo
instance (signature ~ (Gst.Callbacks.PadEventFunction -> m ()), MonadIO m, IsPad a) => O.MethodInfo PadSetEventFunctionFullMethodInfo a signature where
    overloadedMethod = padSetEventFunctionFull

#endif

-- method Pad::set_getrange_function_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a source #GstPad." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "get"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "PadGetRangeFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPadGetRangeFunction to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user_data passed to @notify"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "notify called when @get will not be used anymore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_set_getrange_function_full" gst_pad_set_getrange_function_full :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    FunPtr Gst.Callbacks.C_PadGetRangeFunction -> -- get : TInterface (Name {namespace = "Gst", name = "PadGetRangeFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the given getrange function for the pad. The getrange function is
-- called to produce a new t'GI.Gst.Structs.Buffer.Buffer' to start the processing pipeline. see
-- t'GI.Gst.Callbacks.PadGetRangeFunction' for a description of the getrange function.
padSetGetrangeFunctionFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a source t'GI.Gst.Objects.Pad.Pad'.
    -> Gst.Callbacks.PadGetRangeFunction
    -- ^ /@get@/: the t'GI.Gst.Callbacks.PadGetRangeFunction' to set.
    -> m ()
padSetGetrangeFunctionFull :: a -> PadGetRangeFunction -> m ()
padSetGetrangeFunctionFull a
pad PadGetRangeFunction
get = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    FunPtr C_PadGetRangeFunction
get' <- C_PadGetRangeFunction -> IO (FunPtr C_PadGetRangeFunction)
Gst.Callbacks.mk_PadGetRangeFunction (Maybe (Ptr (FunPtr C_PadGetRangeFunction))
-> PadGetRangeFunction -> C_PadGetRangeFunction
Gst.Callbacks.wrap_PadGetRangeFunction Maybe (Ptr (FunPtr C_PadGetRangeFunction))
forall a. Maybe a
Nothing PadGetRangeFunction
get)
    let userData :: Ptr ()
userData = FunPtr C_PadGetRangeFunction -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_PadGetRangeFunction
get'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr Pad
-> FunPtr C_PadGetRangeFunction
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gst_pad_set_getrange_function_full Ptr Pad
pad' FunPtr C_PadGetRangeFunction
get' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadSetGetrangeFunctionFullMethodInfo
instance (signature ~ (Gst.Callbacks.PadGetRangeFunction -> m ()), MonadIO m, IsPad a) => O.MethodInfo PadSetGetrangeFunctionFullMethodInfo a signature where
    overloadedMethod = padSetGetrangeFunctionFull

#endif

-- method Pad::set_iterate_internal_links_function_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad of either direction."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iterintlink"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "PadIterIntLinkFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPadIterIntLinkFunction to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user_data passed to @notify"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "notify called when @iterintlink will not be used anymore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_set_iterate_internal_links_function_full" gst_pad_set_iterate_internal_links_function_full :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    FunPtr Gst.Callbacks.C_PadIterIntLinkFunction -> -- iterintlink : TInterface (Name {namespace = "Gst", name = "PadIterIntLinkFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the given internal link iterator function for the pad.
padSetIterateInternalLinksFunctionFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' of either direction.
    -> Gst.Callbacks.PadIterIntLinkFunction
    -- ^ /@iterintlink@/: the t'GI.Gst.Callbacks.PadIterIntLinkFunction' to set.
    -> m ()
padSetIterateInternalLinksFunctionFull :: a -> PadIterIntLinkFunction -> m ()
padSetIterateInternalLinksFunctionFull a
pad PadIterIntLinkFunction
iterintlink = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    FunPtr (Ptr Pad -> Ptr Object -> IO (Ptr Iterator))
iterintlink' <- (Ptr Pad -> Ptr Object -> IO (Ptr Iterator))
-> IO (FunPtr (Ptr Pad -> Ptr Object -> IO (Ptr Iterator)))
Gst.Callbacks.mk_PadIterIntLinkFunction (Maybe (Ptr (FunPtr (Ptr Pad -> Ptr Object -> IO (Ptr Iterator))))
-> PadIterIntLinkFunction
-> Ptr Pad
-> Ptr Object
-> IO (Ptr Iterator)
Gst.Callbacks.wrap_PadIterIntLinkFunction Maybe (Ptr (FunPtr (Ptr Pad -> Ptr Object -> IO (Ptr Iterator))))
forall a. Maybe a
Nothing PadIterIntLinkFunction
iterintlink)
    let userData :: Ptr ()
userData = FunPtr (Ptr Pad -> Ptr Object -> IO (Ptr Iterator)) -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr (Ptr Pad -> Ptr Object -> IO (Ptr Iterator))
iterintlink'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr Pad
-> FunPtr (Ptr Pad -> Ptr Object -> IO (Ptr Iterator))
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gst_pad_set_iterate_internal_links_function_full Ptr Pad
pad' FunPtr (Ptr Pad -> Ptr Object -> IO (Ptr Iterator))
iterintlink' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadSetIterateInternalLinksFunctionFullMethodInfo
instance (signature ~ (Gst.Callbacks.PadIterIntLinkFunction -> m ()), MonadIO m, IsPad a) => O.MethodInfo PadSetIterateInternalLinksFunctionFullMethodInfo a signature where
    overloadedMethod = padSetIterateInternalLinksFunctionFull

#endif

-- method Pad::set_link_function_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "link"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadLinkFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPadLinkFunction to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user_data passed to @notify"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "notify called when @link will not be used anymore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_set_link_function_full" gst_pad_set_link_function_full :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    FunPtr Gst.Callbacks.C_PadLinkFunction -> -- link : TInterface (Name {namespace = "Gst", name = "PadLinkFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the given link function for the pad. It will be called when
-- the pad is linked with another pad.
-- 
-- The return value @/GST_PAD_LINK_OK/@ should be used when the connection can be
-- made.
-- 
-- The return value @/GST_PAD_LINK_REFUSED/@ should be used when the connection
-- cannot be made for some reason.
-- 
-- If /@link@/ is installed on a source pad, it should call the t'GI.Gst.Callbacks.PadLinkFunction'
-- of the peer sink pad, if present.
padSetLinkFunctionFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad'.
    -> Gst.Callbacks.PadLinkFunction
    -- ^ /@link@/: the t'GI.Gst.Callbacks.PadLinkFunction' to set.
    -> m ()
padSetLinkFunctionFull :: a -> PadLinkFunction -> m ()
padSetLinkFunctionFull a
pad PadLinkFunction
link = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    FunPtr C_PadLinkFunction
link' <- C_PadLinkFunction -> IO (FunPtr C_PadLinkFunction)
Gst.Callbacks.mk_PadLinkFunction (Maybe (Ptr (FunPtr C_PadLinkFunction))
-> PadLinkFunction -> C_PadLinkFunction
Gst.Callbacks.wrap_PadLinkFunction Maybe (Ptr (FunPtr C_PadLinkFunction))
forall a. Maybe a
Nothing PadLinkFunction
link)
    let userData :: Ptr ()
userData = FunPtr C_PadLinkFunction -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_PadLinkFunction
link'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr Pad
-> FunPtr C_PadLinkFunction
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gst_pad_set_link_function_full Ptr Pad
pad' FunPtr C_PadLinkFunction
link' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadSetLinkFunctionFullMethodInfo
instance (signature ~ (Gst.Callbacks.PadLinkFunction -> m ()), MonadIO m, IsPad a) => O.MethodInfo PadSetLinkFunctionFullMethodInfo a signature where
    overloadedMethod = padSetLinkFunctionFull

#endif

-- method Pad::set_offset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the offset" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_set_offset" gst_pad_set_offset :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Int64 ->                                -- offset : TBasicType TInt64
    IO ()

-- | Set the offset that will be applied to the running time of /@pad@/.
padSetOffset ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad'
    -> Int64
    -- ^ /@offset@/: the offset
    -> m ()
padSetOffset :: a -> Int64 -> m ()
padSetOffset a
pad Int64
offset = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Pad -> Int64 -> IO ()
gst_pad_set_offset Ptr Pad
pad' Int64
offset
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadSetOffsetMethodInfo
instance (signature ~ (Int64 -> m ()), MonadIO m, IsPad a) => O.MethodInfo PadSetOffsetMethodInfo a signature where
    overloadedMethod = padSetOffset

#endif

-- method Pad::set_query_function_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad of either direction."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadQueryFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPadQueryFunction to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user_data passed to @notify"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "notify called when @query will not be used anymore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_set_query_function_full" gst_pad_set_query_function_full :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    FunPtr Gst.Callbacks.C_PadQueryFunction -> -- query : TInterface (Name {namespace = "Gst", name = "PadQueryFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Set the given query function for the pad.
padSetQueryFunctionFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad' of either direction.
    -> Gst.Callbacks.PadQueryFunction
    -- ^ /@query@/: the t'GI.Gst.Callbacks.PadQueryFunction' to set.
    -> m ()
padSetQueryFunctionFull :: a -> PadQueryFunction -> m ()
padSetQueryFunctionFull a
pad PadQueryFunction
query = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    FunPtr (Ptr Pad -> Ptr Object -> Ptr Query -> IO CInt)
query' <- (Ptr Pad -> Ptr Object -> Ptr Query -> IO CInt)
-> IO (FunPtr (Ptr Pad -> Ptr Object -> Ptr Query -> IO CInt))
Gst.Callbacks.mk_PadQueryFunction (Maybe
  (Ptr (FunPtr (Ptr Pad -> Ptr Object -> Ptr Query -> IO CInt)))
-> PadQueryFunction
-> Ptr Pad
-> Ptr Object
-> Ptr Query
-> IO CInt
Gst.Callbacks.wrap_PadQueryFunction Maybe
  (Ptr (FunPtr (Ptr Pad -> Ptr Object -> Ptr Query -> IO CInt)))
forall a. Maybe a
Nothing PadQueryFunction
query)
    let userData :: Ptr ()
userData = FunPtr (Ptr Pad -> Ptr Object -> Ptr Query -> IO CInt) -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr (Ptr Pad -> Ptr Object -> Ptr Query -> IO CInt)
query'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr Pad
-> FunPtr (Ptr Pad -> Ptr Object -> Ptr Query -> IO CInt)
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gst_pad_set_query_function_full Ptr Pad
pad' FunPtr (Ptr Pad -> Ptr Object -> Ptr Query -> IO CInt)
query' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadSetQueryFunctionFullMethodInfo
instance (signature ~ (Gst.Callbacks.PadQueryFunction -> m ()), MonadIO m, IsPad a) => O.MethodInfo PadSetQueryFunctionFullMethodInfo a signature where
    overloadedMethod = padSetQueryFunctionFull

#endif

-- method Pad::set_unlink_function_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "unlink"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadUnlinkFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPadUnlinkFunction to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user_data passed to @notify"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "notify called when @unlink will not be used anymore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_set_unlink_function_full" gst_pad_set_unlink_function_full :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    FunPtr Gst.Callbacks.C_PadUnlinkFunction -> -- unlink : TInterface (Name {namespace = "Gst", name = "PadUnlinkFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the given unlink function for the pad. It will be called
-- when the pad is unlinked.
-- 
-- Note that the pad\'s lock is already held when the unlink
-- function is called, so most pad functions cannot be called
-- from within the callback.
padSetUnlinkFunctionFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad'.
    -> Gst.Callbacks.PadUnlinkFunction
    -- ^ /@unlink@/: the t'GI.Gst.Callbacks.PadUnlinkFunction' to set.
    -> m ()
padSetUnlinkFunctionFull :: a -> PadUnlinkFunction -> m ()
padSetUnlinkFunctionFull a
pad PadUnlinkFunction
unlink = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    FunPtr C_PadUnlinkFunction
unlink' <- C_PadUnlinkFunction -> IO (FunPtr C_PadUnlinkFunction)
Gst.Callbacks.mk_PadUnlinkFunction (Maybe (Ptr (FunPtr C_PadUnlinkFunction))
-> PadUnlinkFunction -> C_PadUnlinkFunction
Gst.Callbacks.wrap_PadUnlinkFunction Maybe (Ptr (FunPtr C_PadUnlinkFunction))
forall a. Maybe a
Nothing PadUnlinkFunction
unlink)
    let userData :: Ptr ()
userData = FunPtr C_PadUnlinkFunction -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_PadUnlinkFunction
unlink'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr Pad
-> FunPtr C_PadUnlinkFunction
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gst_pad_set_unlink_function_full Ptr Pad
pad' FunPtr C_PadUnlinkFunction
unlink' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadSetUnlinkFunctionFullMethodInfo
instance (signature ~ (Gst.Callbacks.PadUnlinkFunction -> m ()), MonadIO m, IsPad a) => O.MethodInfo PadSetUnlinkFunctionFullMethodInfo a signature where
    overloadedMethod = padSetUnlinkFunctionFull

#endif

-- method Pad::start_task
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to start the task of"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TaskFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the task function to call"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to the task function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "called when @user_data is no longer referenced"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_start_task" gst_pad_start_task :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    FunPtr Gst.Callbacks.C_TaskFunction ->  -- func : TInterface (Name {namespace = "Gst", name = "TaskFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO CInt

-- | Starts a task that repeatedly calls /@func@/ with /@userData@/. This function
-- is mostly used in pad activation functions to start the dataflow.
-- The @/GST_PAD_STREAM_LOCK/@ of /@pad@/ will automatically be acquired
-- before /@func@/ is called.
padStartTask ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to start the task of
    -> Gst.Callbacks.TaskFunction
    -- ^ /@func@/: the task function to call
    -> m Bool
    -- ^ __Returns:__ a 'P.True' if the task could be started.
padStartTask :: a -> IO () -> m Bool
padStartTask a
pad IO ()
func = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    FunPtr C_DestroyNotify
func' <- C_DestroyNotify -> IO (FunPtr C_DestroyNotify)
Gst.Callbacks.mk_TaskFunction (Maybe (Ptr (FunPtr C_DestroyNotify))
-> C_DestroyNotify -> C_DestroyNotify
Gst.Callbacks.wrap_TaskFunction Maybe (Ptr (FunPtr C_DestroyNotify))
forall a. Maybe a
Nothing (IO () -> C_DestroyNotify
Gst.Callbacks.drop_closures_TaskFunction IO ()
func))
    let userData :: Ptr ()
userData = FunPtr C_DestroyNotify -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_DestroyNotify
func'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    CInt
result <- Ptr Pad
-> FunPtr C_DestroyNotify
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO CInt
gst_pad_start_task Ptr Pad
pad' FunPtr C_DestroyNotify
func' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadStartTaskMethodInfo
instance (signature ~ (Gst.Callbacks.TaskFunction -> m Bool), MonadIO m, IsPad a) => O.MethodInfo PadStartTaskMethodInfo a signature where
    overloadedMethod = padStartTask

#endif

-- method Pad::sticky_events_foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GstPad that should be used for iteration."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "foreach_func"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "Gst" , name = "PadStickyEventsForeachFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GstPadStickyEventsForeachFunction that\n               should be called for every event."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the optional user data."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_sticky_events_foreach" gst_pad_sticky_events_foreach :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    FunPtr Gst.Callbacks.C_PadStickyEventsForeachFunction -> -- foreach_func : TInterface (Name {namespace = "Gst", name = "PadStickyEventsForeachFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Iterates all sticky events on /@pad@/ and calls /@foreachFunc@/ for every
-- event. If /@foreachFunc@/ returns 'P.False' the iteration is immediately stopped.
padStickyEventsForeach ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' that should be used for iteration.
    -> Gst.Callbacks.PadStickyEventsForeachFunction
    -- ^ /@foreachFunc@/: the t'GI.Gst.Callbacks.PadStickyEventsForeachFunction' that
    --                should be called for every event.
    -> m ()
padStickyEventsForeach :: a -> PadStickyEventsForeachFunction -> m ()
padStickyEventsForeach a
pad PadStickyEventsForeachFunction
foreachFunc = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    FunPtr C_PadStickyEventsForeachFunction
foreachFunc' <- C_PadStickyEventsForeachFunction
-> IO (FunPtr C_PadStickyEventsForeachFunction)
Gst.Callbacks.mk_PadStickyEventsForeachFunction (Maybe (Ptr (FunPtr C_PadStickyEventsForeachFunction))
-> PadStickyEventsForeachFunction_WithClosures
-> C_PadStickyEventsForeachFunction
Gst.Callbacks.wrap_PadStickyEventsForeachFunction Maybe (Ptr (FunPtr C_PadStickyEventsForeachFunction))
forall a. Maybe a
Nothing (PadStickyEventsForeachFunction
-> PadStickyEventsForeachFunction_WithClosures
Gst.Callbacks.drop_closures_PadStickyEventsForeachFunction PadStickyEventsForeachFunction
foreachFunc))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Pad
-> FunPtr C_PadStickyEventsForeachFunction -> C_DestroyNotify
gst_pad_sticky_events_foreach Ptr Pad
pad' FunPtr C_PadStickyEventsForeachFunction
foreachFunc' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_PadStickyEventsForeachFunction -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_PadStickyEventsForeachFunction
foreachFunc'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadStickyEventsForeachMethodInfo
instance (signature ~ (Gst.Callbacks.PadStickyEventsForeachFunction -> m ()), MonadIO m, IsPad a) => O.MethodInfo PadStickyEventsForeachMethodInfo a signature where
    overloadedMethod = padStickyEventsForeach

#endif

-- method Pad::stop_task
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to stop the task of"
--                 , 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_pad_stop_task" gst_pad_stop_task :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Stop the task of /@pad@/. This function will also make sure that the
-- function executed by the task will effectively stop if not called
-- from the GstTaskFunction.
-- 
-- This function will deadlock if called from the GstTaskFunction of
-- the task. Use 'GI.Gst.Objects.Task.taskPause' instead.
-- 
-- Regardless of whether the pad has a task, the stream lock is acquired and
-- released so as to ensure that streaming through this pad has finished.
padStopTask ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to stop the task of
    -> m Bool
    -- ^ __Returns:__ a 'P.True' if the task could be stopped or 'P.False' on error.
padStopTask :: a -> m Bool
padStopTask a
pad = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    CInt
result <- Ptr Pad -> IO CInt
gst_pad_stop_task Ptr Pad
pad'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadStopTaskMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPad a) => O.MethodInfo PadStopTaskMethodInfo a signature where
    overloadedMethod = padStopTask

#endif

-- method Pad::store_sticky_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPad" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gst" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstEvent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "FlowReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_store_sticky_event" gst_pad_store_sticky_event :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Event.Event ->                  -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    IO CInt

-- | Store the sticky /@event@/ on /@pad@/
-- 
-- /Since: 1.2/
padStoreStickyEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: a t'GI.Gst.Objects.Pad.Pad'
    -> Gst.Event.Event
    -- ^ /@event@/: a t'GI.Gst.Structs.Event.Event'
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ @/GST_FLOW_OK/@ on success, @/GST_FLOW_FLUSHING/@ when the pad
    -- was flushing or @/GST_FLOW_EOS/@ when the pad was EOS.
padStoreStickyEvent :: a -> Event -> m FlowReturn
padStoreStickyEvent a
pad Event
event = IO FlowReturn -> m FlowReturn
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlowReturn -> m FlowReturn) -> IO FlowReturn -> m FlowReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    CInt
result <- Ptr Pad -> Ptr Event -> IO CInt
gst_pad_store_sticky_event Ptr Pad
pad' Ptr Event
event'
    let result' :: FlowReturn
result' = (Int -> FlowReturn
forall a. Enum a => Int -> a
toEnum (Int -> FlowReturn) -> (CInt -> Int) -> CInt -> FlowReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    FlowReturn -> IO FlowReturn
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data PadStoreStickyEventMethodInfo
instance (signature ~ (Gst.Event.Event -> m Gst.Enums.FlowReturn), MonadIO m, IsPad a) => O.MethodInfo PadStoreStickyEventMethodInfo a signature where
    overloadedMethod = padStoreStickyEvent

#endif

-- method Pad::unlink
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "srcpad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source #GstPad to unlink."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sinkpad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the sink #GstPad to unlink."
--                 , 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_pad_unlink" gst_pad_unlink :: 
    Ptr Pad ->                              -- srcpad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Pad ->                              -- sinkpad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO CInt

-- | Unlinks the source pad from the sink pad. Will emit the [unlinked]("GI.Gst.Objects.Pad#g:signal:unlinked")
-- signal on both pads.
padUnlink ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a, IsPad b) =>
    a
    -- ^ /@srcpad@/: the source t'GI.Gst.Objects.Pad.Pad' to unlink.
    -> b
    -- ^ /@sinkpad@/: the sink t'GI.Gst.Objects.Pad.Pad' to unlink.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pads were unlinked. This function returns 'P.False' if
    -- the pads were not linked together.
    -- 
    -- MT safe.
padUnlink :: a -> b -> m Bool
padUnlink a
srcpad b
sinkpad = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pad
srcpad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
srcpad
    Ptr Pad
sinkpad' <- b -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
sinkpad
    CInt
result <- Ptr Pad -> Ptr Pad -> IO CInt
gst_pad_unlink Ptr Pad
srcpad' Ptr Pad
sinkpad'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
srcpad
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
sinkpad
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PadUnlinkMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsPad a, IsPad b) => O.MethodInfo PadUnlinkMethodInfo a signature where
    overloadedMethod = padUnlink

#endif

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

foreign import ccall "gst_pad_use_fixed_caps" gst_pad_use_fixed_caps :: 
    Ptr Pad ->                              -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO ()

-- | A helper function you can use that sets the FIXED_CAPS flag
-- This way the default CAPS query will always return the negotiated caps
-- or in case the pad is not negotiated, the padtemplate caps.
-- 
-- The negotiated caps are the caps of the last CAPS event that passed on the
-- pad. Use this function on a pad that, once it negotiated to a CAPS, cannot
-- be renegotiated to something else.
padUseFixedCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsPad a) =>
    a
    -- ^ /@pad@/: the pad to use
    -> m ()
padUseFixedCaps :: a -> m ()
padUseFixedCaps a
pad = 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 Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr Pad -> IO ()
gst_pad_use_fixed_caps Ptr Pad
pad'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadUseFixedCapsMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPad a) => O.MethodInfo PadUseFixedCapsMethodInfo a signature where
    overloadedMethod = padUseFixedCaps

#endif

-- method Pad::link_get_name
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "ret"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadLinkReturn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPadLinkReturn to get the name of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_pad_link_get_name" gst_pad_link_get_name :: 
    CInt ->                                 -- ret : TInterface (Name {namespace = "Gst", name = "PadLinkReturn"})
    IO CString

-- | Gets a string representing the given pad-link return.
-- 
-- /Since: 1.4/
padLinkGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.PadLinkReturn
    -- ^ /@ret@/: a t'GI.Gst.Enums.PadLinkReturn' to get the name of.
    -> m T.Text
    -- ^ __Returns:__ a static string with the name of the pad-link return.
padLinkGetName :: PadLinkReturn -> m Text
padLinkGetName PadLinkReturn
ret = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    let ret' :: CInt
ret' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (PadLinkReturn -> Int) -> PadLinkReturn -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PadLinkReturn -> Int
forall a. Enum a => a -> Int
fromEnum) PadLinkReturn
ret
    Ptr CChar
result <- CInt -> IO (Ptr CChar)
gst_pad_link_get_name CInt
ret'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"padLinkGetName" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif