{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Caps (capabilities) are lightweight refcounted objects describing media types.
-- They are composed of an array of t'GI.Gst.Structs.Structure.Structure'.
-- 
-- Caps are exposed on t'GI.Gst.Objects.PadTemplate.PadTemplate' to describe all possible types a
-- given pad can handle. They are also stored in the t'GI.Gst.Objects.Registry.Registry' along with
-- a description of the t'GI.Gst.Objects.Element.Element'.
-- 
-- Caps are exposed on the element pads using the 'GI.Gst.Objects.Pad.padQueryCaps' pad
-- function. This function describes the possible types that the pad can
-- handle or produce at runtime.
-- 
-- A t'GI.Gst.Structs.Caps.Caps' can be constructed with the following code fragment:
-- 
-- === /C code/
-- >
-- >  GstCaps *caps = gst_caps_new_simple ("video/x-raw",
-- >     "format", G_TYPE_STRING, "I420",
-- >     "framerate", GST_TYPE_FRACTION, 25, 1,
-- >     "pixel-aspect-ratio", GST_TYPE_FRACTION, 1, 1,
-- >     "width", G_TYPE_INT, 320,
-- >     "height", G_TYPE_INT, 240,
-- >     NULL);
-- 
-- 
-- A t'GI.Gst.Structs.Caps.Caps' is fixed when it has no properties with ranges or lists. Use
-- 'GI.Gst.Structs.Caps.capsIsFixed' to test for fixed caps. Fixed caps can be used in a
-- caps event to notify downstream elements of the current media type.
-- 
-- Various methods exist to work with the media types such as subtracting
-- or intersecting.
-- 
-- Be aware that the current t'GI.Gst.Structs.Caps.Caps' \/ t'GI.Gst.Structs.Structure.Structure' serialization into string
-- has limited support for nested t'GI.Gst.Structs.Caps.Caps' \/ t'GI.Gst.Structs.Structure.Structure' fields. It can only
-- support one level of nesting. Using more levels will lead to unexpected
-- behavior when using serialization features, such as 'GI.Gst.Structs.Caps.capsToString' or
-- 'GI.Gst.Functions.valueSerialize' and their counterparts.

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

module GI.Gst.Structs.Caps
    ( 

-- * Exported types
    Caps(..)                                ,
    newZeroCaps                             ,
    noCaps                                  ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveCapsMethod                       ,
#endif


-- ** append #method:append#

#if defined(ENABLE_OVERLOADING)
    CapsAppendMethodInfo                    ,
#endif
    capsAppend                              ,


-- ** appendStructure #method:appendStructure#

#if defined(ENABLE_OVERLOADING)
    CapsAppendStructureMethodInfo           ,
#endif
    capsAppendStructure                     ,


-- ** appendStructureFull #method:appendStructureFull#

#if defined(ENABLE_OVERLOADING)
    CapsAppendStructureFullMethodInfo       ,
#endif
    capsAppendStructureFull                 ,


-- ** canIntersect #method:canIntersect#

#if defined(ENABLE_OVERLOADING)
    CapsCanIntersectMethodInfo              ,
#endif
    capsCanIntersect                        ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    CapsCopyMethodInfo                      ,
#endif
    capsCopy                                ,


-- ** copyNth #method:copyNth#

#if defined(ENABLE_OVERLOADING)
    CapsCopyNthMethodInfo                   ,
#endif
    capsCopyNth                             ,


-- ** filterAndMapInPlace #method:filterAndMapInPlace#

#if defined(ENABLE_OVERLOADING)
    CapsFilterAndMapInPlaceMethodInfo       ,
#endif
    capsFilterAndMapInPlace                 ,


-- ** fixate #method:fixate#

#if defined(ENABLE_OVERLOADING)
    CapsFixateMethodInfo                    ,
#endif
    capsFixate                              ,


-- ** foreach #method:foreach#

#if defined(ENABLE_OVERLOADING)
    CapsForeachMethodInfo                   ,
#endif
    capsForeach                             ,


-- ** fromString #method:fromString#

    capsFromString                          ,


-- ** getFeatures #method:getFeatures#

#if defined(ENABLE_OVERLOADING)
    CapsGetFeaturesMethodInfo               ,
#endif
    capsGetFeatures                         ,


-- ** getSize #method:getSize#

#if defined(ENABLE_OVERLOADING)
    CapsGetSizeMethodInfo                   ,
#endif
    capsGetSize                             ,


-- ** getStructure #method:getStructure#

#if defined(ENABLE_OVERLOADING)
    CapsGetStructureMethodInfo              ,
#endif
    capsGetStructure                        ,


-- ** intersect #method:intersect#

#if defined(ENABLE_OVERLOADING)
    CapsIntersectMethodInfo                 ,
#endif
    capsIntersect                           ,


-- ** intersectFull #method:intersectFull#

#if defined(ENABLE_OVERLOADING)
    CapsIntersectFullMethodInfo             ,
#endif
    capsIntersectFull                       ,


-- ** isAlwaysCompatible #method:isAlwaysCompatible#

#if defined(ENABLE_OVERLOADING)
    CapsIsAlwaysCompatibleMethodInfo        ,
#endif
    capsIsAlwaysCompatible                  ,


-- ** isAny #method:isAny#

#if defined(ENABLE_OVERLOADING)
    CapsIsAnyMethodInfo                     ,
#endif
    capsIsAny                               ,


-- ** isEmpty #method:isEmpty#

#if defined(ENABLE_OVERLOADING)
    CapsIsEmptyMethodInfo                   ,
#endif
    capsIsEmpty                             ,


-- ** isEqual #method:isEqual#

#if defined(ENABLE_OVERLOADING)
    CapsIsEqualMethodInfo                   ,
#endif
    capsIsEqual                             ,


-- ** isEqualFixed #method:isEqualFixed#

#if defined(ENABLE_OVERLOADING)
    CapsIsEqualFixedMethodInfo              ,
#endif
    capsIsEqualFixed                        ,


-- ** isFixed #method:isFixed#

#if defined(ENABLE_OVERLOADING)
    CapsIsFixedMethodInfo                   ,
#endif
    capsIsFixed                             ,


-- ** isStrictlyEqual #method:isStrictlyEqual#

#if defined(ENABLE_OVERLOADING)
    CapsIsStrictlyEqualMethodInfo           ,
#endif
    capsIsStrictlyEqual                     ,


-- ** isSubset #method:isSubset#

#if defined(ENABLE_OVERLOADING)
    CapsIsSubsetMethodInfo                  ,
#endif
    capsIsSubset                            ,


-- ** isSubsetStructure #method:isSubsetStructure#

#if defined(ENABLE_OVERLOADING)
    CapsIsSubsetStructureMethodInfo         ,
#endif
    capsIsSubsetStructure                   ,


-- ** isSubsetStructureFull #method:isSubsetStructureFull#

#if defined(ENABLE_OVERLOADING)
    CapsIsSubsetStructureFullMethodInfo     ,
#endif
    capsIsSubsetStructureFull               ,


-- ** mapInPlace #method:mapInPlace#

#if defined(ENABLE_OVERLOADING)
    CapsMapInPlaceMethodInfo                ,
#endif
    capsMapInPlace                          ,


-- ** merge #method:merge#

#if defined(ENABLE_OVERLOADING)
    CapsMergeMethodInfo                     ,
#endif
    capsMerge                               ,


-- ** mergeStructure #method:mergeStructure#

#if defined(ENABLE_OVERLOADING)
    CapsMergeStructureMethodInfo            ,
#endif
    capsMergeStructure                      ,


-- ** mergeStructureFull #method:mergeStructureFull#

#if defined(ENABLE_OVERLOADING)
    CapsMergeStructureFullMethodInfo        ,
#endif
    capsMergeStructureFull                  ,


-- ** newAny #method:newAny#

    capsNewAny                              ,


-- ** newEmpty #method:newEmpty#

    capsNewEmpty                            ,


-- ** newEmptySimple #method:newEmptySimple#

    capsNewEmptySimple                      ,


-- ** normalize #method:normalize#

#if defined(ENABLE_OVERLOADING)
    CapsNormalizeMethodInfo                 ,
#endif
    capsNormalize                           ,


-- ** removeStructure #method:removeStructure#

#if defined(ENABLE_OVERLOADING)
    CapsRemoveStructureMethodInfo           ,
#endif
    capsRemoveStructure                     ,


-- ** setFeatures #method:setFeatures#

#if defined(ENABLE_OVERLOADING)
    CapsSetFeaturesMethodInfo               ,
#endif
    capsSetFeatures                         ,


-- ** setFeaturesSimple #method:setFeaturesSimple#

#if defined(ENABLE_OVERLOADING)
    CapsSetFeaturesSimpleMethodInfo         ,
#endif
    capsSetFeaturesSimple                   ,


-- ** setValue #method:setValue#

#if defined(ENABLE_OVERLOADING)
    CapsSetValueMethodInfo                  ,
#endif
    capsSetValue                            ,


-- ** simplify #method:simplify#

#if defined(ENABLE_OVERLOADING)
    CapsSimplifyMethodInfo                  ,
#endif
    capsSimplify                            ,


-- ** stealStructure #method:stealStructure#

#if defined(ENABLE_OVERLOADING)
    CapsStealStructureMethodInfo            ,
#endif
    capsStealStructure                      ,


-- ** subtract #method:subtract#

#if defined(ENABLE_OVERLOADING)
    CapsSubtractMethodInfo                  ,
#endif
    capsSubtract                            ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    CapsToStringMethodInfo                  ,
#endif
    capsToString                            ,


-- ** truncate #method:truncate#

#if defined(ENABLE_OVERLOADING)
    CapsTruncateMethodInfo                  ,
#endif
    capsTruncate                            ,




 -- * Properties
-- ** miniObject #attr:miniObject#
-- | the parent type

#if defined(ENABLE_OVERLOADING)
    caps_miniObject                         ,
#endif
    getCapsMiniObject                       ,




    ) 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.Gst.Callbacks as Gst.Callbacks
import {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums
import {-# SOURCE #-} qualified GI.Gst.Structs.CapsFeatures as Gst.CapsFeatures
import {-# SOURCE #-} qualified GI.Gst.Structs.MiniObject as Gst.MiniObject
import {-# SOURCE #-} qualified GI.Gst.Structs.Structure as Gst.Structure

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

instance BoxedObject Caps where
    boxedType :: Caps -> IO GType
boxedType _ = IO GType
c_gst_caps_get_type

-- | Convert 'Caps' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Caps where
    toGValue :: Caps -> IO GValue
toGValue o :: Caps
o = do
        GType
gtype <- IO GType
c_gst_caps_get_type
        Caps -> (Ptr Caps -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Caps
o (GType -> (GValue -> Ptr Caps -> IO ()) -> Ptr Caps -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Caps -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO Caps
fromGValue gv :: GValue
gv = do
        Ptr Caps
ptr <- GValue -> IO (Ptr Caps)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr Caps)
        (ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Caps -> Caps
Caps Ptr Caps
ptr
        
    

-- | Construct a `Caps` struct initialized to zero.
newZeroCaps :: MonadIO m => m Caps
newZeroCaps :: m Caps
newZeroCaps = 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
$ Int -> IO (Ptr Caps)
forall a. BoxedObject a => Int -> IO (Ptr a)
callocBoxedBytes 64 IO (Ptr Caps) -> (Ptr Caps -> IO Caps) -> IO Caps
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps

instance tag ~ 'AttrSet => Constructible Caps tag where
    new :: (ManagedPtr Caps -> Caps) -> [AttrOp Caps tag] -> m Caps
new _ attrs :: [AttrOp Caps tag]
attrs = do
        Caps
o <- m Caps
forall (m :: * -> *). MonadIO m => m Caps
newZeroCaps
        Caps -> [AttrOp Caps 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set Caps
o [AttrOp Caps tag]
[AttrOp Caps 'AttrSet]
attrs
        Caps -> m Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
o


-- | A convenience alias for `Nothing` :: `Maybe` `Caps`.
noCaps :: Maybe Caps
noCaps :: Maybe Caps
noCaps = Maybe Caps
forall a. Maybe a
Nothing

-- | Get the value of the “@mini_object@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' caps #miniObject
-- @
getCapsMiniObject :: MonadIO m => Caps -> m Gst.MiniObject.MiniObject
getCapsMiniObject :: Caps -> m MiniObject
getCapsMiniObject s :: Caps
s = IO MiniObject -> m MiniObject
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MiniObject -> m MiniObject) -> IO MiniObject -> m MiniObject
forall a b. (a -> b) -> a -> b
$ Caps -> (Ptr Caps -> IO MiniObject) -> IO MiniObject
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Caps
s ((Ptr Caps -> IO MiniObject) -> IO MiniObject)
-> (Ptr Caps -> IO MiniObject) -> IO MiniObject
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Caps
ptr -> do
    let val :: Ptr MiniObject
val = Ptr Caps
ptr Ptr Caps -> Int -> Ptr MiniObject
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: (Ptr Gst.MiniObject.MiniObject)
    MiniObject
val' <- ((ManagedPtr MiniObject -> MiniObject)
-> Ptr MiniObject -> IO MiniObject
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr MiniObject -> MiniObject
Gst.MiniObject.MiniObject) Ptr MiniObject
val
    MiniObject -> IO MiniObject
forall (m :: * -> *) a. Monad m => a -> m a
return MiniObject
val'

#if defined(ENABLE_OVERLOADING)
data CapsMiniObjectFieldInfo
instance AttrInfo CapsMiniObjectFieldInfo where
    type AttrBaseTypeConstraint CapsMiniObjectFieldInfo = (~) Caps
    type AttrAllowedOps CapsMiniObjectFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint CapsMiniObjectFieldInfo = (~) (Ptr Gst.MiniObject.MiniObject)
    type AttrTransferTypeConstraint CapsMiniObjectFieldInfo = (~)(Ptr Gst.MiniObject.MiniObject)
    type AttrTransferType CapsMiniObjectFieldInfo = (Ptr Gst.MiniObject.MiniObject)
    type AttrGetType CapsMiniObjectFieldInfo = Gst.MiniObject.MiniObject
    type AttrLabel CapsMiniObjectFieldInfo = "mini_object"
    type AttrOrigin CapsMiniObjectFieldInfo = Caps
    attrGet = getCapsMiniObject
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined

caps_miniObject :: AttrLabelProxy "miniObject"
caps_miniObject = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Caps
type instance O.AttributeList Caps = CapsAttributeList
type CapsAttributeList = ('[ '("miniObject", CapsMiniObjectFieldInfo)] :: [(Symbol, *)])
#endif

-- method Caps::new_any
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Caps" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_new_any" gst_caps_new_any :: 
    IO (Ptr Caps)

-- | Creates a new t'GI.Gst.Structs.Caps.Caps' that indicates that it is compatible with
-- any media format.
capsNewAny ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Caps
    -- ^ __Returns:__ the new t'GI.Gst.Structs.Caps.Caps'
capsNewAny :: m Caps
capsNewAny  = 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 Caps
result <- IO (Ptr Caps)
gst_caps_new_any
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsNewAny" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Caps::new_empty
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Caps" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_new_empty" gst_caps_new_empty :: 
    IO (Ptr Caps)

-- | Creates a new t'GI.Gst.Structs.Caps.Caps' that is empty.  That is, the returned
-- t'GI.Gst.Structs.Caps.Caps' contains no media formats.
-- The t'GI.Gst.Structs.Caps.Caps' is guaranteed to be writable.
-- Caller is responsible for unreffing the returned caps.
capsNewEmpty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Caps
    -- ^ __Returns:__ the new t'GI.Gst.Structs.Caps.Caps'
capsNewEmpty :: m Caps
capsNewEmpty  = 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 Caps
result <- IO (Ptr Caps)
gst_caps_new_empty
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsNewEmpty" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Caps::new_empty_simple
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "media_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the media type of the structure"
--                 , 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_caps_new_empty_simple" gst_caps_new_empty_simple :: 
    CString ->                              -- media_type : TBasicType TUTF8
    IO (Ptr Caps)

-- | Creates a new t'GI.Gst.Structs.Caps.Caps' that contains one t'GI.Gst.Structs.Structure.Structure' with name
-- /@mediaType@/.
-- Caller is responsible for unreffing the returned caps.
capsNewEmptySimple ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@mediaType@/: the media type of the structure
    -> m Caps
    -- ^ __Returns:__ the new t'GI.Gst.Structs.Caps.Caps'
capsNewEmptySimple :: Text -> m Caps
capsNewEmptySimple mediaType :: Text
mediaType = 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
    CString
mediaType' <- Text -> IO CString
textToCString Text
mediaType
    Ptr Caps
result <- CString -> IO (Ptr Caps)
gst_caps_new_empty_simple CString
mediaType'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsNewEmptySimple" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
mediaType'
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Caps::append
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps1"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCaps that will be appended to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps2"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCaps to append"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_append" gst_caps_append :: 
    Ptr Caps ->                             -- caps1 : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Caps ->                             -- caps2 : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO ()

-- | Appends the structures contained in /@caps2@/ to /@caps1@/. The structures in
-- /@caps2@/ are not copied -- they are transferred to /@caps1@/, and then /@caps2@/ is
-- freed. If either caps is ANY, the resulting caps will be ANY.
capsAppend ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps1@/: the t'GI.Gst.Structs.Caps.Caps' that will be appended to
    -> Caps
    -- ^ /@caps2@/: the t'GI.Gst.Structs.Caps.Caps' to append
    -> m ()
capsAppend :: Caps -> Caps -> m ()
capsAppend caps1 :: Caps
caps1 caps2 :: Caps
caps2 = 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 Caps
caps1' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps1
    Ptr Caps
caps2' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Caps
caps2
    Ptr Caps -> Ptr Caps -> IO ()
gst_caps_append Ptr Caps
caps1' Ptr Caps
caps2'
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps1
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps2
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CapsAppendMethodInfo
instance (signature ~ (Caps -> m ()), MonadIO m) => O.MethodInfo CapsAppendMethodInfo Caps signature where
    overloadedMethod = capsAppend

#endif

-- method Caps::append_structure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCaps that will be appended to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstStructure to append"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_append_structure" gst_caps_append_structure :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Gst.Structure.Structure ->          -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO ()

-- | Appends /@structure@/ to /@caps@/.  The structure is not copied; /@caps@/
-- becomes the owner of /@structure@/.
capsAppendStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: the t'GI.Gst.Structs.Caps.Caps' that will be appended to
    -> Gst.Structure.Structure
    -- ^ /@structure@/: the t'GI.Gst.Structs.Structure.Structure' to append
    -> m ()
capsAppendStructure :: Caps -> Structure -> m ()
capsAppendStructure caps :: Caps
caps structure :: Structure
structure = 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 Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
structure
    Ptr Caps -> Ptr Structure -> IO ()
gst_caps_append_structure Ptr Caps
caps' Ptr Structure
structure'
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CapsAppendStructureMethodInfo
instance (signature ~ (Gst.Structure.Structure -> m ()), MonadIO m) => O.MethodInfo CapsAppendStructureMethodInfo Caps signature where
    overloadedMethod = capsAppendStructure

#endif

-- method Caps::append_structure_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCaps that will be appended to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstStructure to append"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCapsFeatures to append"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_append_structure_full" gst_caps_append_structure_full :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Gst.Structure.Structure ->          -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    Ptr Gst.CapsFeatures.CapsFeatures ->    -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    IO ()

-- | Appends /@structure@/ with /@features@/ to /@caps@/.  The structure is not copied; /@caps@/
-- becomes the owner of /@structure@/.
-- 
-- /Since: 1.2/
capsAppendStructureFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: the t'GI.Gst.Structs.Caps.Caps' that will be appended to
    -> Gst.Structure.Structure
    -- ^ /@structure@/: the t'GI.Gst.Structs.Structure.Structure' to append
    -> Maybe (Gst.CapsFeatures.CapsFeatures)
    -- ^ /@features@/: the t'GI.Gst.Structs.CapsFeatures.CapsFeatures' to append
    -> m ()
capsAppendStructureFull :: Caps -> Structure -> Maybe CapsFeatures -> m ()
capsAppendStructureFull caps :: Caps
caps structure :: Structure
structure features :: Maybe CapsFeatures
features = 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 Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
structure
    Ptr CapsFeatures
maybeFeatures <- case Maybe CapsFeatures
features of
        Nothing -> Ptr CapsFeatures -> IO (Ptr CapsFeatures)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CapsFeatures
forall a. Ptr a
nullPtr
        Just jFeatures :: CapsFeatures
jFeatures -> do
            Ptr CapsFeatures
jFeatures' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed CapsFeatures
jFeatures
            Ptr CapsFeatures -> IO (Ptr CapsFeatures)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CapsFeatures
jFeatures'
    Ptr Caps -> Ptr Structure -> Ptr CapsFeatures -> IO ()
gst_caps_append_structure_full Ptr Caps
caps' Ptr Structure
structure' Ptr CapsFeatures
maybeFeatures
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Maybe CapsFeatures -> (CapsFeatures -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe CapsFeatures
features CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CapsAppendStructureFullMethodInfo
instance (signature ~ (Gst.Structure.Structure -> Maybe (Gst.CapsFeatures.CapsFeatures) -> m ()), MonadIO m) => O.MethodInfo CapsAppendStructureFullMethodInfo Caps signature where
    overloadedMethod = capsAppendStructureFull

#endif

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

foreign import ccall "gst_caps_can_intersect" gst_caps_can_intersect :: 
    Ptr Caps ->                             -- caps1 : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Caps ->                             -- caps2 : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

-- | Tries intersecting /@caps1@/ and /@caps2@/ and reports whether the result would not
-- be empty
capsCanIntersect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps1@/: a t'GI.Gst.Structs.Caps.Caps' to intersect
    -> Caps
    -- ^ /@caps2@/: a t'GI.Gst.Structs.Caps.Caps' to intersect
    -> m Bool
    -- ^ __Returns:__ 'P.True' if intersection would be not empty
capsCanIntersect :: Caps -> Caps -> m Bool
capsCanIntersect caps1 :: Caps
caps1 caps2 :: Caps
caps2 = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps1' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps1
    Ptr Caps
caps2' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps2
    CInt
result <- Ptr Caps -> Ptr Caps -> IO CInt
gst_caps_can_intersect Ptr Caps
caps1' Ptr Caps
caps2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps1
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsCanIntersectMethodInfo
instance (signature ~ (Caps -> m Bool), MonadIO m) => O.MethodInfo CapsCanIntersectMethodInfo Caps signature where
    overloadedMethod = capsCanIntersect

#endif

-- method Caps::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps." , 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_caps_copy" gst_caps_copy :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Caps)

-- | Creates a new t'GI.Gst.Structs.Caps.Caps' as a copy of the old /@caps@/. The new caps will have a
-- refcount of 1, owned by the caller. The structures are copied as well.
-- 
-- Note that this function is the semantic equivalent of a @/gst_caps_ref()/@
-- followed by a @/gst_caps_make_writable()/@. If you only want to hold on to a
-- reference to the data, you should use @/gst_caps_ref()/@.
-- 
-- When you are finished with the caps, call @/gst_caps_unref()/@ on it.
capsCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'.
    -> m Caps
    -- ^ __Returns:__ the new t'GI.Gst.Structs.Caps.Caps'
capsCopy :: Caps -> m Caps
capsCopy caps :: Caps
caps = 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 Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr Caps
result <- Ptr Caps -> IO (Ptr Caps)
gst_caps_copy Ptr Caps
caps'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsCopy" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data CapsCopyMethodInfo
instance (signature ~ (m Caps), MonadIO m) => O.MethodInfo CapsCopyMethodInfo Caps signature where
    overloadedMethod = capsCopy

#endif

-- method Caps::copy_nth
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCaps to copy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "nth"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the nth structure to copy"
--                 , 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_caps_copy_nth" gst_caps_copy_nth :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Word32 ->                               -- nth : TBasicType TUInt
    IO (Ptr Caps)

-- | Creates a new t'GI.Gst.Structs.Caps.Caps' and appends a copy of the nth structure
-- contained in /@caps@/.
capsCopyNth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: the t'GI.Gst.Structs.Caps.Caps' to copy
    -> Word32
    -- ^ /@nth@/: the nth structure to copy
    -> m Caps
    -- ^ __Returns:__ the new t'GI.Gst.Structs.Caps.Caps'
capsCopyNth :: Caps -> Word32 -> m Caps
capsCopyNth caps :: Caps
caps nth :: Word32
nth = 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 Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr Caps
result <- Ptr Caps -> Word32 -> IO (Ptr Caps)
gst_caps_copy_nth Ptr Caps
caps' Word32
nth
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsCopyNth" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data CapsCopyNthMethodInfo
instance (signature ~ (Word32 -> m Caps), MonadIO m) => O.MethodInfo CapsCopyNthMethodInfo Caps signature where
    overloadedMethod = capsCopyNth

#endif

-- method Caps::filter_and_map_in_place
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFilterMapFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a function to call for each field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "private data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_filter_and_map_in_place" gst_caps_filter_and_map_in_place :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    FunPtr Gst.Callbacks.C_CapsFilterMapFunc -> -- func : TInterface (Name {namespace = "Gst", name = "CapsFilterMapFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Calls the provided function once for each structure and caps feature in the
-- t'GI.Gst.Structs.Caps.Caps'. In contrast to 'GI.Gst.Structs.Caps.capsForeach', the function may modify the
-- structure and features. In contrast to 'GI.Gst.Structs.Caps.capsFilterAndMapInPlace',
-- the structure and features are removed from the caps if 'P.False' is returned
-- from the function.
-- The caps must be mutable.
-- 
-- /Since: 1.6/
capsFilterAndMapInPlace ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> Gst.Callbacks.CapsFilterMapFunc
    -- ^ /@func@/: a function to call for each field
    -> m ()
capsFilterAndMapInPlace :: Caps -> CapsFilterMapFunc -> m ()
capsFilterAndMapInPlace caps :: Caps
caps func :: CapsFilterMapFunc
func = 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 Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    FunPtr C_CapsFilterMapFunc
func' <- C_CapsFilterMapFunc -> IO (FunPtr C_CapsFilterMapFunc)
Gst.Callbacks.mk_CapsFilterMapFunc (Maybe (Ptr (FunPtr C_CapsFilterMapFunc))
-> CapsFilterMapFunc_WithClosures -> C_CapsFilterMapFunc
Gst.Callbacks.wrap_CapsFilterMapFunc Maybe (Ptr (FunPtr C_CapsFilterMapFunc))
forall a. Maybe a
Nothing (CapsFilterMapFunc -> CapsFilterMapFunc_WithClosures
Gst.Callbacks.drop_closures_CapsFilterMapFunc CapsFilterMapFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Caps -> FunPtr C_CapsFilterMapFunc -> Ptr () -> IO ()
gst_caps_filter_and_map_in_place Ptr Caps
caps' FunPtr C_CapsFilterMapFunc
func' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_CapsFilterMapFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CapsFilterMapFunc
func'
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CapsFilterAndMapInPlaceMethodInfo
instance (signature ~ (Gst.Callbacks.CapsFilterMapFunc -> m ()), MonadIO m) => O.MethodInfo CapsFilterAndMapInPlaceMethodInfo Caps signature where
    overloadedMethod = capsFilterAndMapInPlace

#endif

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

foreign import ccall "gst_caps_fixate" gst_caps_fixate :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Caps)

-- | Modifies the given /@caps@/ into a representation with only fixed
-- values. First the caps will be truncated and then the first structure will be
-- fixated with 'GI.Gst.Structs.Structure.structureFixate'.
-- 
-- This function takes ownership of /@caps@/ and will call @/gst_caps_make_writable()/@
-- on it so you must not use /@caps@/ afterwards unless you keep an additional
-- reference to it with @/gst_caps_ref()/@.
capsFixate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps' to fixate
    -> m Caps
    -- ^ __Returns:__ the fixated caps
capsFixate :: Caps -> m Caps
capsFixate caps :: Caps
caps = 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 Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Caps
caps
    Ptr Caps
result <- Ptr Caps -> IO (Ptr Caps)
gst_caps_fixate Ptr Caps
caps'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsFixate" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data CapsFixateMethodInfo
instance (signature ~ (m Caps), MonadIO m) => O.MethodInfo CapsFixateMethodInfo Caps signature where
    overloadedMethod = capsFixate

#endif

-- method Caps::foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsForeachFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a function to call for each field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "private data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_foreach" gst_caps_foreach :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    FunPtr Gst.Callbacks.C_CapsForeachFunc -> -- func : TInterface (Name {namespace = "Gst", name = "CapsForeachFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CInt

-- | Calls the provided function once for each structure and caps feature in the
-- t'GI.Gst.Structs.Caps.Caps'. The function must not modify the fields.
-- Also see 'GI.Gst.Structs.Caps.capsMapInPlace' and 'GI.Gst.Structs.Caps.capsFilterAndMapInPlace'.
-- 
-- /Since: 1.6/
capsForeach ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> Gst.Callbacks.CapsForeachFunc
    -- ^ /@func@/: a function to call for each field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the supplied function returns 'P.True' for each call,
    -- 'P.False' otherwise.
capsForeach :: Caps -> CapsFilterMapFunc -> m Bool
capsForeach caps :: Caps
caps func :: CapsFilterMapFunc
func = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    FunPtr C_CapsFilterMapFunc
func' <- C_CapsFilterMapFunc -> IO (FunPtr C_CapsFilterMapFunc)
Gst.Callbacks.mk_CapsForeachFunc (Maybe (Ptr (FunPtr C_CapsFilterMapFunc))
-> CapsFilterMapFunc_WithClosures -> C_CapsFilterMapFunc
Gst.Callbacks.wrap_CapsForeachFunc Maybe (Ptr (FunPtr C_CapsFilterMapFunc))
forall a. Maybe a
Nothing (CapsFilterMapFunc -> CapsFilterMapFunc_WithClosures
Gst.Callbacks.drop_closures_CapsForeachFunc CapsFilterMapFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CInt
result <- Ptr Caps -> FunPtr C_CapsFilterMapFunc -> Ptr () -> IO CInt
gst_caps_foreach Ptr Caps
caps' FunPtr C_CapsFilterMapFunc
func' Ptr ()
forall a. Ptr a
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_CapsFilterMapFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CapsFilterMapFunc
func'
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsForeachMethodInfo
instance (signature ~ (Gst.Callbacks.CapsForeachFunc -> m Bool), MonadIO m) => O.MethodInfo CapsForeachMethodInfo Caps signature where
    overloadedMethod = capsForeach

#endif

-- method Caps::get_features
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gst" , name = "CapsFeatures" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_get_features" gst_caps_get_features :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Word32 ->                               -- index : TBasicType TUInt
    IO (Ptr Gst.CapsFeatures.CapsFeatures)

-- | Finds the features in /@caps@/ that has the index /@index@/, and
-- returns it.
-- 
-- WARNING: This function takes a const GstCaps *, but returns a
-- non-const GstCapsFeatures *.  This is for programming convenience --
-- the caller should be aware that structures inside a constant
-- t'GI.Gst.Structs.Caps.Caps' should not be modified. However, if you know the caps
-- are writable, either because you have just copied them or made
-- them writable with @/gst_caps_make_writable()/@, you may modify the
-- features returned in the usual way, e.g. with functions like
-- 'GI.Gst.Structs.CapsFeatures.capsFeaturesAdd'.
-- 
-- You do not need to free or unref the structure returned, it
-- belongs to the t'GI.Gst.Structs.Caps.Caps'.
-- 
-- /Since: 1.2/
capsGetFeatures ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> Word32
    -- ^ /@index@/: the index of the structure
    -> m (Maybe Gst.CapsFeatures.CapsFeatures)
    -- ^ __Returns:__ a pointer to the t'GI.Gst.Structs.CapsFeatures.CapsFeatures'
    --     corresponding to /@index@/
capsGetFeatures :: Caps -> Word32 -> m (Maybe CapsFeatures)
capsGetFeatures caps :: Caps
caps index :: Word32
index = IO (Maybe CapsFeatures) -> m (Maybe CapsFeatures)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CapsFeatures) -> m (Maybe CapsFeatures))
-> IO (Maybe CapsFeatures) -> m (Maybe CapsFeatures)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr CapsFeatures
result <- Ptr Caps -> Word32 -> IO (Ptr CapsFeatures)
gst_caps_get_features Ptr Caps
caps' Word32
index
    Maybe CapsFeatures
maybeResult <- Ptr CapsFeatures
-> (Ptr CapsFeatures -> IO CapsFeatures) -> IO (Maybe CapsFeatures)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CapsFeatures
result ((Ptr CapsFeatures -> IO CapsFeatures) -> IO (Maybe CapsFeatures))
-> (Ptr CapsFeatures -> IO CapsFeatures) -> IO (Maybe CapsFeatures)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr CapsFeatures
result' -> do
        CapsFeatures
result'' <- ((ManagedPtr CapsFeatures -> CapsFeatures)
-> Ptr CapsFeatures -> IO CapsFeatures
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr CapsFeatures -> CapsFeatures
Gst.CapsFeatures.CapsFeatures) Ptr CapsFeatures
result'
        CapsFeatures -> IO CapsFeatures
forall (m :: * -> *) a. Monad m => a -> m a
return CapsFeatures
result''
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Maybe CapsFeatures -> IO (Maybe CapsFeatures)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CapsFeatures
maybeResult

#if defined(ENABLE_OVERLOADING)
data CapsGetFeaturesMethodInfo
instance (signature ~ (Word32 -> m (Maybe Gst.CapsFeatures.CapsFeatures)), MonadIO m) => O.MethodInfo CapsGetFeaturesMethodInfo Caps signature where
    overloadedMethod = capsGetFeatures

#endif

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

foreign import ccall "gst_caps_get_size" gst_caps_get_size :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO Word32

-- | Gets the number of structures contained in /@caps@/.
capsGetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> m Word32
    -- ^ __Returns:__ the number of structures that /@caps@/ contains
capsGetSize :: Caps -> m Word32
capsGetSize caps :: Caps
caps = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Word32
result <- Ptr Caps -> IO Word32
gst_caps_get_size Ptr Caps
caps'
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data CapsGetSizeMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo CapsGetSizeMethodInfo Caps signature where
    overloadedMethod = capsGetSize

#endif

-- method Caps::get_structure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Structure" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_get_structure" gst_caps_get_structure :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Word32 ->                               -- index : TBasicType TUInt
    IO (Ptr Gst.Structure.Structure)

-- | Finds the structure in /@caps@/ that has the index /@index@/, and
-- returns it.
-- 
-- WARNING: This function takes a const GstCaps *, but returns a
-- non-const GstStructure *.  This is for programming convenience --
-- the caller should be aware that structures inside a constant
-- t'GI.Gst.Structs.Caps.Caps' should not be modified. However, if you know the caps
-- are writable, either because you have just copied them or made
-- them writable with @/gst_caps_make_writable()/@, you may modify the
-- structure returned in the usual way, e.g. with functions like
-- @/gst_structure_set()/@.
-- 
-- You do not need to free or unref the structure returned, it
-- belongs to the t'GI.Gst.Structs.Caps.Caps'.
capsGetStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> Word32
    -- ^ /@index@/: the index of the structure
    -> m Gst.Structure.Structure
    -- ^ __Returns:__ a pointer to the t'GI.Gst.Structs.Structure.Structure' corresponding
    --     to /@index@/
capsGetStructure :: Caps -> Word32 -> m Structure
capsGetStructure caps :: Caps
caps index :: Word32
index = IO Structure -> m Structure
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Structure -> m Structure) -> IO Structure -> m Structure
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr Structure
result <- Ptr Caps -> Word32 -> IO (Ptr Structure)
gst_caps_get_structure Ptr Caps
caps' Word32
index
    Text -> Ptr Structure -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsGetStructure" Ptr Structure
result
    Structure
result' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result'

#if defined(ENABLE_OVERLOADING)
data CapsGetStructureMethodInfo
instance (signature ~ (Word32 -> m Gst.Structure.Structure), MonadIO m) => O.MethodInfo CapsGetStructureMethodInfo Caps signature where
    overloadedMethod = capsGetStructure

#endif

-- method Caps::intersect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps1"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps to intersect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps2"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps to intersect"
--                 , 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_caps_intersect" gst_caps_intersect :: 
    Ptr Caps ->                             -- caps1 : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Caps ->                             -- caps2 : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Caps)

-- | Creates a new t'GI.Gst.Structs.Caps.Caps' that contains all the formats that are common
-- to both /@caps1@/ and /@caps2@/. Defaults to 'GI.Gst.Enums.CapsIntersectModeZigZag' mode.
capsIntersect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps1@/: a t'GI.Gst.Structs.Caps.Caps' to intersect
    -> Caps
    -- ^ /@caps2@/: a t'GI.Gst.Structs.Caps.Caps' to intersect
    -> m Caps
    -- ^ __Returns:__ the new t'GI.Gst.Structs.Caps.Caps'
capsIntersect :: Caps -> Caps -> m Caps
capsIntersect caps1 :: Caps
caps1 caps2 :: Caps
caps2 = 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 Caps
caps1' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps1
    Ptr Caps
caps2' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps2
    Ptr Caps
result <- Ptr Caps -> Ptr Caps -> IO (Ptr Caps)
gst_caps_intersect Ptr Caps
caps1' Ptr Caps
caps2'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsIntersect" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps1
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps2
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data CapsIntersectMethodInfo
instance (signature ~ (Caps -> m Caps), MonadIO m) => O.MethodInfo CapsIntersectMethodInfo Caps signature where
    overloadedMethod = capsIntersect

#endif

-- method Caps::intersect_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps1"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps to intersect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps2"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps to intersect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsIntersectMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The intersection algorithm/mode to use"
--                 , 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_caps_intersect_full" gst_caps_intersect_full :: 
    Ptr Caps ->                             -- caps1 : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Caps ->                             -- caps2 : TInterface (Name {namespace = "Gst", name = "Caps"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gst", name = "CapsIntersectMode"})
    IO (Ptr Caps)

-- | Creates a new t'GI.Gst.Structs.Caps.Caps' that contains all the formats that are common
-- to both /@caps1@/ and /@caps2@/, the order is defined by the t'GI.Gst.Enums.CapsIntersectMode'
-- used.
capsIntersectFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps1@/: a t'GI.Gst.Structs.Caps.Caps' to intersect
    -> Caps
    -- ^ /@caps2@/: a t'GI.Gst.Structs.Caps.Caps' to intersect
    -> Gst.Enums.CapsIntersectMode
    -- ^ /@mode@/: The intersection algorithm\/mode to use
    -> m Caps
    -- ^ __Returns:__ the new t'GI.Gst.Structs.Caps.Caps'
capsIntersectFull :: Caps -> Caps -> CapsIntersectMode -> m Caps
capsIntersectFull caps1 :: Caps
caps1 caps2 :: Caps
caps2 mode :: CapsIntersectMode
mode = 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 Caps
caps1' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps1
    Ptr Caps
caps2' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps2
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (CapsIntersectMode -> Int) -> CapsIntersectMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CapsIntersectMode -> Int
forall a. Enum a => a -> Int
fromEnum) CapsIntersectMode
mode
    Ptr Caps
result <- Ptr Caps -> Ptr Caps -> CUInt -> IO (Ptr Caps)
gst_caps_intersect_full Ptr Caps
caps1' Ptr Caps
caps2' CUInt
mode'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsIntersectFull" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps1
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps2
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data CapsIntersectFullMethodInfo
instance (signature ~ (Caps -> Gst.Enums.CapsIntersectMode -> m Caps), MonadIO m) => O.MethodInfo CapsIntersectFullMethodInfo Caps signature where
    overloadedMethod = capsIntersectFull

#endif

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

foreign import ccall "gst_caps_is_always_compatible" gst_caps_is_always_compatible :: 
    Ptr Caps ->                             -- caps1 : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Caps ->                             -- caps2 : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

-- | A given t'GI.Gst.Structs.Caps.Caps' structure is always compatible with another if
-- every media format that is in the first is also contained in the
-- second.  That is, /@caps1@/ is a subset of /@caps2@/.
capsIsAlwaysCompatible ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps1@/: the t'GI.Gst.Structs.Caps.Caps' to test
    -> Caps
    -- ^ /@caps2@/: the t'GI.Gst.Structs.Caps.Caps' to test
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@caps1@/ is a subset of /@caps2@/.
capsIsAlwaysCompatible :: Caps -> Caps -> m Bool
capsIsAlwaysCompatible caps1 :: Caps
caps1 caps2 :: Caps
caps2 = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps1' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps1
    Ptr Caps
caps2' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps2
    CInt
result <- Ptr Caps -> Ptr Caps -> IO CInt
gst_caps_is_always_compatible Ptr Caps
caps1' Ptr Caps
caps2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps1
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsIsAlwaysCompatibleMethodInfo
instance (signature ~ (Caps -> m Bool), MonadIO m) => O.MethodInfo CapsIsAlwaysCompatibleMethodInfo Caps signature where
    overloadedMethod = capsIsAlwaysCompatible

#endif

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

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

-- | Determines if /@caps@/ represents any media format.
capsIsAny ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: the t'GI.Gst.Structs.Caps.Caps' to test
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@caps@/ represents any format.
capsIsAny :: Caps -> m Bool
capsIsAny caps :: Caps
caps = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    CInt
result <- Ptr Caps -> IO CInt
gst_caps_is_any Ptr Caps
caps'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsIsAnyMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo CapsIsAnyMethodInfo Caps signature where
    overloadedMethod = capsIsAny

#endif

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

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

-- | Determines if /@caps@/ represents no media formats.
capsIsEmpty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: the t'GI.Gst.Structs.Caps.Caps' to test
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@caps@/ represents no formats.
capsIsEmpty :: Caps -> m Bool
capsIsEmpty caps :: Caps
caps = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    CInt
result <- Ptr Caps -> IO CInt
gst_caps_is_empty Ptr Caps
caps'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsIsEmptyMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo CapsIsEmptyMethodInfo Caps signature where
    overloadedMethod = capsIsEmpty

#endif

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

foreign import ccall "gst_caps_is_equal" gst_caps_is_equal :: 
    Ptr Caps ->                             -- caps1 : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Caps ->                             -- caps2 : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

-- | Checks if the given caps represent the same set of caps.
capsIsEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps1@/: a t'GI.Gst.Structs.Caps.Caps'
    -> Caps
    -- ^ /@caps2@/: another t'GI.Gst.Structs.Caps.Caps'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if both caps are equal.
capsIsEqual :: Caps -> Caps -> m Bool
capsIsEqual caps1 :: Caps
caps1 caps2 :: Caps
caps2 = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps1' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps1
    Ptr Caps
caps2' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps2
    CInt
result <- Ptr Caps -> Ptr Caps -> IO CInt
gst_caps_is_equal Ptr Caps
caps1' Ptr Caps
caps2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps1
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsIsEqualMethodInfo
instance (signature ~ (Caps -> m Bool), MonadIO m) => O.MethodInfo CapsIsEqualMethodInfo Caps signature where
    overloadedMethod = capsIsEqual

#endif

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

foreign import ccall "gst_caps_is_equal_fixed" gst_caps_is_equal_fixed :: 
    Ptr Caps ->                             -- caps1 : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Caps ->                             -- caps2 : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

-- | Tests if two t'GI.Gst.Structs.Caps.Caps' are equal.  This function only works on fixed
-- t'GI.Gst.Structs.Caps.Caps'.
capsIsEqualFixed ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps1@/: the t'GI.Gst.Structs.Caps.Caps' to test
    -> Caps
    -- ^ /@caps2@/: the t'GI.Gst.Structs.Caps.Caps' to test
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the arguments represent the same format
capsIsEqualFixed :: Caps -> Caps -> m Bool
capsIsEqualFixed caps1 :: Caps
caps1 caps2 :: Caps
caps2 = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps1' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps1
    Ptr Caps
caps2' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps2
    CInt
result <- Ptr Caps -> Ptr Caps -> IO CInt
gst_caps_is_equal_fixed Ptr Caps
caps1' Ptr Caps
caps2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps1
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsIsEqualFixedMethodInfo
instance (signature ~ (Caps -> m Bool), MonadIO m) => O.MethodInfo CapsIsEqualFixedMethodInfo Caps signature where
    overloadedMethod = capsIsEqualFixed

#endif

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

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

-- | Fixed t'GI.Gst.Structs.Caps.Caps' describe exactly one format, that is, they have exactly
-- one structure, and each field in the structure describes a fixed type.
-- Examples of non-fixed types are GST_TYPE_INT_RANGE and GST_TYPE_LIST.
capsIsFixed ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: the t'GI.Gst.Structs.Caps.Caps' to test
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@caps@/ is fixed
capsIsFixed :: Caps -> m Bool
capsIsFixed caps :: Caps
caps = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    CInt
result <- Ptr Caps -> IO CInt
gst_caps_is_fixed Ptr Caps
caps'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsIsFixedMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo CapsIsFixedMethodInfo Caps signature where
    overloadedMethod = capsIsFixed

#endif

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

foreign import ccall "gst_caps_is_strictly_equal" gst_caps_is_strictly_equal :: 
    Ptr Caps ->                             -- caps1 : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Caps ->                             -- caps2 : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

-- | Checks if the given caps are exactly the same set of caps.
capsIsStrictlyEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps1@/: a t'GI.Gst.Structs.Caps.Caps'
    -> Caps
    -- ^ /@caps2@/: another t'GI.Gst.Structs.Caps.Caps'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if both caps are strictly equal.
capsIsStrictlyEqual :: Caps -> Caps -> m Bool
capsIsStrictlyEqual caps1 :: Caps
caps1 caps2 :: Caps
caps2 = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps1' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps1
    Ptr Caps
caps2' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps2
    CInt
result <- Ptr Caps -> Ptr Caps -> IO CInt
gst_caps_is_strictly_equal Ptr Caps
caps1' Ptr Caps
caps2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps1
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsIsStrictlyEqualMethodInfo
instance (signature ~ (Caps -> m Bool), MonadIO m) => O.MethodInfo CapsIsStrictlyEqualMethodInfo Caps signature where
    overloadedMethod = capsIsStrictlyEqual

#endif

-- method Caps::is_subset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "subset"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "superset"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a potentially greater #GstCaps"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_is_subset" gst_caps_is_subset :: 
    Ptr Caps ->                             -- subset : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Caps ->                             -- superset : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

-- | Checks if all caps represented by /@subset@/ are also represented by /@superset@/.
capsIsSubset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@subset@/: a t'GI.Gst.Structs.Caps.Caps'
    -> Caps
    -- ^ /@superset@/: a potentially greater t'GI.Gst.Structs.Caps.Caps'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@subset@/ is a subset of /@superset@/
capsIsSubset :: Caps -> Caps -> m Bool
capsIsSubset subset :: Caps
subset superset :: Caps
superset = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
subset' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
subset
    Ptr Caps
superset' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
superset
    CInt
result <- Ptr Caps -> Ptr Caps -> IO CInt
gst_caps_is_subset Ptr Caps
subset' Ptr Caps
superset'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
subset
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
superset
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsIsSubsetMethodInfo
instance (signature ~ (Caps -> m Bool), MonadIO m) => O.MethodInfo CapsIsSubsetMethodInfo Caps signature where
    overloadedMethod = capsIsSubset

#endif

-- method Caps::is_subset_structure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a potential #GstStructure subset of @caps"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

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

-- | Checks if /@structure@/ is a subset of /@caps@/. See 'GI.Gst.Structs.Caps.capsIsSubset'
-- for more information.
capsIsSubsetStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> Gst.Structure.Structure
    -- ^ /@structure@/: a potential t'GI.Gst.Structs.Structure.Structure' subset of /@caps@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@structure@/ is a subset of /@caps@/
capsIsSubsetStructure :: Caps -> Structure -> m Bool
capsIsSubsetStructure caps :: Caps
caps structure :: Structure
structure = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    CInt
result <- Ptr Caps -> Ptr Structure -> IO CInt
gst_caps_is_subset_structure Ptr Caps
caps' Ptr Structure
structure'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsIsSubsetStructureMethodInfo
instance (signature ~ (Gst.Structure.Structure -> m Bool), MonadIO m) => O.MethodInfo CapsIsSubsetStructureMethodInfo Caps signature where
    overloadedMethod = capsIsSubsetStructure

#endif

-- method Caps::is_subset_structure_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a potential #GstStructure subset of @caps"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCapsFeatures for @structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_is_subset_structure_full" gst_caps_is_subset_structure_full :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Gst.Structure.Structure ->          -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    Ptr Gst.CapsFeatures.CapsFeatures ->    -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    IO CInt

-- | Checks if /@structure@/ is a subset of /@caps@/. See 'GI.Gst.Structs.Caps.capsIsSubset'
-- for more information.
-- 
-- /Since: 1.2/
capsIsSubsetStructureFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> Gst.Structure.Structure
    -- ^ /@structure@/: a potential t'GI.Gst.Structs.Structure.Structure' subset of /@caps@/
    -> Maybe (Gst.CapsFeatures.CapsFeatures)
    -- ^ /@features@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures' for /@structure@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@structure@/ is a subset of /@caps@/
capsIsSubsetStructureFull :: Caps -> Structure -> Maybe CapsFeatures -> m Bool
capsIsSubsetStructureFull caps :: Caps
caps structure :: Structure
structure features :: Maybe CapsFeatures
features = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    Ptr CapsFeatures
maybeFeatures <- case Maybe CapsFeatures
features of
        Nothing -> Ptr CapsFeatures -> IO (Ptr CapsFeatures)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CapsFeatures
forall a. Ptr a
nullPtr
        Just jFeatures :: CapsFeatures
jFeatures -> do
            Ptr CapsFeatures
jFeatures' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
jFeatures
            Ptr CapsFeatures -> IO (Ptr CapsFeatures)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CapsFeatures
jFeatures'
    CInt
result <- Ptr Caps -> Ptr Structure -> Ptr CapsFeatures -> IO CInt
gst_caps_is_subset_structure_full Ptr Caps
caps' Ptr Structure
structure' Ptr CapsFeatures
maybeFeatures
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Maybe CapsFeatures -> (CapsFeatures -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe CapsFeatures
features CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsIsSubsetStructureFullMethodInfo
instance (signature ~ (Gst.Structure.Structure -> Maybe (Gst.CapsFeatures.CapsFeatures) -> m Bool), MonadIO m) => O.MethodInfo CapsIsSubsetStructureFullMethodInfo Caps signature where
    overloadedMethod = capsIsSubsetStructureFull

#endif

-- method Caps::map_in_place
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsMapFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a function to call for each field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "private data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_map_in_place" gst_caps_map_in_place :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    FunPtr Gst.Callbacks.C_CapsMapFunc ->   -- func : TInterface (Name {namespace = "Gst", name = "CapsMapFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CInt

-- | Calls the provided function once for each structure and caps feature in the
-- t'GI.Gst.Structs.Caps.Caps'. In contrast to 'GI.Gst.Structs.Caps.capsForeach', the function may modify but not
-- delete the structures and features. The caps must be mutable.
-- 
-- /Since: 1.6/
capsMapInPlace ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> Gst.Callbacks.CapsMapFunc
    -- ^ /@func@/: a function to call for each field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the supplied function returns 'P.True' for each call,
    -- 'P.False' otherwise.
capsMapInPlace :: Caps -> CapsFilterMapFunc -> m Bool
capsMapInPlace caps :: Caps
caps func :: CapsFilterMapFunc
func = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    FunPtr C_CapsFilterMapFunc
func' <- C_CapsFilterMapFunc -> IO (FunPtr C_CapsFilterMapFunc)
Gst.Callbacks.mk_CapsMapFunc (Maybe (Ptr (FunPtr C_CapsFilterMapFunc))
-> CapsFilterMapFunc_WithClosures -> C_CapsFilterMapFunc
Gst.Callbacks.wrap_CapsMapFunc Maybe (Ptr (FunPtr C_CapsFilterMapFunc))
forall a. Maybe a
Nothing (CapsFilterMapFunc -> CapsFilterMapFunc_WithClosures
Gst.Callbacks.drop_closures_CapsMapFunc CapsFilterMapFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CInt
result <- Ptr Caps -> FunPtr C_CapsFilterMapFunc -> Ptr () -> IO CInt
gst_caps_map_in_place Ptr Caps
caps' FunPtr C_CapsFilterMapFunc
func' Ptr ()
forall a. Ptr a
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_CapsFilterMapFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CapsFilterMapFunc
func'
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsMapInPlaceMethodInfo
instance (signature ~ (Gst.Callbacks.CapsMapFunc -> m Bool), MonadIO m) => O.MethodInfo CapsMapInPlaceMethodInfo Caps signature where
    overloadedMethod = capsMapInPlace

#endif

-- method Caps::merge
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps1"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCaps that will take the new entries"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "caps2"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCaps to merge in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Caps" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_merge" gst_caps_merge :: 
    Ptr Caps ->                             -- caps1 : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Caps ->                             -- caps2 : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Caps)

-- | Appends the structures contained in /@caps2@/ to /@caps1@/ if they are not yet
-- expressed by /@caps1@/. The structures in /@caps2@/ are not copied -- they are
-- transferred to a writable copy of /@caps1@/, and then /@caps2@/ is freed.
-- If either caps is ANY, the resulting caps will be ANY.
capsMerge ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps1@/: the t'GI.Gst.Structs.Caps.Caps' that will take the new entries
    -> Caps
    -- ^ /@caps2@/: the t'GI.Gst.Structs.Caps.Caps' to merge in
    -> m Caps
    -- ^ __Returns:__ the merged caps.
capsMerge :: Caps -> Caps -> m Caps
capsMerge caps1 :: Caps
caps1 caps2 :: Caps
caps2 = 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 Caps
caps1' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Caps
caps1
    Ptr Caps
caps2' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Caps
caps2
    Ptr Caps
result <- Ptr Caps -> Ptr Caps -> IO (Ptr Caps)
gst_caps_merge Ptr Caps
caps1' Ptr Caps
caps2'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsMerge" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps1
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps2
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data CapsMergeMethodInfo
instance (signature ~ (Caps -> m Caps), MonadIO m) => O.MethodInfo CapsMergeMethodInfo Caps signature where
    overloadedMethod = capsMerge

#endif

-- method Caps::merge_structure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCaps to merge into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstStructure to merge"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Caps" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_merge_structure" gst_caps_merge_structure :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Gst.Structure.Structure ->          -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr Caps)

-- | Appends /@structure@/ to /@caps@/ if its not already expressed by /@caps@/.
capsMergeStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: the t'GI.Gst.Structs.Caps.Caps' to merge into
    -> Gst.Structure.Structure
    -- ^ /@structure@/: the t'GI.Gst.Structs.Structure.Structure' to merge
    -> m Caps
    -- ^ __Returns:__ the merged caps.
capsMergeStructure :: Caps -> Structure -> m Caps
capsMergeStructure caps :: Caps
caps structure :: Structure
structure = 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 Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Caps
caps
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
structure
    Ptr Caps
result <- Ptr Caps -> Ptr Structure -> IO (Ptr Caps)
gst_caps_merge_structure Ptr Caps
caps' Ptr Structure
structure'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsMergeStructure" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data CapsMergeStructureMethodInfo
instance (signature ~ (Gst.Structure.Structure -> m Caps), MonadIO m) => O.MethodInfo CapsMergeStructureMethodInfo Caps signature where
    overloadedMethod = capsMergeStructure

#endif

-- method Caps::merge_structure_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCaps to merge into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstStructure to merge"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCapsFeatures to merge"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Caps" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_merge_structure_full" gst_caps_merge_structure_full :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Gst.Structure.Structure ->          -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    Ptr Gst.CapsFeatures.CapsFeatures ->    -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    IO (Ptr Caps)

-- | Appends /@structure@/ with /@features@/ to /@caps@/ if its not already expressed by /@caps@/.
-- 
-- /Since: 1.2/
capsMergeStructureFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: the t'GI.Gst.Structs.Caps.Caps' to merge into
    -> Gst.Structure.Structure
    -- ^ /@structure@/: the t'GI.Gst.Structs.Structure.Structure' to merge
    -> Maybe (Gst.CapsFeatures.CapsFeatures)
    -- ^ /@features@/: the t'GI.Gst.Structs.CapsFeatures.CapsFeatures' to merge
    -> m Caps
    -- ^ __Returns:__ the merged caps.
capsMergeStructureFull :: Caps -> Structure -> Maybe CapsFeatures -> m Caps
capsMergeStructureFull caps :: Caps
caps structure :: Structure
structure features :: Maybe CapsFeatures
features = 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 Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Caps
caps
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
structure
    Ptr CapsFeatures
maybeFeatures <- case Maybe CapsFeatures
features of
        Nothing -> Ptr CapsFeatures -> IO (Ptr CapsFeatures)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CapsFeatures
forall a. Ptr a
nullPtr
        Just jFeatures :: CapsFeatures
jFeatures -> do
            Ptr CapsFeatures
jFeatures' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed CapsFeatures
jFeatures
            Ptr CapsFeatures -> IO (Ptr CapsFeatures)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CapsFeatures
jFeatures'
    Ptr Caps
result <- Ptr Caps -> Ptr Structure -> Ptr CapsFeatures -> IO (Ptr Caps)
gst_caps_merge_structure_full Ptr Caps
caps' Ptr Structure
structure' Ptr CapsFeatures
maybeFeatures
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsMergeStructureFull" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Maybe CapsFeatures -> (CapsFeatures -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe CapsFeatures
features CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data CapsMergeStructureFullMethodInfo
instance (signature ~ (Gst.Structure.Structure -> Maybe (Gst.CapsFeatures.CapsFeatures) -> m Caps), MonadIO m) => O.MethodInfo CapsMergeStructureFullMethodInfo Caps signature where
    overloadedMethod = capsMergeStructureFull

#endif

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

foreign import ccall "gst_caps_normalize" gst_caps_normalize :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Caps)

-- | Returns a t'GI.Gst.Structs.Caps.Caps' that represents the same set of formats as
-- /@caps@/, but contains no lists.  Each list is expanded into separate
-- /@gstStructures@/.
-- 
-- This function takes ownership of /@caps@/ and will call @/gst_caps_make_writable()/@
-- on it so you must not use /@caps@/ afterwards unless you keep an additional
-- reference to it with @/gst_caps_ref()/@.
capsNormalize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps' to normalize
    -> m Caps
    -- ^ __Returns:__ the normalized t'GI.Gst.Structs.Caps.Caps'
capsNormalize :: Caps -> m Caps
capsNormalize caps :: Caps
caps = 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 Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Caps
caps
    Ptr Caps
result <- Ptr Caps -> IO (Ptr Caps)
gst_caps_normalize Ptr Caps
caps'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsNormalize" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data CapsNormalizeMethodInfo
instance (signature ~ (m Caps), MonadIO m) => O.MethodInfo CapsNormalizeMethodInfo Caps signature where
    overloadedMethod = capsNormalize

#endif

-- method Caps::remove_structure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCaps to remove from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Index of the structure to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_remove_structure" gst_caps_remove_structure :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Word32 ->                               -- idx : TBasicType TUInt
    IO ()

-- | removes the structure with the given index from the list of structures
-- contained in /@caps@/.
capsRemoveStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: the t'GI.Gst.Structs.Caps.Caps' to remove from
    -> Word32
    -- ^ /@idx@/: Index of the structure to remove
    -> m ()
capsRemoveStructure :: Caps -> Word32 -> m ()
capsRemoveStructure caps :: Caps
caps idx :: Word32
idx = 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 Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr Caps -> Word32 -> IO ()
gst_caps_remove_structure Ptr Caps
caps' Word32
idx
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CapsRemoveStructureMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo CapsRemoveStructureMethodInfo Caps signature where
    overloadedMethod = capsRemoveStructure

#endif

-- method Caps::set_features
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCapsFeatures to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_set_features" gst_caps_set_features :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Word32 ->                               -- index : TBasicType TUInt
    Ptr Gst.CapsFeatures.CapsFeatures ->    -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    IO ()

-- | Sets the t'GI.Gst.Structs.CapsFeatures.CapsFeatures' /@features@/ for the structure at /@index@/.
-- 
-- /Since: 1.2/
capsSetFeatures ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> Word32
    -- ^ /@index@/: the index of the structure
    -> Maybe (Gst.CapsFeatures.CapsFeatures)
    -- ^ /@features@/: the t'GI.Gst.Structs.CapsFeatures.CapsFeatures' to set
    -> m ()
capsSetFeatures :: Caps -> Word32 -> Maybe CapsFeatures -> m ()
capsSetFeatures caps :: Caps
caps index :: Word32
index features :: Maybe CapsFeatures
features = 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 Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr CapsFeatures
maybeFeatures <- case Maybe CapsFeatures
features of
        Nothing -> Ptr CapsFeatures -> IO (Ptr CapsFeatures)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CapsFeatures
forall a. Ptr a
nullPtr
        Just jFeatures :: CapsFeatures
jFeatures -> do
            Ptr CapsFeatures
jFeatures' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed CapsFeatures
jFeatures
            Ptr CapsFeatures -> IO (Ptr CapsFeatures)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CapsFeatures
jFeatures'
    Ptr Caps -> Word32 -> Ptr CapsFeatures -> IO ()
gst_caps_set_features Ptr Caps
caps' Word32
index Ptr CapsFeatures
maybeFeatures
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Maybe CapsFeatures -> (CapsFeatures -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe CapsFeatures
features CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CapsSetFeaturesMethodInfo
instance (signature ~ (Word32 -> Maybe (Gst.CapsFeatures.CapsFeatures) -> m ()), MonadIO m) => O.MethodInfo CapsSetFeaturesMethodInfo Caps signature where
    overloadedMethod = capsSetFeatures

#endif

-- method Caps::set_features_simple
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCapsFeatures to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_set_features_simple" gst_caps_set_features_simple :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Gst.CapsFeatures.CapsFeatures ->    -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    IO ()

-- | Sets the t'GI.Gst.Structs.CapsFeatures.CapsFeatures' /@features@/ for all the structures of /@caps@/.
-- 
-- /Since: 1.16/
capsSetFeaturesSimple ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> Maybe (Gst.CapsFeatures.CapsFeatures)
    -- ^ /@features@/: the t'GI.Gst.Structs.CapsFeatures.CapsFeatures' to set
    -> m ()
capsSetFeaturesSimple :: Caps -> Maybe CapsFeatures -> m ()
capsSetFeaturesSimple caps :: Caps
caps features :: Maybe CapsFeatures
features = 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 Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr CapsFeatures
maybeFeatures <- case Maybe CapsFeatures
features of
        Nothing -> Ptr CapsFeatures -> IO (Ptr CapsFeatures)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CapsFeatures
forall a. Ptr a
nullPtr
        Just jFeatures :: CapsFeatures
jFeatures -> do
            Ptr CapsFeatures
jFeatures' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed CapsFeatures
jFeatures
            Ptr CapsFeatures -> IO (Ptr CapsFeatures)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CapsFeatures
jFeatures'
    Ptr Caps -> Ptr CapsFeatures -> IO ()
gst_caps_set_features_simple Ptr Caps
caps' Ptr CapsFeatures
maybeFeatures
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Maybe CapsFeatures -> (CapsFeatures -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe CapsFeatures
features CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CapsSetFeaturesSimpleMethodInfo
instance (signature ~ (Maybe (Gst.CapsFeatures.CapsFeatures) -> m ()), MonadIO m) => O.MethodInfo CapsSetFeaturesSimpleMethodInfo Caps signature where
    overloadedMethod = capsSetFeaturesSimple

#endif

-- method Caps::set_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a writable caps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of the field to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value to set the field to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_set_value" gst_caps_set_value :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    CString ->                              -- field : TBasicType TUTF8
    Ptr GValue ->                           -- value : TInterface (Name {namespace = "GObject", name = "Value"})
    IO ()

-- | Sets the given /@field@/ on all structures of /@caps@/ to the given /@value@/.
-- This is a convenience function for calling 'GI.Gst.Structs.Structure.structureSetValue' on
-- all structures of /@caps@/.
capsSetValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a writable caps
    -> T.Text
    -- ^ /@field@/: name of the field to set
    -> GValue
    -- ^ /@value@/: value to set the field to
    -> m ()
capsSetValue :: Caps -> Text -> GValue -> m ()
capsSetValue caps :: Caps
caps field :: Text
field value :: GValue
value = 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 Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    CString
field' <- Text -> IO CString
textToCString Text
field
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Caps -> CString -> Ptr GValue -> IO ()
gst_caps_set_value Ptr Caps
caps' CString
field' Ptr GValue
value'
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
field'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CapsSetValueMethodInfo
instance (signature ~ (T.Text -> GValue -> m ()), MonadIO m) => O.MethodInfo CapsSetValueMethodInfo Caps signature where
    overloadedMethod = capsSetValue

#endif

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

foreign import ccall "gst_caps_simplify" gst_caps_simplify :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Caps)

-- | Converts the given /@caps@/ into a representation that represents the
-- same set of formats, but in a simpler form.  Component structures that are
-- identical are merged.  Component structures that have values that can be
-- merged are also merged.
-- 
-- This function takes ownership of /@caps@/ and will call @/gst_caps_make_writable()/@
-- on it if necessary, so you must not use /@caps@/ afterwards unless you keep an
-- additional reference to it with @/gst_caps_ref()/@.
-- 
-- This method does not preserve the original order of /@caps@/.
capsSimplify ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps' to simplify
    -> m Caps
    -- ^ __Returns:__ The simplified caps.
capsSimplify :: Caps -> m Caps
capsSimplify caps :: Caps
caps = 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 Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Caps
caps
    Ptr Caps
result <- Ptr Caps -> IO (Ptr Caps)
gst_caps_simplify Ptr Caps
caps'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsSimplify" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data CapsSimplifyMethodInfo
instance (signature ~ (m Caps), MonadIO m) => O.MethodInfo CapsSimplifyMethodInfo Caps signature where
    overloadedMethod = capsSimplify

#endif

-- method Caps::steal_structure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCaps to retrieve from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Index of the structure to retrieve"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Structure" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_caps_steal_structure" gst_caps_steal_structure :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Word32 ->                               -- index : TBasicType TUInt
    IO (Ptr Gst.Structure.Structure)

-- | Retrieves the structure with the given index from the list of structures
-- contained in /@caps@/. The caller becomes the owner of the returned structure.
capsStealStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: the t'GI.Gst.Structs.Caps.Caps' to retrieve from
    -> Word32
    -- ^ /@index@/: Index of the structure to retrieve
    -> m (Maybe Gst.Structure.Structure)
    -- ^ __Returns:__ a pointer to the t'GI.Gst.Structs.Structure.Structure'
    --     corresponding to /@index@/.
capsStealStructure :: Caps -> Word32 -> m (Maybe Structure)
capsStealStructure caps :: Caps
caps index :: Word32
index = IO (Maybe Structure) -> m (Maybe Structure)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Structure) -> m (Maybe Structure))
-> IO (Maybe Structure) -> m (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr Structure
result <- Ptr Caps -> Word32 -> IO (Ptr Structure)
gst_caps_steal_structure Ptr Caps
caps' Word32
index
    Maybe Structure
maybeResult <- Ptr Structure
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Structure
result ((Ptr Structure -> IO Structure) -> IO (Maybe Structure))
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Structure
result' -> do
        Structure
result'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
result'
        Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result''
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Maybe Structure -> IO (Maybe Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Structure
maybeResult

#if defined(ENABLE_OVERLOADING)
data CapsStealStructureMethodInfo
instance (signature ~ (Word32 -> m (Maybe Gst.Structure.Structure)), MonadIO m) => O.MethodInfo CapsStealStructureMethodInfo Caps signature where
    overloadedMethod = capsStealStructure

#endif

-- method Caps::subtract
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "minuend"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstCaps to subtract from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "subtrahend"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstCaps to subtract"
--                 , 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_caps_subtract" gst_caps_subtract :: 
    Ptr Caps ->                             -- minuend : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Caps ->                             -- subtrahend : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Caps)

-- | Subtracts the /@subtrahend@/ from the /@minuend@/.
-- > This function does not work reliably if optional properties for caps
-- > are included on one caps and omitted on the other.
capsSubtract ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@minuend@/: t'GI.Gst.Structs.Caps.Caps' to subtract from
    -> Caps
    -- ^ /@subtrahend@/: t'GI.Gst.Structs.Caps.Caps' to subtract
    -> m Caps
    -- ^ __Returns:__ the resulting caps
capsSubtract :: Caps -> Caps -> m Caps
capsSubtract minuend :: Caps
minuend subtrahend :: Caps
subtrahend = 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 Caps
minuend' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
minuend
    Ptr Caps
subtrahend' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
subtrahend
    Ptr Caps
result <- Ptr Caps -> Ptr Caps -> IO (Ptr Caps)
gst_caps_subtract Ptr Caps
minuend' Ptr Caps
subtrahend'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsSubtract" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
minuend
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
subtrahend
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data CapsSubtractMethodInfo
instance (signature ~ (Caps -> m Caps), MonadIO m) => O.MethodInfo CapsSubtractMethodInfo Caps signature where
    overloadedMethod = capsSubtract

#endif

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

foreign import ccall "gst_caps_to_string" gst_caps_to_string :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CString

-- | Converts /@caps@/ to a string representation.  This string representation
-- can be converted back to a t'GI.Gst.Structs.Caps.Caps' by 'GI.Gst.Functions.capsFromString'.
-- 
-- For debugging purposes its easier to do something like this:
-- 
-- === /C code/
-- >
-- >GST_LOG ("caps are %" GST_PTR_FORMAT, caps);
-- 
-- This prints the caps in human readable form.
-- 
-- The current implementation of serialization will lead to unexpected results
-- when there are nested t'GI.Gst.Structs.Caps.Caps' \/ t'GI.Gst.Structs.Structure.Structure' deeper than one level.
capsToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> m T.Text
    -- ^ __Returns:__ a newly allocated string representing /@caps@/.
capsToString :: Caps -> m Text
capsToString caps :: Caps
caps = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    CString
result <- Ptr Caps -> IO CString
gst_caps_to_string Ptr Caps
caps'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data CapsToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo CapsToStringMethodInfo Caps signature where
    overloadedMethod = capsToString

#endif

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

foreign import ccall "gst_caps_truncate" gst_caps_truncate :: 
    Ptr Caps ->                             -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Caps)

-- | Discard all but the first structure from /@caps@/. Useful when
-- fixating.
-- 
-- This function takes ownership of /@caps@/ and will call @/gst_caps_make_writable()/@
-- on it if necessary, so you must not use /@caps@/ afterwards unless you keep an
-- additional reference to it with @/gst_caps_ref()/@.
capsTruncate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Caps
    -- ^ /@caps@/: the t'GI.Gst.Structs.Caps.Caps' to truncate
    -> m Caps
    -- ^ __Returns:__ truncated caps
capsTruncate :: Caps -> m Caps
capsTruncate caps :: Caps
caps = 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 Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Caps
caps
    Ptr Caps
result <- Ptr Caps -> IO (Ptr Caps)
gst_caps_truncate Ptr Caps
caps'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "capsTruncate" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data CapsTruncateMethodInfo
instance (signature ~ (m Caps), MonadIO m) => O.MethodInfo CapsTruncateMethodInfo Caps signature where
    overloadedMethod = capsTruncate

#endif

-- method Caps::from_string
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string to convert to #GstCaps"
--                 , 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_caps_from_string" gst_caps_from_string :: 
    CString ->                              -- string : TBasicType TUTF8
    IO (Ptr Caps)

-- | Converts /@caps@/ from a string representation.
-- 
-- The current implementation of serialization will lead to unexpected results
-- when there are nested t'GI.Gst.Structs.Caps.Caps' \/ t'GI.Gst.Structs.Structure.Structure' deeper than one level.
capsFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@string@/: a string to convert to t'GI.Gst.Structs.Caps.Caps'
    -> m (Maybe Caps)
    -- ^ __Returns:__ a newly allocated t'GI.Gst.Structs.Caps.Caps'
capsFromString :: Text -> m (Maybe Caps)
capsFromString string :: Text
string = IO (Maybe Caps) -> m (Maybe Caps)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Caps) -> m (Maybe Caps))
-> IO (Maybe Caps) -> m (Maybe Caps)
forall a b. (a -> b) -> a -> b
$ do
    CString
string' <- Text -> IO CString
textToCString Text
string
    Ptr Caps
result <- CString -> IO (Ptr Caps)
gst_caps_from_string CString
string'
    Maybe Caps
maybeResult <- Ptr Caps -> (Ptr Caps -> IO Caps) -> IO (Maybe Caps)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Caps
result ((Ptr Caps -> IO Caps) -> IO (Maybe Caps))
-> (Ptr Caps -> IO Caps) -> IO (Maybe Caps)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Caps
result' -> do
        Caps
result'' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Caps) Ptr Caps
result'
        Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
string'
    Maybe Caps -> IO (Maybe Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Caps
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveCapsMethod (t :: Symbol) (o :: *) :: * where
    ResolveCapsMethod "append" o = CapsAppendMethodInfo
    ResolveCapsMethod "appendStructure" o = CapsAppendStructureMethodInfo
    ResolveCapsMethod "appendStructureFull" o = CapsAppendStructureFullMethodInfo
    ResolveCapsMethod "canIntersect" o = CapsCanIntersectMethodInfo
    ResolveCapsMethod "copy" o = CapsCopyMethodInfo
    ResolveCapsMethod "copyNth" o = CapsCopyNthMethodInfo
    ResolveCapsMethod "filterAndMapInPlace" o = CapsFilterAndMapInPlaceMethodInfo
    ResolveCapsMethod "fixate" o = CapsFixateMethodInfo
    ResolveCapsMethod "foreach" o = CapsForeachMethodInfo
    ResolveCapsMethod "intersect" o = CapsIntersectMethodInfo
    ResolveCapsMethod "intersectFull" o = CapsIntersectFullMethodInfo
    ResolveCapsMethod "isAlwaysCompatible" o = CapsIsAlwaysCompatibleMethodInfo
    ResolveCapsMethod "isAny" o = CapsIsAnyMethodInfo
    ResolveCapsMethod "isEmpty" o = CapsIsEmptyMethodInfo
    ResolveCapsMethod "isEqual" o = CapsIsEqualMethodInfo
    ResolveCapsMethod "isEqualFixed" o = CapsIsEqualFixedMethodInfo
    ResolveCapsMethod "isFixed" o = CapsIsFixedMethodInfo
    ResolveCapsMethod "isStrictlyEqual" o = CapsIsStrictlyEqualMethodInfo
    ResolveCapsMethod "isSubset" o = CapsIsSubsetMethodInfo
    ResolveCapsMethod "isSubsetStructure" o = CapsIsSubsetStructureMethodInfo
    ResolveCapsMethod "isSubsetStructureFull" o = CapsIsSubsetStructureFullMethodInfo
    ResolveCapsMethod "mapInPlace" o = CapsMapInPlaceMethodInfo
    ResolveCapsMethod "merge" o = CapsMergeMethodInfo
    ResolveCapsMethod "mergeStructure" o = CapsMergeStructureMethodInfo
    ResolveCapsMethod "mergeStructureFull" o = CapsMergeStructureFullMethodInfo
    ResolveCapsMethod "normalize" o = CapsNormalizeMethodInfo
    ResolveCapsMethod "removeStructure" o = CapsRemoveStructureMethodInfo
    ResolveCapsMethod "simplify" o = CapsSimplifyMethodInfo
    ResolveCapsMethod "stealStructure" o = CapsStealStructureMethodInfo
    ResolveCapsMethod "subtract" o = CapsSubtractMethodInfo
    ResolveCapsMethod "toString" o = CapsToStringMethodInfo
    ResolveCapsMethod "truncate" o = CapsTruncateMethodInfo
    ResolveCapsMethod "getFeatures" o = CapsGetFeaturesMethodInfo
    ResolveCapsMethod "getSize" o = CapsGetSizeMethodInfo
    ResolveCapsMethod "getStructure" o = CapsGetStructureMethodInfo
    ResolveCapsMethod "setFeatures" o = CapsSetFeaturesMethodInfo
    ResolveCapsMethod "setFeaturesSimple" o = CapsSetFeaturesSimpleMethodInfo
    ResolveCapsMethod "setValue" o = CapsSetValueMethodInfo
    ResolveCapsMethod l o = O.MethodResolutionFailed l o

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

#endif