{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- 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, 'GI.Gst.Functions.metaRegister' 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                             ,
    noMeta                                  ,


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

#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                       ,


-- ** getInfo #method:getInfo#

    metaGetInfo                             ,


-- ** getSeqnum #method:getSeqnum#

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


-- ** register #method:register#

    metaRegister                            ,




 -- * 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.Gst.Callbacks as Gst.Callbacks
import {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags
import {-# SOURCE #-} qualified GI.Gst.Structs.MetaInfo as Gst.MetaInfo

-- | Memory-managed wrapper type.
newtype Meta = Meta (ManagedPtr Meta)
    deriving (Meta -> Meta -> Bool
(Meta -> Meta -> Bool) -> (Meta -> Meta -> Bool) -> Eq Meta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Meta -> Meta -> Bool
$c/= :: Meta -> Meta -> Bool
== :: Meta -> Meta -> Bool
$c== :: Meta -> Meta -> Bool
Eq)
instance WrappedPtr Meta where
    wrappedPtrCalloc :: IO (Ptr Meta)
wrappedPtrCalloc = Int -> IO (Ptr Meta)
forall a. Int -> IO (Ptr a)
callocBytes 16
    wrappedPtrCopy :: Meta -> IO Meta
wrappedPtrCopy = \p :: Meta
p -> Meta -> (Ptr Meta -> IO Meta) -> IO Meta
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Meta
p (Int -> Ptr Meta -> IO (Ptr Meta)
forall a. WrappedPtr a => Int -> Ptr a -> IO (Ptr a)
copyBytes 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, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Meta -> Meta
Meta)
    wrappedPtrFree :: Maybe (GDestroyNotify Meta)
wrappedPtrFree = GDestroyNotify Meta -> Maybe (GDestroyNotify Meta)
forall a. a -> Maybe a
Just GDestroyNotify Meta
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free

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

instance tag ~ 'AttrSet => Constructible Meta tag where
    new :: (ManagedPtr Meta -> Meta) -> [AttrOp Meta tag] -> m Meta
new _ attrs :: [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 (m :: * -> *) a. Monad m => a -> m a
return Meta
o


-- | A convenience alias for `Nothing` :: `Maybe` `Meta`.
noMeta :: Maybe Meta
noMeta :: Maybe Meta
noMeta = Maybe Meta
forall a. Maybe a
Nothing

-- | 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 :: Meta -> m [MetaFlags]
getMetaFlags s :: Meta
s = IO [MetaFlags] -> m [MetaFlags]
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 :: 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` 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 (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 :: Meta -> [MetaFlags] -> m ()
setMetaFlags s :: Meta
s val :: [MetaFlags]
val = IO () -> m ()
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 :: 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` 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

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 :: Meta -> m (Maybe MetaInfo)
getMetaInfo s :: Meta
s = IO (Maybe MetaInfo) -> m (Maybe MetaInfo)
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 :: 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` 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
$ \val' :: Ptr MetaInfo
val' -> do
        MetaInfo
val'' <- ((ManagedPtr MetaInfo -> MetaInfo) -> Ptr MetaInfo -> IO MetaInfo
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr MetaInfo -> MetaInfo
Gst.MetaInfo.MetaInfo) Ptr MetaInfo
val'
        MetaInfo -> IO MetaInfo
forall (m :: * -> *) a. Monad m => a -> m a
return MetaInfo
val''
    Maybe MetaInfo -> IO (Maybe MetaInfo)
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 :: Meta -> Ptr MetaInfo -> m ()
setMetaInfo s :: Meta
s val :: Ptr MetaInfo
val = IO () -> m ()
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 :: 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` 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 :: Meta -> m ()
clearMetaInfo s :: Meta
s = IO () -> m ()
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 :: 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` 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

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, *)])
#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
--           , 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
--           , 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 :: Meta -> Meta -> m Int32
metaCompareSeqnum meta1 :: Meta
meta1 meta2 :: Meta
meta2 = IO Int32 -> m Int32
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 (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data MetaCompareSeqnumMethodInfo
instance (signature ~ (Meta -> m Int32), MonadIO m) => O.MethodInfo MetaCompareSeqnumMethodInfo Meta signature where
    overloadedMethod = 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
--           , 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 :: Meta -> m Word64
metaGetSeqnum meta :: Meta
meta = IO Word64 -> m Word64
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 (m :: * -> *) a. Monad m => a -> m a
return Word64
result

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

#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
--           , 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 :: GType -> m [Text]
metaApiTypeGetTags api :: GType
api = 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
    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 "metaApiTypeGetTags" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    [Text] -> IO [Text]
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
--           , 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
--           , 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 :: GType -> Word32 -> m Bool
metaApiTypeHasTag api :: GType
api tag :: Word32
tag = 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
    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
/= 0) CInt
result
    Bool -> IO Bool
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
--           , 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
--           , 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 :: Text -> [Text] -> m GType
metaApiTypeRegister api :: Text
api tags :: [Text]
tags = IO GType -> m GType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ 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 (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#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
--           , 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 :: Text -> m (Maybe MetaInfo)
metaGetInfo impl :: Text
impl = IO (Maybe MetaInfo) -> m (Maybe MetaInfo)
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
$ \result' :: Ptr MetaInfo
result' -> do
        MetaInfo
result'' <- ((ManagedPtr MetaInfo -> MetaInfo) -> Ptr MetaInfo -> IO MetaInfo
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr MetaInfo -> MetaInfo
Gst.MetaInfo.MetaInfo) Ptr MetaInfo
result'
        MetaInfo -> IO MetaInfo
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe MetaInfo
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Meta::register
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "api"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the type of the #GstMeta API"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "impl"
--           , 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the size of the #GstMeta structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "init_func"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MetaInitFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMetaInitFunction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "free_func"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MetaFreeFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMetaFreeFunction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "transform_func"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "MetaTransformFunction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMetaTransformFunction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "MetaInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_meta_register" gst_meta_register :: 
    CGType ->                               -- api : TBasicType TGType
    CString ->                              -- impl : TBasicType TUTF8
    Word64 ->                               -- size : TBasicType TUInt64
    FunPtr Gst.Callbacks.C_MetaInitFunction -> -- init_func : TInterface (Name {namespace = "Gst", name = "MetaInitFunction"})
    FunPtr Gst.Callbacks.C_MetaFreeFunction -> -- free_func : TInterface (Name {namespace = "Gst", name = "MetaFreeFunction"})
    FunPtr Gst.Callbacks.C_MetaTransformFunction -> -- transform_func : TInterface (Name {namespace = "Gst", name = "MetaTransformFunction"})
    IO (Ptr Gst.MetaInfo.MetaInfo)

-- | Register a new t'GI.Gst.Structs.Meta.Meta' implementation.
-- 
-- The same /@info@/ can be retrieved later with 'GI.Gst.Functions.metaGetInfo' by using
-- /@impl@/ as the key.
metaRegister ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@api@/: the type of the t'GI.Gst.Structs.Meta.Meta' API
    -> T.Text
    -- ^ /@impl@/: the name of the t'GI.Gst.Structs.Meta.Meta' implementation
    -> Word64
    -- ^ /@size@/: the size of the t'GI.Gst.Structs.Meta.Meta' structure
    -> Gst.Callbacks.MetaInitFunction
    -- ^ /@initFunc@/: a t'GI.Gst.Callbacks.MetaInitFunction'
    -> Gst.Callbacks.MetaFreeFunction
    -- ^ /@freeFunc@/: a t'GI.Gst.Callbacks.MetaFreeFunction'
    -> Gst.Callbacks.MetaTransformFunction
    -- ^ /@transformFunc@/: a t'GI.Gst.Callbacks.MetaTransformFunction'
    -> m (Maybe Gst.MetaInfo.MetaInfo)
    -- ^ __Returns:__ a t'GI.Gst.Structs.MetaInfo.MetaInfo' that can be used to
    -- access metadata.
metaRegister :: GType
-> Text
-> Word64
-> MetaInitFunction
-> MetaFreeFunction
-> MetaTransformFunction
-> m (Maybe MetaInfo)
metaRegister api :: GType
api impl :: Text
impl size :: Word64
size initFunc :: MetaInitFunction
initFunc freeFunc :: MetaFreeFunction
freeFunc transformFunc :: MetaTransformFunction
transformFunc = IO (Maybe MetaInfo) -> m (Maybe MetaInfo)
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
    let api' :: Word64
api' = GType -> Word64
gtypeToCGType GType
api
    CString
impl' <- Text -> IO CString
textToCString Text
impl
    Ptr (FunPtr C_MetaInitFunction)
ptrinitFunc <- IO (Ptr (FunPtr C_MetaInitFunction))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gst.Callbacks.C_MetaInitFunction))
    FunPtr C_MetaInitFunction
initFunc' <- C_MetaInitFunction -> IO (FunPtr C_MetaInitFunction)
Gst.Callbacks.mk_MetaInitFunction (Maybe (Ptr (FunPtr C_MetaInitFunction))
-> MetaInitFunction -> C_MetaInitFunction
Gst.Callbacks.wrap_MetaInitFunction (Ptr (FunPtr C_MetaInitFunction)
-> Maybe (Ptr (FunPtr C_MetaInitFunction))
forall a. a -> Maybe a
Just Ptr (FunPtr C_MetaInitFunction)
ptrinitFunc) MetaInitFunction
initFunc)
    Ptr (FunPtr C_MetaInitFunction)
-> FunPtr C_MetaInitFunction -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_MetaInitFunction)
ptrinitFunc FunPtr C_MetaInitFunction
initFunc'
    Ptr (FunPtr C_MetaFreeFunction)
ptrfreeFunc <- IO (Ptr (FunPtr C_MetaFreeFunction))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gst.Callbacks.C_MetaFreeFunction))
    FunPtr C_MetaFreeFunction
freeFunc' <- C_MetaFreeFunction -> IO (FunPtr C_MetaFreeFunction)
Gst.Callbacks.mk_MetaFreeFunction (Maybe (Ptr (FunPtr C_MetaFreeFunction))
-> MetaFreeFunction -> C_MetaFreeFunction
Gst.Callbacks.wrap_MetaFreeFunction (Ptr (FunPtr C_MetaFreeFunction)
-> Maybe (Ptr (FunPtr C_MetaFreeFunction))
forall a. a -> Maybe a
Just Ptr (FunPtr C_MetaFreeFunction)
ptrfreeFunc) MetaFreeFunction
freeFunc)
    Ptr (FunPtr C_MetaFreeFunction)
-> FunPtr C_MetaFreeFunction -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_MetaFreeFunction)
ptrfreeFunc FunPtr C_MetaFreeFunction
freeFunc'
    Ptr (FunPtr C_MetaTransformFunction)
ptrtransformFunc <- IO (Ptr (FunPtr C_MetaTransformFunction))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gst.Callbacks.C_MetaTransformFunction))
    FunPtr C_MetaTransformFunction
transformFunc' <- C_MetaTransformFunction -> IO (FunPtr C_MetaTransformFunction)
Gst.Callbacks.mk_MetaTransformFunction (Maybe (Ptr (FunPtr C_MetaTransformFunction))
-> MetaTransformFunction -> C_MetaTransformFunction
Gst.Callbacks.wrap_MetaTransformFunction (Ptr (FunPtr C_MetaTransformFunction)
-> Maybe (Ptr (FunPtr C_MetaTransformFunction))
forall a. a -> Maybe a
Just Ptr (FunPtr C_MetaTransformFunction)
ptrtransformFunc) MetaTransformFunction
transformFunc)
    Ptr (FunPtr C_MetaTransformFunction)
-> FunPtr C_MetaTransformFunction -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_MetaTransformFunction)
ptrtransformFunc FunPtr C_MetaTransformFunction
transformFunc'
    Ptr MetaInfo
result <- Word64
-> CString
-> Word64
-> FunPtr C_MetaInitFunction
-> FunPtr C_MetaFreeFunction
-> FunPtr C_MetaTransformFunction
-> IO (Ptr MetaInfo)
gst_meta_register Word64
api' CString
impl' Word64
size FunPtr C_MetaInitFunction
initFunc' FunPtr C_MetaFreeFunction
freeFunc' FunPtr C_MetaTransformFunction
transformFunc'
    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
$ \result' :: Ptr MetaInfo
result' -> do
        MetaInfo
result'' <- ((ManagedPtr MetaInfo -> MetaInfo) -> Ptr MetaInfo -> IO MetaInfo
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr MetaInfo -> MetaInfo
Gst.MetaInfo.MetaInfo) Ptr MetaInfo
result'
        MetaInfo -> IO MetaInfo
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe MetaInfo
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMetaMethod (t :: Symbol) (o :: *) :: * where
    ResolveMetaMethod "compareSeqnum" o = MetaCompareSeqnumMethodInfo
    ResolveMetaMethod "getSeqnum" o = MetaGetSeqnumMethodInfo
    ResolveMetaMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveMetaMethod t Meta, O.MethodInfo 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

#endif