{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Extra custom metadata. The /@structure@/ field is the same as returned by
-- 'GI.Gst.Structs.CustomMeta.customMetaGetStructure'.
-- 
-- Since 1.24 it can be serialized using 'GI.Gst.Structs.Meta.metaSerialize' and
-- 'GI.Gst.Functions.metaDeserialize', but only if the t'GI.Gst.Structs.Structure.Structure' does not contain any
-- fields that cannot be serialized, see 'GI.Gst.Flags.SerializeFlagsStrict'.
-- 
-- /Since: 1.20/

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

module GI.Gst.Structs.CustomMeta
    ( 

-- * Exported types
    CustomMeta(..)                          ,
    newZeroCustomMeta                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [hasName]("GI.Gst.Structs.CustomMeta#g:method:hasName").
-- 
-- ==== Getters
-- [getStructure]("GI.Gst.Structs.CustomMeta#g:method:getStructure").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveCustomMetaMethod                 ,
#endif

-- ** getStructure #method:getStructure#

#if defined(ENABLE_OVERLOADING)
    CustomMetaGetStructureMethodInfo        ,
#endif
    customMetaGetStructure                  ,


-- ** hasName #method:hasName#

#if defined(ENABLE_OVERLOADING)
    CustomMetaHasNameMethodInfo             ,
#endif
    customMetaHasName                       ,




 -- * Properties


-- ** meta #attr:meta#
-- | parent t'GI.Gst.Structs.Meta.Meta'

#if defined(ENABLE_OVERLOADING)
    customMeta_meta                         ,
#endif
    getCustomMetaMeta                       ,


-- ** structure #attr:structure#
-- | t'GI.Gst.Structs.Structure.Structure' containing custom metadata.
-- 
-- /Since: 1.24/

    clearCustomMetaStructure                ,
#if defined(ENABLE_OVERLOADING)
    customMeta_structure                    ,
#endif
    getCustomMetaStructure                  ,
    setCustomMetaStructure                  ,




    ) 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.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.Date as GLib.Date
import qualified GI.GLib.Structs.DateTime as GLib.DateTime
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.GObject.Structs.ValueArray as GObject.ValueArray
import qualified GI.Gst.Callbacks as Gst.Callbacks
import {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums
import {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags
import {-# SOURCE #-} qualified GI.Gst.Objects.Allocator as Gst.Allocator
import {-# SOURCE #-} qualified GI.Gst.Objects.BufferPool as Gst.BufferPool
import {-# SOURCE #-} qualified GI.Gst.Objects.ControlBinding as Gst.ControlBinding
import {-# SOURCE #-} qualified GI.Gst.Objects.Object as Gst.Object
import {-# SOURCE #-} qualified GI.Gst.Structs.AllocationParams as Gst.AllocationParams
import {-# SOURCE #-} qualified GI.Gst.Structs.Buffer as Gst.Buffer
import {-# SOURCE #-} qualified GI.Gst.Structs.BufferPoolAcquireParams as Gst.BufferPoolAcquireParams
import {-# SOURCE #-} qualified GI.Gst.Structs.ByteArrayInterface as Gst.ByteArrayInterface
import {-# SOURCE #-} qualified GI.Gst.Structs.Caps as Gst.Caps
import {-# SOURCE #-} qualified GI.Gst.Structs.CapsFeatures as Gst.CapsFeatures
import {-# SOURCE #-} qualified GI.Gst.Structs.DateTime as Gst.DateTime
import {-# SOURCE #-} qualified GI.Gst.Structs.MapInfo as Gst.MapInfo
import {-# SOURCE #-} qualified GI.Gst.Structs.Memory as Gst.Memory
import {-# SOURCE #-} qualified GI.Gst.Structs.Meta as Gst.Meta
import {-# SOURCE #-} qualified GI.Gst.Structs.MetaInfo as Gst.MetaInfo
import {-# SOURCE #-} qualified GI.Gst.Structs.MiniObject as Gst.MiniObject
import {-# SOURCE #-} qualified GI.Gst.Structs.ParentBufferMeta as Gst.ParentBufferMeta
import {-# SOURCE #-} qualified GI.Gst.Structs.ProtectionMeta as Gst.ProtectionMeta
import {-# SOURCE #-} qualified GI.Gst.Structs.ReferenceTimestampMeta as Gst.ReferenceTimestampMeta
import {-# SOURCE #-} qualified GI.Gst.Structs.Structure as Gst.Structure

#else
import {-# SOURCE #-} qualified GI.Gst.Structs.Meta as Gst.Meta
import {-# SOURCE #-} qualified GI.Gst.Structs.Structure as Gst.Structure

#endif

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

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

instance BoxedPtr CustomMeta where
    boxedPtrCopy :: CustomMeta -> IO CustomMeta
boxedPtrCopy = \CustomMeta
p -> CustomMeta -> (Ptr CustomMeta -> IO CustomMeta) -> IO CustomMeta
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr CustomMeta
p (Int -> Ptr CustomMeta -> IO (Ptr CustomMeta)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
24 (Ptr CustomMeta -> IO (Ptr CustomMeta))
-> (Ptr CustomMeta -> IO CustomMeta)
-> Ptr CustomMeta
-> IO CustomMeta
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr CustomMeta -> CustomMeta)
-> Ptr CustomMeta -> IO CustomMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr CustomMeta -> CustomMeta
CustomMeta)
    boxedPtrFree :: CustomMeta -> IO ()
boxedPtrFree = \CustomMeta
x -> CustomMeta -> (Ptr CustomMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr CustomMeta
x Ptr CustomMeta -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr CustomMeta where
    boxedPtrCalloc :: IO (Ptr CustomMeta)
boxedPtrCalloc = Int -> IO (Ptr CustomMeta)
forall a. Int -> IO (Ptr a)
callocBytes Int
24


-- | Construct a `CustomMeta` struct initialized to zero.
newZeroCustomMeta :: MonadIO m => m CustomMeta
newZeroCustomMeta :: forall (m :: * -> *). MonadIO m => m CustomMeta
newZeroCustomMeta = IO CustomMeta -> m CustomMeta
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CustomMeta -> m CustomMeta) -> IO CustomMeta -> m CustomMeta
forall a b. (a -> b) -> a -> b
$ IO (Ptr CustomMeta)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr CustomMeta)
-> (Ptr CustomMeta -> IO CustomMeta) -> IO CustomMeta
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr CustomMeta -> CustomMeta)
-> Ptr CustomMeta -> IO CustomMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr CustomMeta -> CustomMeta
CustomMeta

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


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

#if defined(ENABLE_OVERLOADING)
data CustomMetaMetaFieldInfo
instance AttrInfo CustomMetaMetaFieldInfo where
    type AttrBaseTypeConstraint CustomMetaMetaFieldInfo = (~) CustomMeta
    type AttrAllowedOps CustomMetaMetaFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint CustomMetaMetaFieldInfo = (~) (Ptr Gst.Meta.Meta)
    type AttrTransferTypeConstraint CustomMetaMetaFieldInfo = (~)(Ptr Gst.Meta.Meta)
    type AttrTransferType CustomMetaMetaFieldInfo = (Ptr Gst.Meta.Meta)
    type AttrGetType CustomMetaMetaFieldInfo = Gst.Meta.Meta
    type AttrLabel CustomMetaMetaFieldInfo = "meta"
    type AttrOrigin CustomMetaMetaFieldInfo = CustomMeta
    attrGet = getCustomMetaMeta
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.CustomMeta.meta"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.30/docs/GI-Gst-Structs-CustomMeta.html#g:attr:meta"
        })

customMeta_meta :: AttrLabelProxy "meta"
customMeta_meta = AttrLabelProxy

#endif


-- | Get the value of the “@structure@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' customMeta #structure
-- @
getCustomMetaStructure :: MonadIO m => CustomMeta -> m (Maybe Gst.Structure.Structure)
getCustomMetaStructure :: forall (m :: * -> *).
MonadIO m =>
CustomMeta -> m (Maybe Structure)
getCustomMetaStructure CustomMeta
s = IO (Maybe Structure) -> m (Maybe Structure)
forall a. IO a -> m a
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
$ CustomMeta
-> (Ptr CustomMeta -> IO (Maybe Structure)) -> IO (Maybe Structure)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CustomMeta
s ((Ptr CustomMeta -> IO (Maybe Structure)) -> IO (Maybe Structure))
-> (Ptr CustomMeta -> IO (Maybe Structure)) -> IO (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ \Ptr CustomMeta
ptr -> do
    Ptr Structure
val <- Ptr (Ptr Structure) -> IO (Ptr Structure)
forall a. Storable a => Ptr a -> IO a
peek (Ptr CustomMeta
ptr Ptr CustomMeta -> Int -> Ptr (Ptr Structure)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO (Ptr Gst.Structure.Structure)
    Maybe Structure
result <- Ptr Structure
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Structure
val ((Ptr Structure -> IO Structure) -> IO (Maybe Structure))
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ \Ptr Structure
val' -> do
        Structure
val'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
val'
        Structure -> IO Structure
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
val''
    Maybe Structure -> IO (Maybe Structure)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Structure
result

-- | Set the value of the “@structure@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' customMeta [ #structure 'Data.GI.Base.Attributes.:=' value ]
-- @
setCustomMetaStructure :: MonadIO m => CustomMeta -> Ptr Gst.Structure.Structure -> m ()
setCustomMetaStructure :: forall (m :: * -> *).
MonadIO m =>
CustomMeta -> Ptr Structure -> m ()
setCustomMetaStructure CustomMeta
s Ptr Structure
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ CustomMeta -> (Ptr CustomMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CustomMeta
s ((Ptr CustomMeta -> IO ()) -> IO ())
-> (Ptr CustomMeta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CustomMeta
ptr -> do
    Ptr (Ptr Structure) -> Ptr Structure -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CustomMeta
ptr Ptr CustomMeta -> Int -> Ptr (Ptr Structure)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Ptr Structure
val :: Ptr Gst.Structure.Structure)

-- | Set the value of the “@structure@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #structure
-- @
clearCustomMetaStructure :: MonadIO m => CustomMeta -> m ()
clearCustomMetaStructure :: forall (m :: * -> *). MonadIO m => CustomMeta -> m ()
clearCustomMetaStructure CustomMeta
s = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ CustomMeta -> (Ptr CustomMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CustomMeta
s ((Ptr CustomMeta -> IO ()) -> IO ())
-> (Ptr CustomMeta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CustomMeta
ptr -> do
    Ptr (Ptr Structure) -> Ptr Structure -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CustomMeta
ptr Ptr CustomMeta -> Int -> Ptr (Ptr Structure)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Ptr Structure
forall a. Ptr a
FP.nullPtr :: Ptr Gst.Structure.Structure)

#if defined(ENABLE_OVERLOADING)
data CustomMetaStructureFieldInfo
instance AttrInfo CustomMetaStructureFieldInfo where
    type AttrBaseTypeConstraint CustomMetaStructureFieldInfo = (~) CustomMeta
    type AttrAllowedOps CustomMetaStructureFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CustomMetaStructureFieldInfo = (~) (Ptr Gst.Structure.Structure)
    type AttrTransferTypeConstraint CustomMetaStructureFieldInfo = (~)(Ptr Gst.Structure.Structure)
    type AttrTransferType CustomMetaStructureFieldInfo = (Ptr Gst.Structure.Structure)
    type AttrGetType CustomMetaStructureFieldInfo = Maybe Gst.Structure.Structure
    type AttrLabel CustomMetaStructureFieldInfo = "structure"
    type AttrOrigin CustomMetaStructureFieldInfo = CustomMeta
    attrGet = getCustomMetaStructure
    attrSet = setCustomMetaStructure
    attrConstruct = undefined
    attrClear = clearCustomMetaStructure
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.CustomMeta.structure"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.30/docs/GI-Gst-Structs-CustomMeta.html#g:attr:structure"
        })

customMeta_structure :: AttrLabelProxy "structure"
customMeta_structure = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList CustomMeta
type instance O.AttributeList CustomMeta = CustomMetaAttributeList
type CustomMetaAttributeList = ('[ '("meta", CustomMetaMetaFieldInfo), '("structure", CustomMetaStructureFieldInfo)] :: [(Symbol, DK.Type)])
#endif

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

foreign import ccall "gst_custom_meta_get_structure" gst_custom_meta_get_structure :: 
    Ptr CustomMeta ->                       -- meta : TInterface (Name {namespace = "Gst", name = "CustomMeta"})
    IO (Ptr Gst.Structure.Structure)

-- | Retrieve the t'GI.Gst.Structs.Structure.Structure' backing a custom meta, the structure\'s mutability
-- is conditioned to the writability of the t'GI.Gst.Structs.Buffer.Buffer' /@meta@/ is attached to.
-- 
-- /Since: 1.20/
customMetaGetStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CustomMeta
    -> m Gst.Structure.Structure
    -- ^ __Returns:__ the t'GI.Gst.Structs.Structure.Structure' backing /@meta@/
customMetaGetStructure :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
CustomMeta -> m Structure
customMetaGetStructure CustomMeta
meta = IO Structure -> m Structure
forall a. IO a -> m a
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 CustomMeta
meta' <- CustomMeta -> IO (Ptr CustomMeta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CustomMeta
meta
    Ptr Structure
result <- Ptr CustomMeta -> IO (Ptr Structure)
gst_custom_meta_get_structure Ptr CustomMeta
meta'
    Text -> Ptr Structure -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"customMetaGetStructure" Ptr Structure
result
    Structure
result' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
result
    CustomMeta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CustomMeta
meta
    Structure -> IO Structure
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result'

#if defined(ENABLE_OVERLOADING)
data CustomMetaGetStructureMethodInfo
instance (signature ~ (m Gst.Structure.Structure), MonadIO m) => O.OverloadedMethod CustomMetaGetStructureMethodInfo CustomMeta signature where
    overloadedMethod = customMetaGetStructure

instance O.OverloadedMethodInfo CustomMetaGetStructureMethodInfo CustomMeta where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.CustomMeta.customMetaGetStructure",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.30/docs/GI-Gst-Structs-CustomMeta.html#v:customMetaGetStructure"
        })


#endif

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

foreign import ccall "gst_custom_meta_has_name" gst_custom_meta_has_name :: 
    Ptr CustomMeta ->                       -- meta : TInterface (Name {namespace = "Gst", name = "CustomMeta"})
    CString ->                              -- name : TBasicType TUTF8
    IO CInt

-- | Checks whether the name of the custom meta is /@name@/
-- 
-- /Since: 1.20/
customMetaHasName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CustomMeta
    -> T.Text
    -> m Bool
    -- ^ __Returns:__ Whether /@name@/ is the name of the custom meta
customMetaHasName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
CustomMeta -> Text -> m Bool
customMetaHasName CustomMeta
meta Text
name = IO Bool -> m Bool
forall a. IO a -> m a
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 CustomMeta
meta' <- CustomMeta -> IO (Ptr CustomMeta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CustomMeta
meta
    CString
name' <- Text -> IO CString
textToCString Text
name
    CInt
result <- Ptr CustomMeta -> CString -> IO CInt
gst_custom_meta_has_name Ptr CustomMeta
meta' CString
name'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CustomMeta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CustomMeta
meta
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CustomMetaHasNameMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.OverloadedMethod CustomMetaHasNameMethodInfo CustomMeta signature where
    overloadedMethod = customMetaHasName

instance O.OverloadedMethodInfo CustomMetaHasNameMethodInfo CustomMeta where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.CustomMeta.customMetaHasName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.30/docs/GI-Gst-Structs-CustomMeta.html#v:customMetaHasName"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveCustomMetaMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveCustomMetaMethod "hasName" o = CustomMetaHasNameMethodInfo
    ResolveCustomMetaMethod "getStructure" o = CustomMetaGetStructureMethodInfo
    ResolveCustomMetaMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveCustomMetaMethod t CustomMeta, O.OverloadedMethod info CustomMeta p, R.HasField t CustomMeta p) => R.HasField t CustomMeta p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveCustomMetaMethod t CustomMeta, O.OverloadedMethodInfo info CustomMeta) => OL.IsLabel t (O.MethodProxy info CustomMeta) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif