{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Gst.Objects.ProxyPad
    ( 

-- * Exported types
    ProxyPad(..)                            ,
    IsProxyPad                              ,
    toProxyPad                              ,
    noProxyPad                              ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveProxyPadMethod                   ,
#endif


-- ** chainDefault #method:chainDefault#

    proxyPadChainDefault                    ,


-- ** chainListDefault #method:chainListDefault#

    proxyPadChainListDefault                ,


-- ** getInternal #method:getInternal#

#if defined(ENABLE_OVERLOADING)
    ProxyPadGetInternalMethodInfo           ,
#endif
    proxyPadGetInternal                     ,


-- ** getrangeDefault #method:getrangeDefault#

    proxyPadGetrangeDefault                 ,


-- ** iterateInternalLinksDefault #method:iterateInternalLinksDefault#

    proxyPadIterateInternalLinksDefault     ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums
import {-# SOURCE #-} qualified GI.Gst.Objects.Object as Gst.Object
import {-# SOURCE #-} qualified GI.Gst.Objects.Pad as Gst.Pad
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.Iterator as Gst.Iterator

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

instance GObject ProxyPad where
    gobjectType :: IO GType
gobjectType = IO GType
c_gst_proxy_pad_get_type
    

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

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

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `ProxyPad`.
noProxyPad :: Maybe ProxyPad
noProxyPad :: Maybe ProxyPad
noProxyPad = Maybe ProxyPad
forall a. Maybe a
Nothing

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

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

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

-- | Get the internal pad of /@pad@/. Unref target pad after usage.
-- 
-- The internal pad of a t'GI.Gst.Objects.GhostPad.GhostPad' is the internally used
-- pad of opposite direction, which is used to link to the target.
proxyPadGetInternal ::
    (B.CallStack.HasCallStack, MonadIO m, IsProxyPad a) =>
    a
    -- ^ /@pad@/: the t'GI.Gst.Objects.ProxyPad.ProxyPad'
    -> m (Maybe ProxyPad)
    -- ^ __Returns:__ the target t'GI.Gst.Objects.ProxyPad.ProxyPad', can
    -- be 'P.Nothing'.  Unref target pad after usage.
proxyPadGetInternal :: a -> m (Maybe ProxyPad)
proxyPadGetInternal pad :: a
pad = IO (Maybe ProxyPad) -> m (Maybe ProxyPad)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ProxyPad) -> m (Maybe ProxyPad))
-> IO (Maybe ProxyPad) -> m (Maybe ProxyPad)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ProxyPad
pad' <- a -> IO (Ptr ProxyPad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr ProxyPad
result <- Ptr ProxyPad -> IO (Ptr ProxyPad)
gst_proxy_pad_get_internal Ptr ProxyPad
pad'
    Maybe ProxyPad
maybeResult <- Ptr ProxyPad
-> (Ptr ProxyPad -> IO ProxyPad) -> IO (Maybe ProxyPad)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ProxyPad
result ((Ptr ProxyPad -> IO ProxyPad) -> IO (Maybe ProxyPad))
-> (Ptr ProxyPad -> IO ProxyPad) -> IO (Maybe ProxyPad)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr ProxyPad
result' -> do
        ProxyPad
result'' <- ((ManagedPtr ProxyPad -> ProxyPad) -> Ptr ProxyPad -> IO ProxyPad
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ProxyPad -> ProxyPad
ProxyPad) Ptr ProxyPad
result'
        ProxyPad -> IO ProxyPad
forall (m :: * -> *) a. Monad m => a -> m a
return ProxyPad
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    Maybe ProxyPad -> IO (Maybe ProxyPad)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ProxyPad
maybeResult

#if defined(ENABLE_OVERLOADING)
data ProxyPadGetInternalMethodInfo
instance (signature ~ (m (Maybe ProxyPad)), MonadIO m, IsProxyPad a) => O.MethodInfo ProxyPadGetInternalMethodInfo a signature where
    overloadedMethod = proxyPadGetInternal

#endif

-- method ProxyPad::chain_default
-- method type : MemberFunction
-- 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 = "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 = "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_proxy_pad_chain_default" gst_proxy_pad_chain_default :: 
    Ptr Gst.Pad.Pad ->                      -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Object.Object ->                -- parent : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO CInt

-- | Invoke the default chain function of the proxy pad.
proxyPadChainDefault ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Pad.IsPad a, Gst.Object.IsObject b) =>
    a
    -- ^ /@pad@/: a sink t'GI.Gst.Objects.Pad.Pad', returns GST_FLOW_ERROR if not.
    -> Maybe (b)
    -- ^ /@parent@/: the parent of /@pad@/ or 'P.Nothing'
    -> 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.
proxyPadChainDefault :: a -> Maybe b -> Buffer -> m FlowReturn
proxyPadChainDefault pad :: a
pad parent :: Maybe b
parent buffer :: Buffer
buffer = IO FlowReturn -> m FlowReturn
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlowReturn -> m FlowReturn) -> IO FlowReturn -> m FlowReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jParent :: 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 Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Buffer
buffer
    CInt
result <- Ptr Pad -> Ptr Object -> Ptr Buffer -> IO CInt
gst_proxy_pad_chain_default Ptr Pad
pad' Ptr Object
maybeParent 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
    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
    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)
#endif

-- method ProxyPad::chain_list_default
-- method type : MemberFunction
-- 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 = "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 = "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_proxy_pad_chain_list_default" gst_proxy_pad_chain_list_default :: 
    Ptr Gst.Pad.Pad ->                      -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Object.Object ->                -- parent : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.BufferList.BufferList ->        -- list : TInterface (Name {namespace = "Gst", name = "BufferList"})
    IO CInt

-- | Invoke the default chain list function of the proxy pad.
proxyPadChainListDefault ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Pad.IsPad a, Gst.Object.IsObject b) =>
    a
    -- ^ /@pad@/: a sink t'GI.Gst.Objects.Pad.Pad', returns GST_FLOW_ERROR if not.
    -> Maybe (b)
    -- ^ /@parent@/: the parent of /@pad@/ or 'P.Nothing'
    -> 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.
proxyPadChainListDefault :: a -> Maybe b -> BufferList -> m FlowReturn
proxyPadChainListDefault pad :: a
pad parent :: Maybe b
parent list :: 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 Object
maybeParent <- case Maybe b
parent of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jParent :: 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 BufferList
list' <- BufferList -> IO (Ptr BufferList)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed BufferList
list
    CInt
result <- Ptr Pad -> Ptr Object -> Ptr BufferList -> IO CInt
gst_proxy_pad_chain_list_default Ptr Pad
pad' Ptr Object
maybeParent 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
    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
    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)
#endif

-- method ProxyPad::getrange_default
-- method type : MemberFunction
-- 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 = "parent"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent of @pad" , 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_proxy_pad_getrange_default" gst_proxy_pad_getrange_default :: 
    Ptr Gst.Pad.Pad ->                      -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Object.Object ->                -- parent : TInterface (Name {namespace = "Gst", name = "Object"})
    Word64 ->                               -- offset : TBasicType TUInt64
    Word32 ->                               -- size : TBasicType TUInt
    Ptr (Ptr Gst.Buffer.Buffer) ->          -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO CInt

-- | Invoke the default getrange function of the proxy pad.
proxyPadGetrangeDefault ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Pad.IsPad a, Gst.Object.IsObject b) =>
    a
    -- ^ /@pad@/: a src t'GI.Gst.Objects.Pad.Pad', returns @/GST_FLOW_ERROR/@ if not.
    -> b
    -- ^ /@parent@/: the parent of /@pad@/
    -> 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.
proxyPadGetrangeDefault :: a -> b -> Word64 -> Word32 -> m (FlowReturn, Buffer)
proxyPadGetrangeDefault pad :: a
pad parent :: b
parent offset :: Word64
offset size :: 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 Object
parent' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
parent
    Ptr (Ptr Buffer)
buffer <- IO (Ptr (Ptr Buffer))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Buffer.Buffer))
    CInt
result <- Ptr Pad
-> Ptr Object -> Word64 -> Word32 -> Ptr (Ptr Buffer) -> IO CInt
gst_proxy_pad_getrange_default Ptr Pad
pad' Ptr Object
parent' 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, BoxedObject 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
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
parent
    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)
#endif

-- method ProxyPad::iterate_internal_links_default
-- method type : MemberFunction
-- 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_proxy_pad_iterate_internal_links_default" gst_proxy_pad_iterate_internal_links_default :: 
    Ptr Gst.Pad.Pad ->                      -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    Ptr Gst.Object.Object ->                -- parent : TInterface (Name {namespace = "Gst", name = "Object"})
    IO (Ptr Gst.Iterator.Iterator)

-- | Invoke the default iterate internal links function of the proxy pad.
proxyPadIterateInternalLinksDefault ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Pad.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'.
proxyPadIterateInternalLinksDefault :: a -> Maybe b -> m (Maybe Iterator)
proxyPadIterateInternalLinksDefault pad :: a
pad parent :: 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
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jParent :: 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_proxy_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
$ \result' :: Ptr Iterator
result' -> do
        Iterator
result'' <- ((ManagedPtr Iterator -> Iterator) -> Ptr Iterator -> IO Iterator
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Iterator -> Iterator
Gst.Iterator.Iterator) Ptr Iterator
result'
        Iterator -> IO Iterator
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
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)
#endif