{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Padtemplates describe the possible media types a pad or an elementfactory can
-- handle. This allows for both inspection of handled types before loading the
-- element plugin as well as identifying pads on elements that are not yet
-- created (request or sometimes pads).
-- 
-- Pad and PadTemplates have t'GI.Gst.Structs.Caps.Caps' attached to it to describe the media type
-- they are capable of dealing with. 'GI.Gst.Objects.PadTemplate.padTemplateGetCaps' or
-- @/GST_PAD_TEMPLATE_CAPS()/@ are used to get the caps of a padtemplate. It\'s not
-- possible to modify the caps of a padtemplate after creation.
-- 
-- PadTemplates have a t'GI.Gst.Enums.PadPresence' property which identifies the lifetime
-- of the pad and that can be retrieved with @/GST_PAD_TEMPLATE_PRESENCE()/@. Also
-- the direction of the pad can be retrieved from the t'GI.Gst.Objects.PadTemplate.PadTemplate' with
-- @/GST_PAD_TEMPLATE_DIRECTION()/@.
-- 
-- The GST_PAD_TEMPLATE_NAME_TEMPLATE () is important for GST_PAD_REQUEST pads
-- because it has to be used as the name in the 'GI.Gst.Objects.Element.elementGetRequestPad'
-- call to instantiate a pad from this template.
-- 
-- Padtemplates can be created with 'GI.Gst.Objects.PadTemplate.padTemplateNew' or with
-- gst_static_pad_template_get (), which creates a t'GI.Gst.Objects.PadTemplate.PadTemplate' from a
-- t'GI.Gst.Structs.StaticPadTemplate.StaticPadTemplate' that can be filled with the
-- convenient @/GST_STATIC_PAD_TEMPLATE()/@ macro.
-- 
-- A padtemplate can be used to create a pad (see 'GI.Gst.Objects.Pad.padNewFromTemplate'
-- or gst_pad_new_from_static_template ()) or to add to an element class
-- (see gst_element_class_add_static_pad_template ()).
-- 
-- The following code example shows the code to create a pad from a padtemplate.
-- 
-- === /C code/
-- >
-- >  GstStaticPadTemplate my_template =
-- >  GST_STATIC_PAD_TEMPLATE (
-- >    "sink",          // the name of the pad
-- >    GST_PAD_SINK,    // the direction of the pad
-- >    GST_PAD_ALWAYS,  // when this pad will be present
-- >    GST_STATIC_CAPS (        // the capabilities of the padtemplate
-- >      "audio/x-raw, "
-- >        "channels = (int) [ 1, 6 ]"
-- >    )
-- >  );
-- >  void
-- >  my_method (void)
-- >  {
-- >    GstPad *pad;
-- >    pad = gst_pad_new_from_static_template (&my_template, "sink");
-- >    ...
-- >  }
-- 
-- 
-- The following example shows you how to add the padtemplate to an
-- element class, this is usually done in the class_init of the class:
-- 
-- === /C code/
-- >
-- >  static void
-- >  my_element_class_init (GstMyElementClass *klass)
-- >  {
-- >    GstElementClass *gstelement_class = GST_ELEMENT_CLASS (klass);
-- >
-- >    gst_element_class_add_static_pad_template (gstelement_class, &my_template);
-- >  }
-- 

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

module GI.Gst.Objects.PadTemplate
    ( 

-- * Exported types
    PadTemplate(..)                         ,
    IsPadTemplate                           ,
    toPadTemplate                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolvePadTemplateMethod                ,
#endif


-- ** getCaps #method:getCaps#

#if defined(ENABLE_OVERLOADING)
    PadTemplateGetCapsMethodInfo            ,
#endif
    padTemplateGetCaps                      ,


-- ** new #method:new#

    padTemplateNew                          ,


-- ** newFromStaticPadTemplateWithGtype #method:newFromStaticPadTemplateWithGtype#

    padTemplateNewFromStaticPadTemplateWithGtype,


-- ** newWithGtype #method:newWithGtype#

    padTemplateNewWithGtype                 ,


-- ** padCreated #method:padCreated#

#if defined(ENABLE_OVERLOADING)
    PadTemplatePadCreatedMethodInfo         ,
#endif
    padTemplatePadCreated                   ,




 -- * Properties
-- ** caps #attr:caps#
-- | The capabilities of the pad described by the pad template.

#if defined(ENABLE_OVERLOADING)
    PadTemplateCapsPropertyInfo             ,
#endif
    constructPadTemplateCaps                ,
    getPadTemplateCaps                      ,
#if defined(ENABLE_OVERLOADING)
    padTemplateCaps                         ,
#endif


-- ** direction #attr:direction#
-- | The direction of the pad described by the pad template.

#if defined(ENABLE_OVERLOADING)
    PadTemplateDirectionPropertyInfo        ,
#endif
    constructPadTemplateDirection           ,
    getPadTemplateDirection                 ,
#if defined(ENABLE_OVERLOADING)
    padTemplateDirection                    ,
#endif


-- ** gtype #attr:gtype#
-- | The type of the pad described by the pad template.
-- 
-- /Since: 1.14/

#if defined(ENABLE_OVERLOADING)
    PadTemplateGtypePropertyInfo            ,
#endif
    constructPadTemplateGtype               ,
    getPadTemplateGtype                     ,
#if defined(ENABLE_OVERLOADING)
    padTemplateGtype                        ,
#endif


-- ** nameTemplate #attr:nameTemplate#
-- | The name template of the pad template.

#if defined(ENABLE_OVERLOADING)
    PadTemplateNameTemplatePropertyInfo     ,
#endif
    constructPadTemplateNameTemplate        ,
    getPadTemplateNameTemplate              ,
#if defined(ENABLE_OVERLOADING)
    padTemplateNameTemplate                 ,
#endif


-- ** presence #attr:presence#
-- | When the pad described by the pad template will become available.

#if defined(ENABLE_OVERLOADING)
    PadTemplatePresencePropertyInfo         ,
#endif
    constructPadTemplatePresence            ,
    getPadTemplatePresence                  ,
#if defined(ENABLE_OVERLOADING)
    padTemplatePresence                     ,
#endif




 -- * Signals
-- ** padCreated #signal:padCreated#

    C_PadTemplatePadCreatedCallback         ,
    PadTemplatePadCreatedCallback           ,
#if defined(ENABLE_OVERLOADING)
    PadTemplatePadCreatedSignalInfo         ,
#endif
    afterPadTemplatePadCreated              ,
    genClosure_PadTemplatePadCreated        ,
    mk_PadTemplatePadCreatedCallback        ,
    noPadTemplatePadCreatedCallback         ,
    onPadTemplatePadCreated                 ,
    wrap_PadTemplatePadCreatedCallback      ,




    ) 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.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.Caps as Gst.Caps
import {-# SOURCE #-} qualified GI.Gst.Structs.StaticPadTemplate as Gst.StaticPadTemplate

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

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

foreign import ccall "gst_pad_template_get_type"
    c_gst_pad_template_get_type :: IO B.Types.GType

instance B.Types.TypedObject PadTemplate where
    glibType :: IO GType
glibType = IO GType
c_gst_pad_template_get_type

instance B.Types.GObject PadTemplate

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolvePadTemplateMethod (t :: Symbol) (o :: *) :: * where
    ResolvePadTemplateMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolvePadTemplateMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePadTemplateMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePadTemplateMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolvePadTemplateMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePadTemplateMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePadTemplateMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePadTemplateMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolvePadTemplateMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolvePadTemplateMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolvePadTemplateMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolvePadTemplateMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePadTemplateMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePadTemplateMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePadTemplateMethod "padCreated" o = PadTemplatePadCreatedMethodInfo
    ResolvePadTemplateMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolvePadTemplateMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePadTemplateMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolvePadTemplateMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePadTemplateMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePadTemplateMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePadTemplateMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolvePadTemplateMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolvePadTemplateMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePadTemplateMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolvePadTemplateMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolvePadTemplateMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePadTemplateMethod "getCaps" o = PadTemplateGetCapsMethodInfo
    ResolvePadTemplateMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolvePadTemplateMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolvePadTemplateMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePadTemplateMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolvePadTemplateMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolvePadTemplateMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolvePadTemplateMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolvePadTemplateMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePadTemplateMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePadTemplateMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolvePadTemplateMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolvePadTemplateMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolvePadTemplateMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolvePadTemplateMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePadTemplateMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePadTemplateMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolvePadTemplateMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolvePadTemplateMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePadTemplateMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal PadTemplate::pad-created
-- | This signal is fired when an element creates a pad from this template.
type PadTemplatePadCreatedCallback =
    Gst.Pad.Pad
    -- ^ /@pad@/: the pad that was created.
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `PadTemplatePadCreatedCallback`@.
noPadTemplatePadCreatedCallback :: Maybe PadTemplatePadCreatedCallback
noPadTemplatePadCreatedCallback :: Maybe PadTemplatePadCreatedCallback
noPadTemplatePadCreatedCallback = Maybe PadTemplatePadCreatedCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_PadTemplatePadCreated :: MonadIO m => PadTemplatePadCreatedCallback -> m (GClosure C_PadTemplatePadCreatedCallback)
genClosure_PadTemplatePadCreated :: PadTemplatePadCreatedCallback
-> m (GClosure C_PadTemplatePadCreatedCallback)
genClosure_PadTemplatePadCreated PadTemplatePadCreatedCallback
cb = IO (GClosure C_PadTemplatePadCreatedCallback)
-> m (GClosure C_PadTemplatePadCreatedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_PadTemplatePadCreatedCallback)
 -> m (GClosure C_PadTemplatePadCreatedCallback))
-> IO (GClosure C_PadTemplatePadCreatedCallback)
-> m (GClosure C_PadTemplatePadCreatedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PadTemplatePadCreatedCallback
cb' = PadTemplatePadCreatedCallback -> C_PadTemplatePadCreatedCallback
wrap_PadTemplatePadCreatedCallback PadTemplatePadCreatedCallback
cb
    C_PadTemplatePadCreatedCallback
-> IO (FunPtr C_PadTemplatePadCreatedCallback)
mk_PadTemplatePadCreatedCallback C_PadTemplatePadCreatedCallback
cb' IO (FunPtr C_PadTemplatePadCreatedCallback)
-> (FunPtr C_PadTemplatePadCreatedCallback
    -> IO (GClosure C_PadTemplatePadCreatedCallback))
-> IO (GClosure C_PadTemplatePadCreatedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_PadTemplatePadCreatedCallback
-> IO (GClosure C_PadTemplatePadCreatedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `PadTemplatePadCreatedCallback` into a `C_PadTemplatePadCreatedCallback`.
wrap_PadTemplatePadCreatedCallback ::
    PadTemplatePadCreatedCallback ->
    C_PadTemplatePadCreatedCallback
wrap_PadTemplatePadCreatedCallback :: PadTemplatePadCreatedCallback -> C_PadTemplatePadCreatedCallback
wrap_PadTemplatePadCreatedCallback PadTemplatePadCreatedCallback
_cb Ptr ()
_ Ptr Pad
pad Ptr ()
_ = do
    Pad
pad' <- ((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
Gst.Pad.Pad) Ptr Pad
pad
    PadTemplatePadCreatedCallback
_cb  Pad
pad'


-- | Connect a signal handler for the [padCreated](#signal:padCreated) 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' padTemplate #padCreated callback
-- @
-- 
-- 
onPadTemplatePadCreated :: (IsPadTemplate a, MonadIO m) => a -> PadTemplatePadCreatedCallback -> m SignalHandlerId
onPadTemplatePadCreated :: a -> PadTemplatePadCreatedCallback -> m SignalHandlerId
onPadTemplatePadCreated a
obj PadTemplatePadCreatedCallback
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_PadTemplatePadCreatedCallback
cb' = PadTemplatePadCreatedCallback -> C_PadTemplatePadCreatedCallback
wrap_PadTemplatePadCreatedCallback PadTemplatePadCreatedCallback
cb
    FunPtr C_PadTemplatePadCreatedCallback
cb'' <- C_PadTemplatePadCreatedCallback
-> IO (FunPtr C_PadTemplatePadCreatedCallback)
mk_PadTemplatePadCreatedCallback C_PadTemplatePadCreatedCallback
cb'
    a
-> Text
-> FunPtr C_PadTemplatePadCreatedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"pad-created" FunPtr C_PadTemplatePadCreatedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [padCreated](#signal:padCreated) 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' padTemplate #padCreated callback
-- @
-- 
-- 
afterPadTemplatePadCreated :: (IsPadTemplate a, MonadIO m) => a -> PadTemplatePadCreatedCallback -> m SignalHandlerId
afterPadTemplatePadCreated :: a -> PadTemplatePadCreatedCallback -> m SignalHandlerId
afterPadTemplatePadCreated a
obj PadTemplatePadCreatedCallback
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_PadTemplatePadCreatedCallback
cb' = PadTemplatePadCreatedCallback -> C_PadTemplatePadCreatedCallback
wrap_PadTemplatePadCreatedCallback PadTemplatePadCreatedCallback
cb
    FunPtr C_PadTemplatePadCreatedCallback
cb'' <- C_PadTemplatePadCreatedCallback
-> IO (FunPtr C_PadTemplatePadCreatedCallback)
mk_PadTemplatePadCreatedCallback C_PadTemplatePadCreatedCallback
cb'
    a
-> Text
-> FunPtr C_PadTemplatePadCreatedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"pad-created" FunPtr C_PadTemplatePadCreatedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PadTemplatePadCreatedSignalInfo
instance SignalInfo PadTemplatePadCreatedSignalInfo where
    type HaskellCallbackType PadTemplatePadCreatedSignalInfo = PadTemplatePadCreatedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PadTemplatePadCreatedCallback cb
        cb'' <- mk_PadTemplatePadCreatedCallback cb'
        connectSignalFunPtr obj "pad-created" cb'' connectMode detail

#endif

-- VVV Prop "caps"
   -- Type: TInterface (Name {namespace = "Gst", name = "Caps"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- 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' padTemplate #caps
-- @
getPadTemplateCaps :: (MonadIO m, IsPadTemplate o) => o -> m (Maybe Gst.Caps.Caps)
getPadTemplateCaps :: o -> m (Maybe Caps)
getPadTemplateCaps 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

-- | Construct a `GValueConstruct` with valid value for the “@caps@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPadTemplateCaps :: (IsPadTemplate o, MIO.MonadIO m) => Gst.Caps.Caps -> m (GValueConstruct o)
constructPadTemplateCaps :: Caps -> m (GValueConstruct o)
constructPadTemplateCaps Caps
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 Caps -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"caps" (Caps -> Maybe Caps
forall a. a -> Maybe a
P.Just Caps
val)

#if defined(ENABLE_OVERLOADING)
data PadTemplateCapsPropertyInfo
instance AttrInfo PadTemplateCapsPropertyInfo where
    type AttrAllowedOps PadTemplateCapsPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PadTemplateCapsPropertyInfo = IsPadTemplate
    type AttrSetTypeConstraint PadTemplateCapsPropertyInfo = (~) Gst.Caps.Caps
    type AttrTransferTypeConstraint PadTemplateCapsPropertyInfo = (~) Gst.Caps.Caps
    type AttrTransferType PadTemplateCapsPropertyInfo = Gst.Caps.Caps
    type AttrGetType PadTemplateCapsPropertyInfo = (Maybe Gst.Caps.Caps)
    type AttrLabel PadTemplateCapsPropertyInfo = "caps"
    type AttrOrigin PadTemplateCapsPropertyInfo = PadTemplate
    attrGet = getPadTemplateCaps
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPadTemplateCaps
    attrClear = undefined
#endif

-- VVV Prop "direction"
   -- Type: TInterface (Name {namespace = "Gst", name = "PadDirection"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,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' padTemplate #direction
-- @
getPadTemplateDirection :: (MonadIO m, IsPadTemplate o) => o -> m Gst.Enums.PadDirection
getPadTemplateDirection :: o -> m PadDirection
getPadTemplateDirection 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`.
constructPadTemplateDirection :: (IsPadTemplate o, MIO.MonadIO m) => Gst.Enums.PadDirection -> m (GValueConstruct o)
constructPadTemplateDirection :: PadDirection -> m (GValueConstruct o)
constructPadTemplateDirection 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 PadTemplateDirectionPropertyInfo
instance AttrInfo PadTemplateDirectionPropertyInfo where
    type AttrAllowedOps PadTemplateDirectionPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PadTemplateDirectionPropertyInfo = IsPadTemplate
    type AttrSetTypeConstraint PadTemplateDirectionPropertyInfo = (~) Gst.Enums.PadDirection
    type AttrTransferTypeConstraint PadTemplateDirectionPropertyInfo = (~) Gst.Enums.PadDirection
    type AttrTransferType PadTemplateDirectionPropertyInfo = Gst.Enums.PadDirection
    type AttrGetType PadTemplateDirectionPropertyInfo = Gst.Enums.PadDirection
    type AttrLabel PadTemplateDirectionPropertyInfo = "direction"
    type AttrOrigin PadTemplateDirectionPropertyInfo = PadTemplate
    attrGet = getPadTemplateDirection
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPadTemplateDirection
    attrClear = undefined
#endif

-- VVV Prop "gtype"
   -- Type: TBasicType TGType
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@gtype@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPadTemplateGtype :: (IsPadTemplate o, MIO.MonadIO m) => GType -> m (GValueConstruct o)
constructPadTemplateGtype :: GType -> m (GValueConstruct o)
constructPadTemplateGtype GType
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 -> GType -> IO (GValueConstruct o)
forall o. String -> GType -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyGType String
"gtype" GType
val

#if defined(ENABLE_OVERLOADING)
data PadTemplateGtypePropertyInfo
instance AttrInfo PadTemplateGtypePropertyInfo where
    type AttrAllowedOps PadTemplateGtypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PadTemplateGtypePropertyInfo = IsPadTemplate
    type AttrSetTypeConstraint PadTemplateGtypePropertyInfo = (~) GType
    type AttrTransferTypeConstraint PadTemplateGtypePropertyInfo = (~) GType
    type AttrTransferType PadTemplateGtypePropertyInfo = GType
    type AttrGetType PadTemplateGtypePropertyInfo = GType
    type AttrLabel PadTemplateGtypePropertyInfo = "gtype"
    type AttrOrigin PadTemplateGtypePropertyInfo = PadTemplate
    attrGet = getPadTemplateGtype
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPadTemplateGtype
    attrClear = undefined
#endif

-- VVV Prop "name-template"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@name-template@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' padTemplate #nameTemplate
-- @
getPadTemplateNameTemplate :: (MonadIO m, IsPadTemplate o) => o -> m (Maybe T.Text)
getPadTemplateNameTemplate :: o -> m (Maybe Text)
getPadTemplateNameTemplate o
obj = 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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"name-template"

-- | Construct a `GValueConstruct` with valid value for the “@name-template@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPadTemplateNameTemplate :: (IsPadTemplate o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructPadTemplateNameTemplate :: Text -> m (GValueConstruct o)
constructPadTemplateNameTemplate Text
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 Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"name-template" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data PadTemplateNameTemplatePropertyInfo
instance AttrInfo PadTemplateNameTemplatePropertyInfo where
    type AttrAllowedOps PadTemplateNameTemplatePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PadTemplateNameTemplatePropertyInfo = IsPadTemplate
    type AttrSetTypeConstraint PadTemplateNameTemplatePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint PadTemplateNameTemplatePropertyInfo = (~) T.Text
    type AttrTransferType PadTemplateNameTemplatePropertyInfo = T.Text
    type AttrGetType PadTemplateNameTemplatePropertyInfo = (Maybe T.Text)
    type AttrLabel PadTemplateNameTemplatePropertyInfo = "name-template"
    type AttrOrigin PadTemplateNameTemplatePropertyInfo = PadTemplate
    attrGet = getPadTemplateNameTemplate
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPadTemplateNameTemplate
    attrClear = undefined
#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data PadTemplatePresencePropertyInfo
instance AttrInfo PadTemplatePresencePropertyInfo where
    type AttrAllowedOps PadTemplatePresencePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PadTemplatePresencePropertyInfo = IsPadTemplate
    type AttrSetTypeConstraint PadTemplatePresencePropertyInfo = (~) Gst.Enums.PadPresence
    type AttrTransferTypeConstraint PadTemplatePresencePropertyInfo = (~) Gst.Enums.PadPresence
    type AttrTransferType PadTemplatePresencePropertyInfo = Gst.Enums.PadPresence
    type AttrGetType PadTemplatePresencePropertyInfo = Gst.Enums.PadPresence
    type AttrLabel PadTemplatePresencePropertyInfo = "presence"
    type AttrOrigin PadTemplatePresencePropertyInfo = PadTemplate
    attrGet = getPadTemplatePresence
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPadTemplatePresence
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PadTemplate
type instance O.AttributeList PadTemplate = PadTemplateAttributeList
type PadTemplateAttributeList = ('[ '("caps", PadTemplateCapsPropertyInfo), '("direction", PadTemplateDirectionPropertyInfo), '("gtype", PadTemplateGtypePropertyInfo), '("name", Gst.Object.ObjectNamePropertyInfo), '("nameTemplate", PadTemplateNameTemplatePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo), '("presence", PadTemplatePresencePropertyInfo)] :: [(Symbol, *)])
#endif

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

padTemplateDirection :: AttrLabelProxy "direction"
padTemplateDirection = AttrLabelProxy

padTemplateGtype :: AttrLabelProxy "gtype"
padTemplateGtype = AttrLabelProxy

padTemplateNameTemplate :: AttrLabelProxy "nameTemplate"
padTemplateNameTemplate = AttrLabelProxy

padTemplatePresence :: AttrLabelProxy "presence"
padTemplatePresence = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList PadTemplate = PadTemplateSignalList
type PadTemplateSignalList = ('[ '("deepNotify", Gst.Object.ObjectDeepNotifySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("padCreated", PadTemplatePadCreatedSignalInfo)] :: [(Symbol, *)])

#endif

-- method PadTemplate::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name_template"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name template." , 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 template."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "presence"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadPresence" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPadPresence of the pad."
--                 , 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 set for the template."
--                 , 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_template_new" gst_pad_template_new :: 
    CString ->                              -- name_template : TBasicType TUTF8
    CUInt ->                                -- direction : TInterface (Name {namespace = "Gst", name = "PadDirection"})
    CUInt ->                                -- presence : TInterface (Name {namespace = "Gst", name = "PadPresence"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr PadTemplate)

-- | Creates a new pad template with a name according to the given template
-- and with the given arguments.
padTemplateNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@nameTemplate@/: the name template.
    -> Gst.Enums.PadDirection
    -- ^ /@direction@/: the t'GI.Gst.Enums.PadDirection' of the template.
    -> Gst.Enums.PadPresence
    -- ^ /@presence@/: the t'GI.Gst.Enums.PadPresence' of the pad.
    -> Gst.Caps.Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps' set for the template.
    -> m (Maybe PadTemplate)
    -- ^ __Returns:__ a new t'GI.Gst.Objects.PadTemplate.PadTemplate'.
padTemplateNew :: Text
-> PadDirection -> PadPresence -> Caps -> m (Maybe PadTemplate)
padTemplateNew Text
nameTemplate PadDirection
direction PadPresence
presence Caps
caps = 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
    CString
nameTemplate' <- Text -> IO CString
textToCString Text
nameTemplate
    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
    let presence' :: CUInt
presence' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PadPresence -> Int) -> PadPresence -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PadPresence -> Int
forall a. Enum a => a -> Int
fromEnum) PadPresence
presence
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr PadTemplate
result <- CString -> CUInt -> CUInt -> Ptr Caps -> IO (Ptr PadTemplate)
gst_pad_template_new CString
nameTemplate' CUInt
direction' CUInt
presence' Ptr Caps
caps'
    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
newObject ManagedPtr PadTemplate -> PadTemplate
PadTemplate) Ptr PadTemplate
result'
        PadTemplate -> IO PadTemplate
forall (m :: * -> *) a. Monad m => a -> m a
return PadTemplate
result''
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
nameTemplate'
    Maybe PadTemplate -> IO (Maybe PadTemplate)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PadTemplate
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method PadTemplate::new_from_static_pad_template_with_gtype
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "pad_template"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "StaticPadTemplate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the static pad template"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pad_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GType of the pad to create"
--                 , 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_template_new_from_static_pad_template_with_gtype" gst_pad_template_new_from_static_pad_template_with_gtype :: 
    Ptr Gst.StaticPadTemplate.StaticPadTemplate -> -- pad_template : TInterface (Name {namespace = "Gst", name = "StaticPadTemplate"})
    CGType ->                               -- pad_type : TBasicType TGType
    IO (Ptr PadTemplate)

-- | Converts a t'GI.Gst.Structs.StaticPadTemplate.StaticPadTemplate' into a t'GI.Gst.Objects.PadTemplate.PadTemplate' with a type.
-- 
-- /Since: 1.14/
padTemplateNewFromStaticPadTemplateWithGtype ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.StaticPadTemplate.StaticPadTemplate
    -- ^ /@padTemplate@/: the static pad template
    -> GType
    -- ^ /@padType@/: The t'GType' of the pad to create
    -> m (Maybe PadTemplate)
    -- ^ __Returns:__ a new t'GI.Gst.Objects.PadTemplate.PadTemplate'.
padTemplateNewFromStaticPadTemplateWithGtype :: StaticPadTemplate -> GType -> m (Maybe PadTemplate)
padTemplateNewFromStaticPadTemplateWithGtype StaticPadTemplate
padTemplate GType
padType = 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 StaticPadTemplate
padTemplate' <- StaticPadTemplate -> IO (Ptr StaticPadTemplate)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr StaticPadTemplate
padTemplate
    let padType' :: CGType
padType' = GType -> CGType
gtypeToCGType GType
padType
    Ptr PadTemplate
result <- Ptr StaticPadTemplate -> CGType -> IO (Ptr PadTemplate)
gst_pad_template_new_from_static_pad_template_with_gtype Ptr StaticPadTemplate
padTemplate' CGType
padType'
    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
newObject ManagedPtr PadTemplate -> PadTemplate
PadTemplate) Ptr PadTemplate
result'
        PadTemplate -> IO PadTemplate
forall (m :: * -> *) a. Monad m => a -> m a
return PadTemplate
result''
    StaticPadTemplate -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr StaticPadTemplate
padTemplate
    Maybe PadTemplate -> IO (Maybe PadTemplate)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PadTemplate
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method PadTemplate::new_with_gtype
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name_template"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name template." , 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 template."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "presence"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadPresence" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPadPresence of the pad."
--                 , 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 set for the template."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pad_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GType of the pad to create"
--                 , 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_template_new_with_gtype" gst_pad_template_new_with_gtype :: 
    CString ->                              -- name_template : TBasicType TUTF8
    CUInt ->                                -- direction : TInterface (Name {namespace = "Gst", name = "PadDirection"})
    CUInt ->                                -- presence : TInterface (Name {namespace = "Gst", name = "PadPresence"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    CGType ->                               -- pad_type : TBasicType TGType
    IO (Ptr PadTemplate)

-- | Creates a new pad template with a name according to the given template
-- and with the given arguments.
-- 
-- /Since: 1.14/
padTemplateNewWithGtype ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@nameTemplate@/: the name template.
    -> Gst.Enums.PadDirection
    -- ^ /@direction@/: the t'GI.Gst.Enums.PadDirection' of the template.
    -> Gst.Enums.PadPresence
    -- ^ /@presence@/: the t'GI.Gst.Enums.PadPresence' of the pad.
    -> Gst.Caps.Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps' set for the template.
    -> GType
    -- ^ /@padType@/: The t'GType' of the pad to create
    -> m (Maybe PadTemplate)
    -- ^ __Returns:__ a new t'GI.Gst.Objects.PadTemplate.PadTemplate'.
padTemplateNewWithGtype :: Text
-> PadDirection
-> PadPresence
-> Caps
-> GType
-> m (Maybe PadTemplate)
padTemplateNewWithGtype Text
nameTemplate PadDirection
direction PadPresence
presence Caps
caps GType
padType = 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
    CString
nameTemplate' <- Text -> IO CString
textToCString Text
nameTemplate
    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
    let presence' :: CUInt
presence' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PadPresence -> Int) -> PadPresence -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PadPresence -> Int
forall a. Enum a => a -> Int
fromEnum) PadPresence
presence
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    let padType' :: CGType
padType' = GType -> CGType
gtypeToCGType GType
padType
    Ptr PadTemplate
result <- CString
-> CUInt -> CUInt -> Ptr Caps -> CGType -> IO (Ptr PadTemplate)
gst_pad_template_new_with_gtype CString
nameTemplate' CUInt
direction' CUInt
presence' Ptr Caps
caps' CGType
padType'
    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
newObject ManagedPtr PadTemplate -> PadTemplate
PadTemplate) Ptr PadTemplate
result'
        PadTemplate -> IO PadTemplate
forall (m :: * -> *) a. Monad m => a -> m a
return PadTemplate
result''
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
nameTemplate'
    Maybe PadTemplate -> IO (Maybe PadTemplate)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PadTemplate
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method PadTemplate::get_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "templ"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadTemplate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPadTemplate to get 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_template_get_caps" gst_pad_template_get_caps :: 
    Ptr PadTemplate ->                      -- templ : TInterface (Name {namespace = "Gst", name = "PadTemplate"})
    IO (Ptr Gst.Caps.Caps)

-- | Gets the capabilities of the pad template.
padTemplateGetCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsPadTemplate a) =>
    a
    -- ^ /@templ@/: a t'GI.Gst.Objects.PadTemplate.PadTemplate' to get capabilities of.
    -> m Gst.Caps.Caps
    -- ^ __Returns:__ the t'GI.Gst.Structs.Caps.Caps' of the pad template.
    -- Unref after usage.
padTemplateGetCaps :: a -> m Caps
padTemplateGetCaps a
templ = 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 PadTemplate
templ' <- a -> IO (Ptr PadTemplate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
templ
    Ptr Caps
result <- Ptr PadTemplate -> IO (Ptr Caps)
gst_pad_template_get_caps Ptr PadTemplate
templ'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"padTemplateGetCaps" 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
templ
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data PadTemplateGetCapsMethodInfo
instance (signature ~ (m Gst.Caps.Caps), MonadIO m, IsPadTemplate a) => O.MethodInfo PadTemplateGetCapsMethodInfo a signature where
    overloadedMethod = padTemplateGetCaps

#endif

-- method PadTemplate::pad_created
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "templ"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PadTemplate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPadTemplate that has been created"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad that created it"
--                 , 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_template_pad_created" gst_pad_template_pad_created :: 
    Ptr PadTemplate ->                      -- templ : TInterface (Name {namespace = "Gst", name = "PadTemplate"})
    Ptr Gst.Pad.Pad ->                      -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO ()

-- | Emit the pad-created signal for this template when created by this pad.
padTemplatePadCreated ::
    (B.CallStack.HasCallStack, MonadIO m, IsPadTemplate a, Gst.Pad.IsPad b) =>
    a
    -- ^ /@templ@/: a t'GI.Gst.Objects.PadTemplate.PadTemplate' that has been created
    -> b
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' that created it
    -> m ()
padTemplatePadCreated :: a -> b -> m ()
padTemplatePadCreated a
templ b
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 PadTemplate
templ' <- a -> IO (Ptr PadTemplate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
templ
    Ptr Pad
pad' <- b -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pad
    Ptr PadTemplate -> Ptr Pad -> IO ()
gst_pad_template_pad_created Ptr PadTemplate
templ' Ptr Pad
pad'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
templ
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PadTemplatePadCreatedMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsPadTemplate a, Gst.Pad.IsPad b) => O.MethodInfo PadTemplatePadCreatedMethodInfo a signature where
    overloadedMethod = padTemplatePadCreated

#endif