{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gst.Structs.CapsFeatures.CapsFeatures' can optionally be set on a t'GI.Gst.Structs.Caps.Caps' to add requirements
-- for additional features for a specific t'GI.Gst.Structs.Structure.Structure'. Caps structures with
-- the same name but with a non-equal set of caps features are not compatible.
-- If a pad supports multiple sets of features it has to add multiple equal
-- structures with different feature sets to the caps.
-- 
-- Empty t'GI.Gst.Structs.CapsFeatures.CapsFeatures' are equivalent with the t'GI.Gst.Structs.CapsFeatures.CapsFeatures' that only
-- contain 'GI.Gst.Constants.CAPS_FEATURE_MEMORY_SYSTEM_MEMORY'. ANY t'GI.Gst.Structs.CapsFeatures.CapsFeatures' as
-- created by 'GI.Gst.Structs.CapsFeatures.capsFeaturesNewAny' are equal to any other t'GI.Gst.Structs.CapsFeatures.CapsFeatures'
-- and can be used to specify that any t'GI.Gst.Structs.CapsFeatures.CapsFeatures' would be supported, e.g.
-- for elements that don\'t touch buffer memory. t'GI.Gst.Structs.Caps.Caps' with ANY t'GI.Gst.Structs.CapsFeatures.CapsFeatures'
-- are considered non-fixed and during negotiation some t'GI.Gst.Structs.CapsFeatures.CapsFeatures' have
-- to be selected.
-- 
-- Examples for caps features would be the requirement of a specific t'GI.Gst.Structs.Memory.Memory'
-- types or the requirement of having a specific t'GI.Gst.Structs.Meta.Meta' on the buffer. Features
-- are given as a string of the format \"memory:GstMemoryTypeName\" or
-- \"meta:GstMetaAPIName\".
-- 
-- /Since: 1.2/

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

module GI.Gst.Structs.CapsFeatures
    ( 

-- * Exported types
    CapsFeatures(..)                        ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveCapsFeaturesMethod               ,
#endif


-- ** add #method:add#

#if defined(ENABLE_OVERLOADING)
    CapsFeaturesAddMethodInfo               ,
#endif
    capsFeaturesAdd                         ,


-- ** addId #method:addId#

#if defined(ENABLE_OVERLOADING)
    CapsFeaturesAddIdMethodInfo             ,
#endif
    capsFeaturesAddId                       ,


-- ** contains #method:contains#

#if defined(ENABLE_OVERLOADING)
    CapsFeaturesContainsMethodInfo          ,
#endif
    capsFeaturesContains                    ,


-- ** containsId #method:containsId#

#if defined(ENABLE_OVERLOADING)
    CapsFeaturesContainsIdMethodInfo        ,
#endif
    capsFeaturesContainsId                  ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    CapsFeaturesCopyMethodInfo              ,
#endif
    capsFeaturesCopy                        ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    CapsFeaturesFreeMethodInfo              ,
#endif
    capsFeaturesFree                        ,


-- ** fromString #method:fromString#

    capsFeaturesFromString                  ,


-- ** getNth #method:getNth#

#if defined(ENABLE_OVERLOADING)
    CapsFeaturesGetNthMethodInfo            ,
#endif
    capsFeaturesGetNth                      ,


-- ** getNthId #method:getNthId#

#if defined(ENABLE_OVERLOADING)
    CapsFeaturesGetNthIdMethodInfo          ,
#endif
    capsFeaturesGetNthId                    ,


-- ** getSize #method:getSize#

#if defined(ENABLE_OVERLOADING)
    CapsFeaturesGetSizeMethodInfo           ,
#endif
    capsFeaturesGetSize                     ,


-- ** isAny #method:isAny#

#if defined(ENABLE_OVERLOADING)
    CapsFeaturesIsAnyMethodInfo             ,
#endif
    capsFeaturesIsAny                       ,


-- ** isEqual #method:isEqual#

#if defined(ENABLE_OVERLOADING)
    CapsFeaturesIsEqualMethodInfo           ,
#endif
    capsFeaturesIsEqual                     ,


-- ** newAny #method:newAny#

    capsFeaturesNewAny                      ,


-- ** newEmpty #method:newEmpty#

    capsFeaturesNewEmpty                    ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    CapsFeaturesRemoveMethodInfo            ,
#endif
    capsFeaturesRemove                      ,


-- ** removeId #method:removeId#

#if defined(ENABLE_OVERLOADING)
    CapsFeaturesRemoveIdMethodInfo          ,
#endif
    capsFeaturesRemoveId                    ,


-- ** setParentRefcount #method:setParentRefcount#

#if defined(ENABLE_OVERLOADING)
    CapsFeaturesSetParentRefcountMethodInfo ,
#endif
    capsFeaturesSetParentRefcount           ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    CapsFeaturesToStringMethodInfo          ,
#endif
    capsFeaturesToString                    ,




    ) where

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

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


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

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

foreign import ccall "gst_caps_features_get_type" c_gst_caps_features_get_type :: 
    IO GType

type instance O.ParentTypes CapsFeatures = '[]
instance O.HasParentTypes CapsFeatures

instance B.Types.TypedObject CapsFeatures where
    glibType :: IO GType
glibType = IO GType
c_gst_caps_features_get_type

instance B.Types.GBoxed CapsFeatures

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


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList CapsFeatures
type instance O.AttributeList CapsFeatures = CapsFeaturesAttributeList
type CapsFeaturesAttributeList = ('[ ] :: [(Symbol, *)])
#endif

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

foreign import ccall "gst_caps_features_new_any" gst_caps_features_new_any :: 
    IO (Ptr CapsFeatures)

-- | Creates a new, ANY t'GI.Gst.Structs.CapsFeatures.CapsFeatures'. This will be equal
-- to any other t'GI.Gst.Structs.CapsFeatures.CapsFeatures' but caps with these are
-- unfixed.
-- 
-- Free-function: gst_caps_features_free
-- 
-- /Since: 1.2/
capsFeaturesNewAny ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m CapsFeatures
    -- ^ __Returns:__ a new, ANY t'GI.Gst.Structs.CapsFeatures.CapsFeatures'
capsFeaturesNewAny :: m CapsFeatures
capsFeaturesNewAny  = IO CapsFeatures -> m CapsFeatures
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CapsFeatures -> m CapsFeatures)
-> IO CapsFeatures -> m CapsFeatures
forall a b. (a -> b) -> a -> b
$ do
    Ptr CapsFeatures
result <- IO (Ptr CapsFeatures)
gst_caps_features_new_any
    Text -> Ptr CapsFeatures -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"capsFeaturesNewAny" Ptr CapsFeatures
result
    CapsFeatures
result' <- ((ManagedPtr CapsFeatures -> CapsFeatures)
-> Ptr CapsFeatures -> IO CapsFeatures
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr CapsFeatures -> CapsFeatures
CapsFeatures) Ptr CapsFeatures
result
    CapsFeatures -> IO CapsFeatures
forall (m :: * -> *) a. Monad m => a -> m a
return CapsFeatures
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gst_caps_features_new_empty" gst_caps_features_new_empty :: 
    IO (Ptr CapsFeatures)

-- | Creates a new, empty t'GI.Gst.Structs.CapsFeatures.CapsFeatures'.
-- 
-- Free-function: gst_caps_features_free
-- 
-- /Since: 1.2/
capsFeaturesNewEmpty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m CapsFeatures
    -- ^ __Returns:__ a new, empty t'GI.Gst.Structs.CapsFeatures.CapsFeatures'
capsFeaturesNewEmpty :: m CapsFeatures
capsFeaturesNewEmpty  = IO CapsFeatures -> m CapsFeatures
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CapsFeatures -> m CapsFeatures)
-> IO CapsFeatures -> m CapsFeatures
forall a b. (a -> b) -> a -> b
$ do
    Ptr CapsFeatures
result <- IO (Ptr CapsFeatures)
gst_caps_features_new_empty
    Text -> Ptr CapsFeatures -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"capsFeaturesNewEmpty" Ptr CapsFeatures
result
    CapsFeatures
result' <- ((ManagedPtr CapsFeatures -> CapsFeatures)
-> Ptr CapsFeatures -> IO CapsFeatures
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr CapsFeatures -> CapsFeatures
CapsFeatures) Ptr CapsFeatures
result
    CapsFeatures -> IO CapsFeatures
forall (m :: * -> *) a. Monad m => a -> m a
return CapsFeatures
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method CapsFeatures::add
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCapsFeatures."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "feature"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a feature." , 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_features_add" gst_caps_features_add :: 
    Ptr CapsFeatures ->                     -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    CString ->                              -- feature : TBasicType TUTF8
    IO ()

-- | Adds /@feature@/ to /@features@/.
-- 
-- /Since: 1.2/
capsFeaturesAdd ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CapsFeatures
    -- ^ /@features@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures'.
    -> T.Text
    -- ^ /@feature@/: a feature.
    -> m ()
capsFeaturesAdd :: CapsFeatures -> Text -> m ()
capsFeaturesAdd CapsFeatures
features Text
feature = 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 CapsFeatures
features' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
features
    CString
feature' <- Text -> IO CString
textToCString Text
feature
    Ptr CapsFeatures -> CString -> IO ()
gst_caps_features_add Ptr CapsFeatures
features' CString
feature'
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
feature'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CapsFeaturesAddMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.MethodInfo CapsFeaturesAddMethodInfo CapsFeatures signature where
    overloadedMethod = capsFeaturesAdd

#endif

-- method CapsFeatures::add_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCapsFeatures."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "feature"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a feature." , 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_features_add_id" gst_caps_features_add_id :: 
    Ptr CapsFeatures ->                     -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    Word32 ->                               -- feature : TBasicType TUInt32
    IO ()

-- | Adds /@feature@/ to /@features@/.
-- 
-- /Since: 1.2/
capsFeaturesAddId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CapsFeatures
    -- ^ /@features@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures'.
    -> Word32
    -- ^ /@feature@/: a feature.
    -> m ()
capsFeaturesAddId :: CapsFeatures -> Word32 -> m ()
capsFeaturesAddId CapsFeatures
features Word32
feature = 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 CapsFeatures
features' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
features
    Ptr CapsFeatures -> Word32 -> IO ()
gst_caps_features_add_id Ptr CapsFeatures
features' Word32
feature
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CapsFeaturesAddIdMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo CapsFeaturesAddIdMethodInfo CapsFeatures signature where
    overloadedMethod = capsFeaturesAddId

#endif

-- method CapsFeatures::contains
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCapsFeatures."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "feature"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a feature" , 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_features_contains" gst_caps_features_contains :: 
    Ptr CapsFeatures ->                     -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    CString ->                              -- feature : TBasicType TUTF8
    IO CInt

-- | Check if /@features@/ contains /@feature@/.
-- 
-- /Since: 1.2/
capsFeaturesContains ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CapsFeatures
    -- ^ /@features@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures'.
    -> T.Text
    -- ^ /@feature@/: a feature
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@features@/ contains /@feature@/.
capsFeaturesContains :: CapsFeatures -> Text -> m Bool
capsFeaturesContains CapsFeatures
features Text
feature = 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 CapsFeatures
features' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
features
    CString
feature' <- Text -> IO CString
textToCString Text
feature
    CInt
result <- Ptr CapsFeatures -> CString -> IO CInt
gst_caps_features_contains Ptr CapsFeatures
features' CString
feature'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
feature'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsFeaturesContainsMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.MethodInfo CapsFeaturesContainsMethodInfo CapsFeatures signature where
    overloadedMethod = capsFeaturesContains

#endif

-- method CapsFeatures::contains_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCapsFeatures."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "feature"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a feature" , 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_features_contains_id" gst_caps_features_contains_id :: 
    Ptr CapsFeatures ->                     -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    Word32 ->                               -- feature : TBasicType TUInt32
    IO CInt

-- | Check if /@features@/ contains /@feature@/.
-- 
-- /Since: 1.2/
capsFeaturesContainsId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CapsFeatures
    -- ^ /@features@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures'.
    -> Word32
    -- ^ /@feature@/: a feature
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@features@/ contains /@feature@/.
capsFeaturesContainsId :: CapsFeatures -> Word32 -> m Bool
capsFeaturesContainsId CapsFeatures
features Word32
feature = 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 CapsFeatures
features' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
features
    CInt
result <- Ptr CapsFeatures -> Word32 -> IO CInt
gst_caps_features_contains_id Ptr CapsFeatures
features' Word32
feature
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsFeaturesContainsIdMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m) => O.MethodInfo CapsFeaturesContainsIdMethodInfo CapsFeatures signature where
    overloadedMethod = capsFeaturesContainsId

#endif

-- method CapsFeatures::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCapsFeatures to duplicate"
--                 , 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_features_copy" gst_caps_features_copy :: 
    Ptr CapsFeatures ->                     -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    IO (Ptr CapsFeatures)

-- | Duplicates a t'GI.Gst.Structs.CapsFeatures.CapsFeatures' and all its values.
-- 
-- Free-function: gst_caps_features_free
-- 
-- /Since: 1.2/
capsFeaturesCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CapsFeatures
    -- ^ /@features@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures' to duplicate
    -> m CapsFeatures
    -- ^ __Returns:__ a new t'GI.Gst.Structs.CapsFeatures.CapsFeatures'.
capsFeaturesCopy :: CapsFeatures -> m CapsFeatures
capsFeaturesCopy CapsFeatures
features = IO CapsFeatures -> m CapsFeatures
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CapsFeatures -> m CapsFeatures)
-> IO CapsFeatures -> m CapsFeatures
forall a b. (a -> b) -> a -> b
$ do
    Ptr CapsFeatures
features' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
features
    Ptr CapsFeatures
result <- Ptr CapsFeatures -> IO (Ptr CapsFeatures)
gst_caps_features_copy Ptr CapsFeatures
features'
    Text -> Ptr CapsFeatures -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"capsFeaturesCopy" Ptr CapsFeatures
result
    CapsFeatures
result' <- ((ManagedPtr CapsFeatures -> CapsFeatures)
-> Ptr CapsFeatures -> IO CapsFeatures
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr CapsFeatures -> CapsFeatures
CapsFeatures) Ptr CapsFeatures
result
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features
    CapsFeatures -> IO CapsFeatures
forall (m :: * -> *) a. Monad m => a -> m a
return CapsFeatures
result'

#if defined(ENABLE_OVERLOADING)
data CapsFeaturesCopyMethodInfo
instance (signature ~ (m CapsFeatures), MonadIO m) => O.MethodInfo CapsFeaturesCopyMethodInfo CapsFeatures signature where
    overloadedMethod = capsFeaturesCopy

#endif

-- method CapsFeatures::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCapsFeatures to free"
--                 , 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_features_free" gst_caps_features_free :: 
    Ptr CapsFeatures ->                     -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    IO ()

-- | Frees a t'GI.Gst.Structs.CapsFeatures.CapsFeatures' and all its values. The caps features must not
-- have a parent when this function is called.
-- 
-- /Since: 1.2/
capsFeaturesFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CapsFeatures
    -- ^ /@features@/: the t'GI.Gst.Structs.CapsFeatures.CapsFeatures' to free
    -> m ()
capsFeaturesFree :: CapsFeatures -> m ()
capsFeaturesFree 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 CapsFeatures
features' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed CapsFeatures
features
    Ptr CapsFeatures -> IO ()
gst_caps_features_free Ptr CapsFeatures
features'
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CapsFeaturesFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo CapsFeaturesFreeMethodInfo CapsFeatures signature where
    overloadedMethod = capsFeaturesFree

#endif

-- method CapsFeatures::get_nth
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCapsFeatures."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "i"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of the feature"
--                 , 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_features_get_nth" gst_caps_features_get_nth :: 
    Ptr CapsFeatures ->                     -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    Word32 ->                               -- i : TBasicType TUInt
    IO CString

-- | Returns the /@i@/-th feature of /@features@/.
-- 
-- /Since: 1.2/
capsFeaturesGetNth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CapsFeatures
    -- ^ /@features@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures'.
    -> Word32
    -- ^ /@i@/: index of the feature
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The /@i@/-th feature of /@features@/.
capsFeaturesGetNth :: CapsFeatures -> Word32 -> m (Maybe Text)
capsFeaturesGetNth CapsFeatures
features Word32
i = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CapsFeatures
features' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
features
    CString
result <- Ptr CapsFeatures -> Word32 -> IO CString
gst_caps_features_get_nth Ptr CapsFeatures
features' Word32
i
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data CapsFeaturesGetNthMethodInfo
instance (signature ~ (Word32 -> m (Maybe T.Text)), MonadIO m) => O.MethodInfo CapsFeaturesGetNthMethodInfo CapsFeatures signature where
    overloadedMethod = capsFeaturesGetNth

#endif

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

foreign import ccall "gst_caps_features_get_nth_id" gst_caps_features_get_nth_id :: 
    Ptr CapsFeatures ->                     -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    Word32 ->                               -- i : TBasicType TUInt
    IO Word32

-- | Returns the /@i@/-th feature of /@features@/.
-- 
-- /Since: 1.2/
capsFeaturesGetNthId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CapsFeatures
    -- ^ /@features@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures'.
    -> Word32
    -- ^ /@i@/: index of the feature
    -> m Word32
    -- ^ __Returns:__ The /@i@/-th feature of /@features@/.
capsFeaturesGetNthId :: CapsFeatures -> Word32 -> m Word32
capsFeaturesGetNthId CapsFeatures
features Word32
i = 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 CapsFeatures
features' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
features
    Word32
result <- Ptr CapsFeatures -> Word32 -> IO Word32
gst_caps_features_get_nth_id Ptr CapsFeatures
features' Word32
i
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data CapsFeaturesGetNthIdMethodInfo
instance (signature ~ (Word32 -> m Word32), MonadIO m) => O.MethodInfo CapsFeaturesGetNthIdMethodInfo CapsFeatures signature where
    overloadedMethod = capsFeaturesGetNthId

#endif

-- method CapsFeatures::get_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCapsFeatures."
--                 , 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_features_get_size" gst_caps_features_get_size :: 
    Ptr CapsFeatures ->                     -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    IO Word32

-- | Returns the number of features in /@features@/.
-- 
-- /Since: 1.2/
capsFeaturesGetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CapsFeatures
    -- ^ /@features@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures'.
    -> m Word32
    -- ^ __Returns:__ The number of features in /@features@/.
capsFeaturesGetSize :: CapsFeatures -> m Word32
capsFeaturesGetSize CapsFeatures
features = 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 CapsFeatures
features' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
features
    Word32
result <- Ptr CapsFeatures -> IO Word32
gst_caps_features_get_size Ptr CapsFeatures
features'
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data CapsFeaturesGetSizeMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo CapsFeaturesGetSizeMethodInfo CapsFeatures signature where
    overloadedMethod = capsFeaturesGetSize

#endif

-- method CapsFeatures::is_any
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCapsFeatures."
--                 , 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_features_is_any" gst_caps_features_is_any :: 
    Ptr CapsFeatures ->                     -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    IO CInt

-- | Check if /@features@/ is @/GST_CAPS_FEATURES_ANY/@.
-- 
-- /Since: 1.2/
capsFeaturesIsAny ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CapsFeatures
    -- ^ /@features@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@features@/ is @/GST_CAPS_FEATURES_ANY/@.
capsFeaturesIsAny :: CapsFeatures -> m Bool
capsFeaturesIsAny 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 CapsFeatures
features' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
features
    CInt
result <- Ptr CapsFeatures -> IO CInt
gst_caps_features_is_any Ptr CapsFeatures
features'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsFeaturesIsAnyMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo CapsFeaturesIsAnyMethodInfo CapsFeatures signature where
    overloadedMethod = capsFeaturesIsAny

#endif

-- method CapsFeatures::is_equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "features1"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCapsFeatures."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "features2"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCapsFeatures."
--                 , 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_features_is_equal" gst_caps_features_is_equal :: 
    Ptr CapsFeatures ->                     -- features1 : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    Ptr CapsFeatures ->                     -- features2 : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    IO CInt

-- | Check if /@features1@/ and /@features2@/ are equal.
-- 
-- /Since: 1.2/
capsFeaturesIsEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CapsFeatures
    -- ^ /@features1@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures'.
    -> CapsFeatures
    -- ^ /@features2@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@features1@/ and /@features2@/ are equal.
capsFeaturesIsEqual :: CapsFeatures -> CapsFeatures -> m Bool
capsFeaturesIsEqual CapsFeatures
features1 CapsFeatures
features2 = 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 CapsFeatures
features1' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
features1
    Ptr CapsFeatures
features2' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
features2
    CInt
result <- Ptr CapsFeatures -> Ptr CapsFeatures -> IO CInt
gst_caps_features_is_equal Ptr CapsFeatures
features1' Ptr CapsFeatures
features2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features1
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsFeaturesIsEqualMethodInfo
instance (signature ~ (CapsFeatures -> m Bool), MonadIO m) => O.MethodInfo CapsFeaturesIsEqualMethodInfo CapsFeatures signature where
    overloadedMethod = capsFeaturesIsEqual

#endif

-- method CapsFeatures::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCapsFeatures."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "feature"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a feature." , 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_features_remove" gst_caps_features_remove :: 
    Ptr CapsFeatures ->                     -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    CString ->                              -- feature : TBasicType TUTF8
    IO ()

-- | Removes /@feature@/ from /@features@/.
-- 
-- /Since: 1.2/
capsFeaturesRemove ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CapsFeatures
    -- ^ /@features@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures'.
    -> T.Text
    -- ^ /@feature@/: a feature.
    -> m ()
capsFeaturesRemove :: CapsFeatures -> Text -> m ()
capsFeaturesRemove CapsFeatures
features Text
feature = 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 CapsFeatures
features' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
features
    CString
feature' <- Text -> IO CString
textToCString Text
feature
    Ptr CapsFeatures -> CString -> IO ()
gst_caps_features_remove Ptr CapsFeatures
features' CString
feature'
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
feature'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CapsFeaturesRemoveMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.MethodInfo CapsFeaturesRemoveMethodInfo CapsFeatures signature where
    overloadedMethod = capsFeaturesRemove

#endif

-- method CapsFeatures::remove_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCapsFeatures."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "feature"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a feature." , 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_features_remove_id" gst_caps_features_remove_id :: 
    Ptr CapsFeatures ->                     -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    Word32 ->                               -- feature : TBasicType TUInt32
    IO ()

-- | Removes /@feature@/ from /@features@/.
-- 
-- /Since: 1.2/
capsFeaturesRemoveId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CapsFeatures
    -- ^ /@features@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures'.
    -> Word32
    -- ^ /@feature@/: a feature.
    -> m ()
capsFeaturesRemoveId :: CapsFeatures -> Word32 -> m ()
capsFeaturesRemoveId CapsFeatures
features Word32
feature = 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 CapsFeatures
features' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
features
    Ptr CapsFeatures -> Word32 -> IO ()
gst_caps_features_remove_id Ptr CapsFeatures
features' Word32
feature
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CapsFeaturesRemoveIdMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo CapsFeaturesRemoveIdMethodInfo CapsFeatures signature where
    overloadedMethod = capsFeaturesRemoveId

#endif

-- method CapsFeatures::set_parent_refcount
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCapsFeatures" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "refcount"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to the parent's refcount"
--                 , 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_features_set_parent_refcount" gst_caps_features_set_parent_refcount :: 
    Ptr CapsFeatures ->                     -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    Int32 ->                                -- refcount : TBasicType TInt
    IO CInt

-- | Sets the parent_refcount field of t'GI.Gst.Structs.CapsFeatures.CapsFeatures'. This field is used to
-- determine whether a caps features is mutable or not. This function should only be
-- called by code implementing parent objects of t'GI.Gst.Structs.CapsFeatures.CapsFeatures', as described in
-- the MT Refcounting section of the design documents.
-- 
-- /Since: 1.2/
capsFeaturesSetParentRefcount ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CapsFeatures
    -- ^ /@features@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures'
    -> Int32
    -- ^ /@refcount@/: a pointer to the parent\'s refcount
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the parent refcount could be set.
capsFeaturesSetParentRefcount :: CapsFeatures -> Int32 -> m Bool
capsFeaturesSetParentRefcount CapsFeatures
features Int32
refcount = 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 CapsFeatures
features' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
features
    CInt
result <- Ptr CapsFeatures -> Int32 -> IO CInt
gst_caps_features_set_parent_refcount Ptr CapsFeatures
features' Int32
refcount
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CapsFeaturesSetParentRefcountMethodInfo
instance (signature ~ (Int32 -> m Bool), MonadIO m) => O.MethodInfo CapsFeaturesSetParentRefcountMethodInfo CapsFeatures signature where
    overloadedMethod = capsFeaturesSetParentRefcount

#endif

-- method CapsFeatures::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "features"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CapsFeatures" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCapsFeatures" , 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_features_to_string" gst_caps_features_to_string :: 
    Ptr CapsFeatures ->                     -- features : TInterface (Name {namespace = "Gst", name = "CapsFeatures"})
    IO CString

-- | Converts /@features@/ to a human-readable string representation.
-- 
-- For debugging purposes its easier to do something like this:
-- 
-- === /C code/
-- >
-- >GST_LOG ("features is %" GST_PTR_FORMAT, features);
-- 
-- This prints the features in human readable form.
-- 
-- Free-function: g_free
-- 
-- /Since: 1.2/
capsFeaturesToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CapsFeatures
    -- ^ /@features@/: a t'GI.Gst.Structs.CapsFeatures.CapsFeatures'
    -> m T.Text
    -- ^ __Returns:__ a pointer to string allocated by 'GI.GLib.Functions.malloc'.
    --     'GI.GLib.Functions.free' after usage.
capsFeaturesToString :: CapsFeatures -> m Text
capsFeaturesToString CapsFeatures
features = 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 CapsFeatures
features' <- CapsFeatures -> IO (Ptr CapsFeatures)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CapsFeatures
features
    CString
result <- Ptr CapsFeatures -> IO CString
gst_caps_features_to_string Ptr CapsFeatures
features'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"capsFeaturesToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    CapsFeatures -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CapsFeatures
features
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data CapsFeaturesToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo CapsFeaturesToStringMethodInfo CapsFeatures signature where
    overloadedMethod = capsFeaturesToString

#endif

-- method CapsFeatures::from_string
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "features"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a string representation of a #GstCapsFeatures."
--                 , 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_features_from_string" gst_caps_features_from_string :: 
    CString ->                              -- features : TBasicType TUTF8
    IO (Ptr CapsFeatures)

-- | Creates a t'GI.Gst.Structs.CapsFeatures.CapsFeatures' from a string representation.
-- 
-- Free-function: gst_caps_features_free
-- 
-- /Since: 1.2/
capsFeaturesFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@features@/: a string representation of a t'GI.Gst.Structs.CapsFeatures.CapsFeatures'.
    -> m (Maybe CapsFeatures)
    -- ^ __Returns:__ a new t'GI.Gst.Structs.CapsFeatures.CapsFeatures' or
    --     'P.Nothing' when the string could not be parsed. Free with
    --     'GI.Gst.Structs.CapsFeatures.capsFeaturesFree' after use.
capsFeaturesFromString :: Text -> m (Maybe CapsFeatures)
capsFeaturesFromString Text
features = 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
    CString
features' <- Text -> IO CString
textToCString Text
features
    Ptr CapsFeatures
result <- CString -> IO (Ptr CapsFeatures)
gst_caps_features_from_string CString
features'
    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
$ \Ptr CapsFeatures
result' -> do
        CapsFeatures
result'' <- ((ManagedPtr CapsFeatures -> CapsFeatures)
-> Ptr CapsFeatures -> IO CapsFeatures
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr CapsFeatures -> CapsFeatures
CapsFeatures) Ptr CapsFeatures
result'
        CapsFeatures -> IO CapsFeatures
forall (m :: * -> *) a. Monad m => a -> m a
return CapsFeatures
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
features'
    Maybe CapsFeatures -> IO (Maybe CapsFeatures)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CapsFeatures
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveCapsFeaturesMethod (t :: Symbol) (o :: *) :: * where
    ResolveCapsFeaturesMethod "add" o = CapsFeaturesAddMethodInfo
    ResolveCapsFeaturesMethod "addId" o = CapsFeaturesAddIdMethodInfo
    ResolveCapsFeaturesMethod "contains" o = CapsFeaturesContainsMethodInfo
    ResolveCapsFeaturesMethod "containsId" o = CapsFeaturesContainsIdMethodInfo
    ResolveCapsFeaturesMethod "copy" o = CapsFeaturesCopyMethodInfo
    ResolveCapsFeaturesMethod "free" o = CapsFeaturesFreeMethodInfo
    ResolveCapsFeaturesMethod "isAny" o = CapsFeaturesIsAnyMethodInfo
    ResolveCapsFeaturesMethod "isEqual" o = CapsFeaturesIsEqualMethodInfo
    ResolveCapsFeaturesMethod "remove" o = CapsFeaturesRemoveMethodInfo
    ResolveCapsFeaturesMethod "removeId" o = CapsFeaturesRemoveIdMethodInfo
    ResolveCapsFeaturesMethod "toString" o = CapsFeaturesToStringMethodInfo
    ResolveCapsFeaturesMethod "getNth" o = CapsFeaturesGetNthMethodInfo
    ResolveCapsFeaturesMethod "getNthId" o = CapsFeaturesGetNthIdMethodInfo
    ResolveCapsFeaturesMethod "getSize" o = CapsFeaturesGetSizeMethodInfo
    ResolveCapsFeaturesMethod "setParentRefcount" o = CapsFeaturesSetParentRefcountMethodInfo
    ResolveCapsFeaturesMethod l o = O.MethodResolutionFailed l o

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

#endif