{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Gst.Structs.Meta.Meta' structure should be included as the first member of a t'GI.Gst.Structs.Buffer.Buffer'
-- metadata structure. The structure defines the API of the metadata and should
-- be accessible to all elements using the metadata.
-- 
-- A metadata API is registered with 'GI.Gst.Functions.metaApiTypeRegister' which takes a
-- name for the metadata API and some tags associated with the metadata.
-- With 'GI.Gst.Functions.metaApiTypeHasTag' one can check if a certain metadata API
-- contains a given tag.
-- 
-- Multiple implementations of a metadata API can be registered.
-- To implement a metadata API, @/gst_meta_register()/@ should be used. This
-- function takes all parameters needed to create, free and transform metadata
-- along with the size of the metadata. The function returns a t'GI.Gst.Structs.MetaInfo.MetaInfo'
-- structure that contains the information for the implementation of the API.
-- 
-- A specific implementation can be retrieved by name with 'GI.Gst.Functions.metaGetInfo'.
-- 
-- See t'GI.Gst.Structs.Buffer.Buffer' for how the metadata can be added, retrieved and removed from
-- buffers.

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

module GI.Gst.Structs.Meta
    ( 

-- * Exported types
    Meta(..)                                ,
    newZeroMeta                             ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveMetaMethod                       ,
#endif

-- ** apiTypeGetTags #method:apiTypeGetTags#

    metaApiTypeGetTags                      ,


-- ** apiTypeHasTag #method:apiTypeHasTag#

    metaApiTypeHasTag                       ,


-- ** apiTypeRegister #method:apiTypeRegister#

    metaApiTypeRegister                     ,


-- ** compareSeqnum #method:compareSeqnum#

#if defined(ENABLE_OVERLOADING)
    MetaCompareSeqnumMethodInfo             ,
#endif
    metaCompareSeqnum                       ,


-- ** deserialize #method:deserialize#

    metaDeserialize                         ,


-- ** getInfo #method:getInfo#

    metaGetInfo                             ,


-- ** getSeqnum #method:getSeqnum#

#if defined(ENABLE_OVERLOADING)
    MetaGetSeqnumMethodInfo                 ,
#endif
    metaGetSeqnum                           ,


-- ** registerCustom #method:registerCustom#

    metaRegisterCustom                      ,


-- ** registerCustomSimple #method:registerCustomSimple#

    metaRegisterCustomSimple                ,


-- ** serialize #method:serialize#

#if defined(ENABLE_OVERLOADING)
    MetaSerializeMethodInfo                 ,
#endif
    metaSerialize                           ,


-- ** serializeSimple #method:serializeSimple#

#if defined(ENABLE_OVERLOADING)
    MetaSerializeSimpleMethodInfo           ,
#endif
    metaSerializeSimple                     ,




 -- * Properties


-- ** flags #attr:flags#
-- | extra flags for the metadata

    getMetaFlags                            ,
#if defined(ENABLE_OVERLOADING)
    meta_flags                              ,
#endif
    setMetaFlags                            ,


-- ** info #attr:info#
-- | pointer to the t'GI.Gst.Structs.MetaInfo.MetaInfo'

    clearMetaInfo                           ,
    getMetaInfo                             ,
#if defined(ENABLE_OVERLOADING)
    meta_info                               ,
#endif
    setMetaInfo                             ,




    ) 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.CustomMeta as Gst.CustomMeta
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.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 qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.Gst.Callbacks as Gst.Callbacks
import {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags
import {-# SOURCE #-} qualified GI.Gst.Structs.Buffer as Gst.Buffer
import {-# SOURCE #-} qualified GI.Gst.Structs.ByteArrayInterface as Gst.ByteArrayInterface
import {-# SOURCE #-} qualified GI.Gst.Structs.MetaInfo as Gst.MetaInfo

#endif

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

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

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


-- | Construct a `Meta` struct initialized to zero.
newZeroMeta :: MonadIO m => m Meta
newZeroMeta :: forall (m :: * -> *). MonadIO m => m Meta
newZeroMeta = 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
$ IO (Ptr Meta)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr Meta) -> (Ptr Meta -> IO Meta) -> IO Meta
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Meta -> Meta) -> Ptr Meta -> IO Meta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Meta -> Meta
Meta

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


-- | Get the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' meta #flags
-- @
getMetaFlags :: MonadIO m => Meta -> m [Gst.Flags.MetaFlags]
getMetaFlags :: forall (m :: * -> *). MonadIO m => Meta -> m [MetaFlags]
getMetaFlags Meta
s = IO [MetaFlags] -> m [MetaFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [MetaFlags] -> m [MetaFlags])
-> IO [MetaFlags] -> m [MetaFlags]
forall a b. (a -> b) -> a -> b
$ Meta -> (Ptr Meta -> IO [MetaFlags]) -> IO [MetaFlags]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Meta
s ((Ptr Meta -> IO [MetaFlags]) -> IO [MetaFlags])
-> (Ptr Meta -> IO [MetaFlags]) -> IO [MetaFlags]
forall a b. (a -> b) -> a -> b
$ \Ptr Meta
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr Meta
ptr Ptr Meta -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CUInt
    let val' :: [MetaFlags]
val' = CUInt -> [MetaFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
val
    [MetaFlags] -> IO [MetaFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [MetaFlags]
val'

-- | Set the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' meta [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setMetaFlags :: MonadIO m => Meta -> [Gst.Flags.MetaFlags] -> m ()
setMetaFlags :: forall (m :: * -> *). MonadIO m => Meta -> [MetaFlags] -> m ()
setMetaFlags Meta
s [MetaFlags]
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
$ Meta -> (Ptr Meta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Meta
s ((Ptr Meta -> IO ()) -> IO ()) -> (Ptr Meta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Meta
ptr -> do
    let val' :: CUInt
val' = [MetaFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MetaFlags]
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Meta
ptr Ptr Meta -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data MetaFlagsFieldInfo
instance AttrInfo MetaFlagsFieldInfo where
    type AttrBaseTypeConstraint MetaFlagsFieldInfo = (~) Meta
    type AttrAllowedOps MetaFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MetaFlagsFieldInfo = (~) [Gst.Flags.MetaFlags]
    type AttrTransferTypeConstraint MetaFlagsFieldInfo = (~)[Gst.Flags.MetaFlags]
    type AttrTransferType MetaFlagsFieldInfo = [Gst.Flags.MetaFlags]
    type AttrGetType MetaFlagsFieldInfo = [Gst.Flags.MetaFlags]
    type AttrLabel MetaFlagsFieldInfo = "flags"
    type AttrOrigin MetaFlagsFieldInfo = Meta
    attrGet = getMetaFlags
    attrSet = setMetaFlags
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Meta.flags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.30/docs/GI-Gst-Structs-Meta.html#g:attr:flags"
        })

meta_flags :: AttrLabelProxy "flags"
meta_flags = AttrLabelProxy

#endif


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

-- | Set the value of the “@info@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' meta [ #info 'Data.GI.Base.Attributes.:=' value ]
-- @
setMetaInfo :: MonadIO m => Meta -> Ptr Gst.MetaInfo.MetaInfo -> m ()
setMetaInfo :: forall (m :: * -> *). MonadIO m => Meta -> Ptr MetaInfo -> m ()
setMetaInfo Meta
s Ptr MetaInfo
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
$ Meta -> (Ptr Meta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Meta
s ((Ptr Meta -> IO ()) -> IO ()) -> (Ptr Meta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Meta
ptr -> do
    Ptr (Ptr MetaInfo) -> Ptr MetaInfo -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Meta
ptr Ptr Meta -> Int -> Ptr (Ptr MetaInfo)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Ptr MetaInfo
val :: Ptr Gst.MetaInfo.MetaInfo)

-- | Set the value of the “@info@” 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' #info
-- @
clearMetaInfo :: MonadIO m => Meta -> m ()
clearMetaInfo :: forall (m :: * -> *). MonadIO m => Meta -> m ()
clearMetaInfo Meta
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
$ Meta -> (Ptr Meta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Meta
s ((Ptr Meta -> IO ()) -> IO ()) -> (Ptr Meta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Meta
ptr -> do
    Ptr (Ptr MetaInfo) -> Ptr MetaInfo -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Meta
ptr Ptr Meta -> Int -> Ptr (Ptr MetaInfo)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Ptr MetaInfo
forall a. Ptr a
FP.nullPtr :: Ptr Gst.MetaInfo.MetaInfo)

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

meta_info :: AttrLabelProxy "info"
meta_info = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Meta
type instance O.AttributeList Meta = MetaAttributeList
type MetaAttributeList = ('[ '("flags", MetaFlagsFieldInfo), '("info", MetaInfoFieldInfo)] :: [(Symbol, DK.Type)])
#endif

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

foreign import ccall "gst_meta_compare_seqnum" gst_meta_compare_seqnum :: 
    Ptr Meta ->                             -- meta1 : TInterface (Name {namespace = "Gst", name = "Meta"})
    Ptr Meta ->                             -- meta2 : TInterface (Name {namespace = "Gst", name = "Meta"})
    IO Int32

-- | Meta sequence number compare function. Can be used as t'GI.GLib.Callbacks.CompareFunc'
-- or a t'GI.GLib.Callbacks.CompareDataFunc'.
-- 
-- /Since: 1.16/
metaCompareSeqnum ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Meta
    -- ^ /@meta1@/: a t'GI.Gst.Structs.Meta.Meta'
    -> Meta
    -- ^ /@meta2@/: a t'GI.Gst.Structs.Meta.Meta'
    -> m Int32
    -- ^ __Returns:__ a negative number if /@meta1@/ comes before /@meta2@/, 0 if both metas
    --   have an equal sequence number, or a positive integer if /@meta1@/ comes
    --   after /@meta2@/.
metaCompareSeqnum :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Meta -> Meta -> m Int32
metaCompareSeqnum Meta
meta1 Meta
meta2 = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Meta
meta1' <- Meta -> IO (Ptr Meta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Meta
meta1
    Ptr Meta
meta2' <- Meta -> IO (Ptr Meta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Meta
meta2
    Int32
result <- Ptr Meta -> Ptr Meta -> IO Int32
gst_meta_compare_seqnum Ptr Meta
meta1' Ptr Meta
meta2'
    Meta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Meta
meta1
    Meta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Meta
meta2
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data MetaCompareSeqnumMethodInfo
instance (signature ~ (Meta -> m Int32), MonadIO m) => O.OverloadedMethod MetaCompareSeqnumMethodInfo Meta signature where
    overloadedMethod = metaCompareSeqnum

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


#endif

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

foreign import ccall "gst_meta_get_seqnum" gst_meta_get_seqnum :: 
    Ptr Meta ->                             -- meta : TInterface (Name {namespace = "Gst", name = "Meta"})
    IO Word64

-- | Gets seqnum for this meta.
-- 
-- /Since: 1.16/
metaGetSeqnum ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Meta
    -- ^ /@meta@/: a t'GI.Gst.Structs.Meta.Meta'
    -> m Word64
metaGetSeqnum :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Meta -> m Word64
metaGetSeqnum Meta
meta = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Meta
meta' <- Meta -> IO (Ptr Meta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Meta
meta
    Word64
result <- Ptr Meta -> IO Word64
gst_meta_get_seqnum Ptr Meta
meta'
    Meta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Meta
meta
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data MetaGetSeqnumMethodInfo
instance (signature ~ (m Word64), MonadIO m) => O.OverloadedMethod MetaGetSeqnumMethodInfo Meta signature where
    overloadedMethod = metaGetSeqnum

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


#endif

-- method Meta::serialize
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "meta"
--           , argType = TInterface Name { namespace = "Gst" , name = "Meta" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMeta" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "ByteArrayInterface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#GstByteArrayInterface to append serialization data"
--                 , 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_meta_serialize" gst_meta_serialize :: 
    Ptr Meta ->                             -- meta : TInterface (Name {namespace = "Gst", name = "Meta"})
    Ptr Gst.ByteArrayInterface.ByteArrayInterface -> -- data : TInterface (Name {namespace = "Gst", name = "ByteArrayInterface"})
    IO CInt

-- | Serialize /@meta@/ into a format that can be stored or transmitted and later
-- deserialized by 'GI.Gst.Functions.metaDeserialize'.
-- 
-- This is only supported for meta that implements t'GI.Gst.Structs.MetaInfo.MetaInfo'.@/serialize_func/@,
-- 'P.False' is returned otherwise.
-- 
-- Upon failure, /@data@/->data pointer could have been reallocated, but /@data@/->len
-- won\'t be modified. This is intended to be able to append multiple metas
-- into the same t'GI.GLib.Structs.ByteArray.ByteArray'.
-- 
-- Since serialization size is often the same for every buffer, caller may want
-- to remember the size of previous data to preallocate the next.
-- 
-- /Since: 1.24/
metaSerialize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Meta
    -- ^ /@meta@/: a t'GI.Gst.Structs.Meta.Meta'
    -> Gst.ByteArrayInterface.ByteArrayInterface
    -- ^ /@data@/: t'GI.Gst.Structs.ByteArrayInterface.ByteArrayInterface' to append serialization data
    -> m Bool
    -- ^ __Returns:__ 'P.True' on success, 'P.False' otherwise.
metaSerialize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Meta -> ByteArrayInterface -> m Bool
metaSerialize Meta
meta ByteArrayInterface
data_ = 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 Meta
meta' <- Meta -> IO (Ptr Meta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Meta
meta
    Ptr ByteArrayInterface
data_' <- ByteArrayInterface -> IO (Ptr ByteArrayInterface)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ByteArrayInterface
data_
    CInt
result <- Ptr Meta -> Ptr ByteArrayInterface -> IO CInt
gst_meta_serialize Ptr Meta
meta' Ptr ByteArrayInterface
data_'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Meta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Meta
meta
    ByteArrayInterface -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ByteArrayInterface
data_
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaSerializeMethodInfo
instance (signature ~ (Gst.ByteArrayInterface.ByteArrayInterface -> m Bool), MonadIO m) => O.OverloadedMethod MetaSerializeMethodInfo Meta signature where
    overloadedMethod = metaSerialize

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


#endif

-- method Meta::serialize_simple
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "meta"
--           , argType = TInterface Name { namespace = "Gst" , name = "Meta" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMeta" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GByteArray to append serialization data"
--                 , 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_meta_serialize_simple" gst_meta_serialize_simple :: 
    Ptr Meta ->                             -- meta : TInterface (Name {namespace = "Gst", name = "Meta"})
    Ptr GByteArray ->                       -- data : TByteArray
    IO CInt

-- | Same as 'GI.Gst.Structs.Meta.metaSerialize' but with a t'GI.GLib.Structs.ByteArray.ByteArray' instead of
-- t'GI.Gst.Structs.ByteArrayInterface.ByteArrayInterface'.
-- 
-- /Since: 1.24/
metaSerializeSimple ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Meta
    -- ^ /@meta@/: a t'GI.Gst.Structs.Meta.Meta'
    -> ByteString
    -- ^ /@data@/: t'GI.GLib.Structs.ByteArray.ByteArray' to append serialization data
    -> m Bool
    -- ^ __Returns:__ 'P.True' on success, 'P.False' otherwise.
metaSerializeSimple :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Meta -> ByteString -> m Bool
metaSerializeSimple Meta
meta ByteString
data_ = 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 Meta
meta' <- Meta -> IO (Ptr Meta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Meta
meta
    Ptr GByteArray
data_' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
data_
    CInt
result <- Ptr Meta -> Ptr GByteArray -> IO CInt
gst_meta_serialize_simple Ptr Meta
meta' Ptr GByteArray
data_'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Meta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Meta
meta
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
data_'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaSerializeSimpleMethodInfo
instance (signature ~ (ByteString -> m Bool), MonadIO m) => O.OverloadedMethod MetaSerializeSimpleMethodInfo Meta signature where
    overloadedMethod = metaSerializeSimple

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


#endif

-- method Meta::api_type_get_tags
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "api"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an API" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "gst_meta_api_type_get_tags" gst_meta_api_type_get_tags :: 
    CGType ->                               -- api : TBasicType TGType
    IO (Ptr CString)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
metaApiTypeGetTags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@api@/: an API
    -> m [T.Text]
    -- ^ __Returns:__ an array of tags as strings.
metaApiTypeGetTags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GType -> m [Text]
metaApiTypeGetTags GType
api = IO [Text] -> m [Text]
forall a. IO a -> m a
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
    let api' :: Word64
api' = GType -> Word64
gtypeToCGType GType
api
    Ptr CString
result <- Word64 -> IO (Ptr CString)
gst_meta_api_type_get_tags Word64
api'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"metaApiTypeGetTags" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Meta::api_type_has_tag
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "api"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an API" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the tag to check" , 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_meta_api_type_has_tag" gst_meta_api_type_has_tag :: 
    CGType ->                               -- api : TBasicType TGType
    Word32 ->                               -- tag : TBasicType TUInt32
    IO CInt

-- | Check if /@api@/ was registered with /@tag@/.
metaApiTypeHasTag ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@api@/: an API
    -> Word32
    -- ^ /@tag@/: the tag to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@api@/ was registered with /@tag@/.
metaApiTypeHasTag :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GType -> Word32 -> m Bool
metaApiTypeHasTag GType
api Word32
tag = 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
    let api' :: Word64
api' = GType -> Word64
gtypeToCGType GType
api
    CInt
result <- Word64 -> Word32 -> IO CInt
gst_meta_api_type_has_tag Word64
api' Word32
tag
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Meta::api_type_register
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "api"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an API to register" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tags"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tags for @api" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "gst_meta_api_type_register" gst_meta_api_type_register :: 
    CString ->                              -- api : TBasicType TUTF8
    Ptr CString ->                          -- tags : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO CGType

-- | Register and return a GType for the /@api@/ and associate it with
-- /@tags@/.
metaApiTypeRegister ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@api@/: an API to register
    -> [T.Text]
    -- ^ /@tags@/: tags for /@api@/
    -> m GType
    -- ^ __Returns:__ a unique GType for /@api@/.
metaApiTypeRegister :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> [Text] -> m GType
metaApiTypeRegister Text
api [Text]
tags = IO GType -> m GType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    CString
api' <- Text -> IO CString
textToCString Text
api
    Ptr CString
tags' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
tags
    Word64
result <- CString -> Ptr CString -> IO Word64
gst_meta_api_type_register CString
api' Ptr CString
tags'
    let result' :: GType
result' = Word64 -> GType
GType Word64
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
api'
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
tags'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
tags'
    GType -> IO GType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Meta::deserialize
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "serialization data obtained from gst_meta_serialize()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "size of @data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "consumed"
--           , argType = TBasicType TUInt32
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "total size used by this meta, could be less than @size"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Meta" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_meta_deserialize" gst_meta_deserialize :: 
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Word8 ->                                -- data : TBasicType TUInt8
    FCT.CSize ->                            -- size : TBasicType TSize
    Ptr Word32 ->                           -- consumed : TBasicType TUInt32
    IO (Ptr Meta)

-- | Recreate a t'GI.Gst.Structs.Meta.Meta' from serialized data returned by
-- 'GI.Gst.Structs.Meta.metaSerialize' and add it to /@buffer@/.
-- 
-- Note that the meta must have been previously registered by calling one of
-- @gst_*_meta_get_info ()@ functions.
-- 
-- /@consumed@/ is set to the number of bytes that can be skipped from /@data@/ to
-- find the next meta serialization, if any. In case of parsing error that does
-- not allow to determine that size, /@consumed@/ is set to 0.
-- 
-- /Since: 1.24/
metaDeserialize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Buffer.Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> Word8
    -- ^ /@data@/: serialization data obtained from 'GI.Gst.Structs.Meta.metaSerialize'
    -> FCT.CSize
    -- ^ /@size@/: size of /@data@/
    -> m ((Maybe Meta, Word32))
    -- ^ __Returns:__ the metadata owned by /@buffer@/, or 'P.Nothing'.
metaDeserialize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Word8 -> CSize -> m (Maybe Meta, Word32)
metaDeserialize Buffer
buffer Word8
data_ CSize
size = IO (Maybe Meta, Word32) -> m (Maybe Meta, Word32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Meta, Word32) -> m (Maybe Meta, Word32))
-> IO (Maybe Meta, Word32) -> m (Maybe Meta, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Word32
consumed <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Meta
result <- Ptr Buffer -> Word8 -> CSize -> Ptr Word32 -> IO (Ptr Meta)
gst_meta_deserialize Ptr Buffer
buffer' Word8
data_ CSize
size Ptr Word32
consumed
    Maybe Meta
maybeResult <- Ptr Meta -> (Ptr Meta -> IO Meta) -> IO (Maybe Meta)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Meta
result ((Ptr Meta -> IO Meta) -> IO (Maybe Meta))
-> (Ptr Meta -> IO Meta) -> IO (Maybe Meta)
forall a b. (a -> b) -> a -> b
$ \Ptr Meta
result' -> do
        Meta
result'' <- ((ManagedPtr Meta -> Meta) -> Ptr Meta -> IO Meta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Meta -> Meta
Meta) Ptr Meta
result'
        Meta -> IO Meta
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Meta
result''
    Word32
consumed' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
consumed
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
consumed
    (Maybe Meta, Word32) -> IO (Maybe Meta, Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Meta
maybeResult, Word32
consumed')

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gst_meta_get_info" gst_meta_get_info :: 
    CString ->                              -- impl : TBasicType TUTF8
    IO (Ptr Gst.MetaInfo.MetaInfo)

-- | Lookup a previously registered meta info structure by its implementation name
-- /@impl@/.
metaGetInfo ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@impl@/: the name
    -> m (Maybe Gst.MetaInfo.MetaInfo)
    -- ^ __Returns:__ a t'GI.Gst.Structs.MetaInfo.MetaInfo' with /@impl@/, or
    -- 'P.Nothing' when no such metainfo exists.
metaGetInfo :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe MetaInfo)
metaGetInfo Text
impl = IO (Maybe MetaInfo) -> m (Maybe MetaInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe MetaInfo) -> m (Maybe MetaInfo))
-> IO (Maybe MetaInfo) -> m (Maybe MetaInfo)
forall a b. (a -> b) -> a -> b
$ do
    CString
impl' <- Text -> IO CString
textToCString Text
impl
    Ptr MetaInfo
result <- CString -> IO (Ptr MetaInfo)
gst_meta_get_info CString
impl'
    Maybe MetaInfo
maybeResult <- Ptr MetaInfo
-> (Ptr MetaInfo -> IO MetaInfo) -> IO (Maybe MetaInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr MetaInfo
result ((Ptr MetaInfo -> IO MetaInfo) -> IO (Maybe MetaInfo))
-> (Ptr MetaInfo -> IO MetaInfo) -> IO (Maybe MetaInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr MetaInfo
result' -> do
        MetaInfo
result'' <- ((ManagedPtr MetaInfo -> MetaInfo) -> Ptr MetaInfo -> IO MetaInfo
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr MetaInfo -> MetaInfo
Gst.MetaInfo.MetaInfo) Ptr MetaInfo
result'
        MetaInfo -> IO MetaInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MetaInfo
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
impl'
    Maybe MetaInfo -> IO (Maybe MetaInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MetaInfo
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Meta::register_custom
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the #GstMeta implementation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tags"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tags for @api" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "transform_func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "CustomMetaTransformFunction" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMetaTransformFunction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 3
--           , argDestroy = 4
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to @transform_func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy_data"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GDestroyNotify for user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "MetaInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_meta_register_custom" gst_meta_register_custom :: 
    CString ->                              -- name : TBasicType TUTF8
    Ptr CString ->                          -- tags : TCArray True (-1) (-1) (TBasicType TUTF8)
    FunPtr Gst.Callbacks.C_CustomMetaTransformFunction -> -- transform_func : TInterface (Name {namespace = "Gst", name = "CustomMetaTransformFunction"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy_data : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO (Ptr Gst.MetaInfo.MetaInfo)

-- | Register a new custom t'GI.Gst.Structs.Meta.Meta' implementation, backed by an opaque
-- structure holding a t'GI.Gst.Structs.Structure.Structure'.
-- 
-- The registered info can be retrieved later with 'GI.Gst.Functions.metaGetInfo' by using
-- /@name@/ as the key.
-- 
-- The backing t'GI.Gst.Structs.Structure.Structure' can be retrieved with
-- 'GI.Gst.Structs.CustomMeta.customMetaGetStructure', its mutability is conditioned by the
-- writability of the buffer the meta is attached to.
-- 
-- When /@transformFunc@/ is 'P.Nothing', the meta and its backing t'GI.Gst.Structs.Structure.Structure'
-- will always be copied when the transform operation is copy, other operations
-- are discarded, copy regions are ignored.
-- 
-- /Since: 1.20/
metaRegisterCustom ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: the name of the t'GI.Gst.Structs.Meta.Meta' implementation
    -> [T.Text]
    -- ^ /@tags@/: tags for /@api@/
    -> Maybe (Gst.Callbacks.CustomMetaTransformFunction)
    -- ^ /@transformFunc@/: a t'GI.Gst.Callbacks.MetaTransformFunction'
    -> m Gst.MetaInfo.MetaInfo
    -- ^ __Returns:__ a t'GI.Gst.Structs.MetaInfo.MetaInfo' that can be used to
    -- access metadata.
metaRegisterCustom :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> [Text] -> Maybe CustomMetaTransformFunction -> m MetaInfo
metaRegisterCustom Text
name [Text]
tags Maybe CustomMetaTransformFunction
transformFunc = IO MetaInfo -> m MetaInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MetaInfo -> m MetaInfo) -> IO MetaInfo -> m MetaInfo
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr CString
tags' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
tags
    FunPtr C_CustomMetaTransformFunction
maybeTransformFunc <- case Maybe CustomMetaTransformFunction
transformFunc of
        Maybe CustomMetaTransformFunction
Nothing -> FunPtr C_CustomMetaTransformFunction
-> IO (FunPtr C_CustomMetaTransformFunction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_CustomMetaTransformFunction
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just CustomMetaTransformFunction
jTransformFunc -> do
            FunPtr C_CustomMetaTransformFunction
jTransformFunc' <- C_CustomMetaTransformFunction
-> IO (FunPtr C_CustomMetaTransformFunction)
Gst.Callbacks.mk_CustomMetaTransformFunction (Maybe (Ptr (FunPtr C_CustomMetaTransformFunction))
-> CustomMetaTransformFunction_WithClosures
-> C_CustomMetaTransformFunction
Gst.Callbacks.wrap_CustomMetaTransformFunction Maybe (Ptr (FunPtr C_CustomMetaTransformFunction))
forall a. Maybe a
Nothing (CustomMetaTransformFunction
-> CustomMetaTransformFunction_WithClosures
Gst.Callbacks.drop_closures_CustomMetaTransformFunction CustomMetaTransformFunction
jTransformFunc))
            FunPtr C_CustomMetaTransformFunction
-> IO (FunPtr C_CustomMetaTransformFunction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_CustomMetaTransformFunction
jTransformFunc'
    let userData :: Ptr ()
userData = FunPtr C_CustomMetaTransformFunction -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_CustomMetaTransformFunction
maybeTransformFunc
    let destroyData :: FunPtr (Ptr a -> IO ())
destroyData = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr MetaInfo
result <- CString
-> Ptr CString
-> FunPtr C_CustomMetaTransformFunction
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO (Ptr MetaInfo)
gst_meta_register_custom CString
name' Ptr CString
tags' FunPtr C_CustomMetaTransformFunction
maybeTransformFunc Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroyData
    Text -> Ptr MetaInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"metaRegisterCustom" Ptr MetaInfo
result
    MetaInfo
result' <- ((ManagedPtr MetaInfo -> MetaInfo) -> Ptr MetaInfo -> IO MetaInfo
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr MetaInfo -> MetaInfo
Gst.MetaInfo.MetaInfo) Ptr MetaInfo
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
tags'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
tags'
    MetaInfo -> IO MetaInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MetaInfo
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Meta::register_custom_simple
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the #GstMeta implementation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "MetaInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_meta_register_custom_simple" gst_meta_register_custom_simple :: 
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Gst.MetaInfo.MetaInfo)

-- | Simplified version of 'GI.Gst.Functions.metaRegisterCustom', with no tags and no
-- transform function.
-- 
-- /Since: 1.24/
metaRegisterCustomSimple ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: the name of the t'GI.Gst.Structs.Meta.Meta' implementation
    -> m Gst.MetaInfo.MetaInfo
    -- ^ __Returns:__ a t'GI.Gst.Structs.MetaInfo.MetaInfo' that can be used to access metadata.
metaRegisterCustomSimple :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m MetaInfo
metaRegisterCustomSimple Text
name = IO MetaInfo -> m MetaInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MetaInfo -> m MetaInfo) -> IO MetaInfo -> m MetaInfo
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr MetaInfo
result <- CString -> IO (Ptr MetaInfo)
gst_meta_register_custom_simple CString
name'
    Text -> Ptr MetaInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"metaRegisterCustomSimple" Ptr MetaInfo
result
    MetaInfo
result' <- ((ManagedPtr MetaInfo -> MetaInfo) -> Ptr MetaInfo -> IO MetaInfo
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr MetaInfo -> MetaInfo
Gst.MetaInfo.MetaInfo) Ptr MetaInfo
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    MetaInfo -> IO MetaInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MetaInfo
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMetaMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveMetaMethod "compareSeqnum" o = MetaCompareSeqnumMethodInfo
    ResolveMetaMethod "serialize" o = MetaSerializeMethodInfo
    ResolveMetaMethod "serializeSimple" o = MetaSerializeSimpleMethodInfo
    ResolveMetaMethod "getSeqnum" o = MetaGetSeqnumMethodInfo
    ResolveMetaMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveMetaMethod t Meta, O.OverloadedMethod info Meta p) => OL.IsLabel t (Meta -> 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 ~ ResolveMetaMethod t Meta, O.OverloadedMethod info Meta p, R.HasField t Meta p) => R.HasField t Meta p where
    getField = O.overloadedMethod @info

#endif

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

#endif