{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- List of tags and values used to describe media metadata.
-- 
-- Strings in structures must be ASCII or UTF-8 encoded. Other encodings are
-- not allowed. Strings must not be empty or 'P.Nothing'.

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

module GI.Gst.Structs.TagList
    ( 

-- * Exported types
    TagList(..)                             ,
    newZeroTagList                          ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveTagListMethod                    ,
#endif


-- ** addValue #method:addValue#

#if defined(ENABLE_OVERLOADING)
    TagListAddValueMethodInfo               ,
#endif
    tagListAddValue                         ,


-- ** copyValue #method:copyValue#

    tagListCopyValue                        ,


-- ** foreach #method:foreach#

#if defined(ENABLE_OVERLOADING)
    TagListForeachMethodInfo                ,
#endif
    tagListForeach                          ,


-- ** getBoolean #method:getBoolean#

#if defined(ENABLE_OVERLOADING)
    TagListGetBooleanMethodInfo             ,
#endif
    tagListGetBoolean                       ,


-- ** getBooleanIndex #method:getBooleanIndex#

#if defined(ENABLE_OVERLOADING)
    TagListGetBooleanIndexMethodInfo        ,
#endif
    tagListGetBooleanIndex                  ,


-- ** getDate #method:getDate#

#if defined(ENABLE_OVERLOADING)
    TagListGetDateMethodInfo                ,
#endif
    tagListGetDate                          ,


-- ** getDateIndex #method:getDateIndex#

#if defined(ENABLE_OVERLOADING)
    TagListGetDateIndexMethodInfo           ,
#endif
    tagListGetDateIndex                     ,


-- ** getDateTime #method:getDateTime#

#if defined(ENABLE_OVERLOADING)
    TagListGetDateTimeMethodInfo            ,
#endif
    tagListGetDateTime                      ,


-- ** getDateTimeIndex #method:getDateTimeIndex#

#if defined(ENABLE_OVERLOADING)
    TagListGetDateTimeIndexMethodInfo       ,
#endif
    tagListGetDateTimeIndex                 ,


-- ** getDouble #method:getDouble#

#if defined(ENABLE_OVERLOADING)
    TagListGetDoubleMethodInfo              ,
#endif
    tagListGetDouble                        ,


-- ** getDoubleIndex #method:getDoubleIndex#

#if defined(ENABLE_OVERLOADING)
    TagListGetDoubleIndexMethodInfo         ,
#endif
    tagListGetDoubleIndex                   ,


-- ** getFloat #method:getFloat#

#if defined(ENABLE_OVERLOADING)
    TagListGetFloatMethodInfo               ,
#endif
    tagListGetFloat                         ,


-- ** getFloatIndex #method:getFloatIndex#

#if defined(ENABLE_OVERLOADING)
    TagListGetFloatIndexMethodInfo          ,
#endif
    tagListGetFloatIndex                    ,


-- ** getInt #method:getInt#

#if defined(ENABLE_OVERLOADING)
    TagListGetIntMethodInfo                 ,
#endif
    tagListGetInt                           ,


-- ** getInt64 #method:getInt64#

#if defined(ENABLE_OVERLOADING)
    TagListGetInt64MethodInfo               ,
#endif
    tagListGetInt64                         ,


-- ** getInt64Index #method:getInt64Index#

#if defined(ENABLE_OVERLOADING)
    TagListGetInt64IndexMethodInfo          ,
#endif
    tagListGetInt64Index                    ,


-- ** getIntIndex #method:getIntIndex#

#if defined(ENABLE_OVERLOADING)
    TagListGetIntIndexMethodInfo            ,
#endif
    tagListGetIntIndex                      ,


-- ** getPointer #method:getPointer#

#if defined(ENABLE_OVERLOADING)
    TagListGetPointerMethodInfo             ,
#endif
    tagListGetPointer                       ,


-- ** getPointerIndex #method:getPointerIndex#

#if defined(ENABLE_OVERLOADING)
    TagListGetPointerIndexMethodInfo        ,
#endif
    tagListGetPointerIndex                  ,


-- ** getSample #method:getSample#

#if defined(ENABLE_OVERLOADING)
    TagListGetSampleMethodInfo              ,
#endif
    tagListGetSample                        ,


-- ** getSampleIndex #method:getSampleIndex#

#if defined(ENABLE_OVERLOADING)
    TagListGetSampleIndexMethodInfo         ,
#endif
    tagListGetSampleIndex                   ,


-- ** getScope #method:getScope#

#if defined(ENABLE_OVERLOADING)
    TagListGetScopeMethodInfo               ,
#endif
    tagListGetScope                         ,


-- ** getString #method:getString#

#if defined(ENABLE_OVERLOADING)
    TagListGetStringMethodInfo              ,
#endif
    tagListGetString                        ,


-- ** getStringIndex #method:getStringIndex#

#if defined(ENABLE_OVERLOADING)
    TagListGetStringIndexMethodInfo         ,
#endif
    tagListGetStringIndex                   ,


-- ** getTagSize #method:getTagSize#

#if defined(ENABLE_OVERLOADING)
    TagListGetTagSizeMethodInfo             ,
#endif
    tagListGetTagSize                       ,


-- ** getUint #method:getUint#

#if defined(ENABLE_OVERLOADING)
    TagListGetUintMethodInfo                ,
#endif
    tagListGetUint                          ,


-- ** getUint64 #method:getUint64#

#if defined(ENABLE_OVERLOADING)
    TagListGetUint64MethodInfo              ,
#endif
    tagListGetUint64                        ,


-- ** getUint64Index #method:getUint64Index#

#if defined(ENABLE_OVERLOADING)
    TagListGetUint64IndexMethodInfo         ,
#endif
    tagListGetUint64Index                   ,


-- ** getUintIndex #method:getUintIndex#

#if defined(ENABLE_OVERLOADING)
    TagListGetUintIndexMethodInfo           ,
#endif
    tagListGetUintIndex                     ,


-- ** getValueIndex #method:getValueIndex#

#if defined(ENABLE_OVERLOADING)
    TagListGetValueIndexMethodInfo          ,
#endif
    tagListGetValueIndex                    ,


-- ** insert #method:insert#

#if defined(ENABLE_OVERLOADING)
    TagListInsertMethodInfo                 ,
#endif
    tagListInsert                           ,


-- ** isEmpty #method:isEmpty#

#if defined(ENABLE_OVERLOADING)
    TagListIsEmptyMethodInfo                ,
#endif
    tagListIsEmpty                          ,


-- ** isEqual #method:isEqual#

#if defined(ENABLE_OVERLOADING)
    TagListIsEqualMethodInfo                ,
#endif
    tagListIsEqual                          ,


-- ** merge #method:merge#

#if defined(ENABLE_OVERLOADING)
    TagListMergeMethodInfo                  ,
#endif
    tagListMerge                            ,


-- ** nTags #method:nTags#

#if defined(ENABLE_OVERLOADING)
    TagListNTagsMethodInfo                  ,
#endif
    tagListNTags                            ,


-- ** newEmpty #method:newEmpty#

    tagListNewEmpty                         ,


-- ** newFromString #method:newFromString#

    tagListNewFromString                    ,


-- ** nthTagName #method:nthTagName#

#if defined(ENABLE_OVERLOADING)
    TagListNthTagNameMethodInfo             ,
#endif
    tagListNthTagName                       ,


-- ** peekStringIndex #method:peekStringIndex#

#if defined(ENABLE_OVERLOADING)
    TagListPeekStringIndexMethodInfo        ,
#endif
    tagListPeekStringIndex                  ,


-- ** removeTag #method:removeTag#

#if defined(ENABLE_OVERLOADING)
    TagListRemoveTagMethodInfo              ,
#endif
    tagListRemoveTag                        ,


-- ** setScope #method:setScope#

#if defined(ENABLE_OVERLOADING)
    TagListSetScopeMethodInfo               ,
#endif
    tagListSetScope                         ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    TagListToStringMethodInfo               ,
#endif
    tagListToString                         ,




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

    getTagListMiniObject                    ,
#if defined(ENABLE_OVERLOADING)
    tagList_miniObject                      ,
#endif




    ) where

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

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

import qualified GI.GLib.Structs.Date as GLib.Date
import qualified GI.Gst.Callbacks as Gst.Callbacks
import {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums
import {-# SOURCE #-} qualified GI.Gst.Structs.DateTime as Gst.DateTime
import {-# SOURCE #-} qualified GI.Gst.Structs.MiniObject as Gst.MiniObject
import {-# SOURCE #-} qualified GI.Gst.Structs.Sample as Gst.Sample

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

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

foreign import ccall "gst_tag_list_get_type" c_gst_tag_list_get_type :: 
    IO GType

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

instance B.Types.TypedObject TagList where
    glibType :: IO GType
glibType = IO GType
c_gst_tag_list_get_type

instance B.Types.GBoxed TagList

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

-- | Construct a `TagList` struct initialized to zero.
newZeroTagList :: MonadIO m => m TagList
newZeroTagList :: m TagList
newZeroTagList = IO TagList -> m TagList
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TagList -> m TagList) -> IO TagList -> m TagList
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr TagList)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
64 IO (Ptr TagList) -> (Ptr TagList -> IO TagList) -> IO TagList
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr TagList -> TagList) -> Ptr TagList -> IO TagList
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TagList -> TagList
TagList

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


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

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

tagList_miniObject :: AttrLabelProxy "miniObject"
tagList_miniObject = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TagList
type instance O.AttributeList TagList = TagListAttributeList
type TagListAttributeList = ('[ '("miniObject", TagListMiniObjectFieldInfo)] :: [(Symbol, *)])
#endif

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

foreign import ccall "gst_tag_list_new_empty" gst_tag_list_new_empty :: 
    IO (Ptr TagList)

-- | Creates a new empty GstTagList.
-- 
-- Free-function: gst_tag_list_unref
tagListNewEmpty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m TagList
    -- ^ __Returns:__ An empty tag list
tagListNewEmpty :: m TagList
tagListNewEmpty  = IO TagList -> m TagList
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TagList -> m TagList) -> IO TagList -> m TagList
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
result <- IO (Ptr TagList)
gst_tag_list_new_empty
    Text -> Ptr TagList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tagListNewEmpty" Ptr TagList
result
    TagList
result' <- ((ManagedPtr TagList -> TagList) -> Ptr TagList -> IO TagList
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TagList -> TagList
TagList) Ptr TagList
result
    TagList -> IO TagList
forall (m :: * -> *) a. Monad m => a -> m a
return TagList
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method TagList::new_from_string
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a string created with gst_tag_list_to_string()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "TagList" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_new_from_string" gst_tag_list_new_from_string :: 
    CString ->                              -- str : TBasicType TUTF8
    IO (Ptr TagList)

-- | Deserializes a tag list.
tagListNewFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@str@/: a string created with 'GI.Gst.Structs.TagList.tagListToString'
    -> m (Maybe TagList)
    -- ^ __Returns:__ a new t'GI.Gst.Structs.TagList.TagList', or 'P.Nothing' in case of an
    -- error.
tagListNewFromString :: Text -> m (Maybe TagList)
tagListNewFromString Text
str = IO (Maybe TagList) -> m (Maybe TagList)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TagList) -> m (Maybe TagList))
-> IO (Maybe TagList) -> m (Maybe TagList)
forall a b. (a -> b) -> a -> b
$ do
    CString
str' <- Text -> IO CString
textToCString Text
str
    Ptr TagList
result <- CString -> IO (Ptr TagList)
gst_tag_list_new_from_string CString
str'
    Maybe TagList
maybeResult <- Ptr TagList -> (Ptr TagList -> IO TagList) -> IO (Maybe TagList)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TagList
result ((Ptr TagList -> IO TagList) -> IO (Maybe TagList))
-> (Ptr TagList -> IO TagList) -> IO (Maybe TagList)
forall a b. (a -> b) -> a -> b
$ \Ptr TagList
result' -> do
        TagList
result'' <- ((ManagedPtr TagList -> TagList) -> Ptr TagList -> IO TagList
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TagList -> TagList
TagList) Ptr TagList
result'
        TagList -> IO TagList
forall (m :: * -> *) a. Monad m => a -> m a
return TagList
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
    Maybe TagList -> IO (Maybe TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TagList
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method TagList::add_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "list to set tags in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagMergeMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mode to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "tag" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GValue for this tag"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_add_value" gst_tag_list_add_value :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gst", name = "TagMergeMode"})
    CString ->                              -- tag : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Sets the GValue for a given tag using the specified mode.
tagListAddValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: list to set tags in
    -> Gst.Enums.TagMergeMode
    -- ^ /@mode@/: the mode to use
    -> T.Text
    -- ^ /@tag@/: tag
    -> GValue
    -- ^ /@value@/: GValue for this tag
    -> m ()
tagListAddValue :: TagList -> TagMergeMode -> Text -> GValue -> m ()
tagListAddValue TagList
list TagMergeMode
mode Text
tag GValue
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TagMergeMode -> Int) -> TagMergeMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagMergeMode -> Int
forall a. Enum a => a -> Int
fromEnum) TagMergeMode
mode
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr TagList -> CUInt -> CString -> Ptr GValue -> IO ()
gst_tag_list_add_value Ptr TagList
list' CUInt
mode' CString
tag' Ptr GValue
value'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr GValue -> IO ()
B.GValue.unsetGValue Ptr GValue
value'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TagListAddValueMethodInfo
instance (signature ~ (Gst.Enums.TagMergeMode -> T.Text -> GValue -> m ()), MonadIO m) => O.MethodInfo TagListAddValueMethodInfo TagList signature where
    overloadedMethod = tagListAddValue

#endif

-- method TagList::foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "list to iterate over"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagForeachFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "function to be called for each tag"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user specified data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_foreach" gst_tag_list_foreach :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    FunPtr Gst.Callbacks.C_TagForeachFunc -> -- func : TInterface (Name {namespace = "Gst", name = "TagForeachFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Calls the given function for each tag inside the tag list. Note that if there
-- is no tag, the function won\'t be called at all.
tagListForeach ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: list to iterate over
    -> Gst.Callbacks.TagForeachFunc
    -- ^ /@func@/: function to be called for each tag
    -> m ()
tagListForeach :: TagList -> TagForeachFunc -> m ()
tagListForeach TagList
list TagForeachFunc
func = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    FunPtr C_TagForeachFunc
func' <- C_TagForeachFunc -> IO (FunPtr C_TagForeachFunc)
Gst.Callbacks.mk_TagForeachFunc (Maybe (Ptr (FunPtr C_TagForeachFunc))
-> TagForeachFunc_WithClosures -> C_TagForeachFunc
Gst.Callbacks.wrap_TagForeachFunc Maybe (Ptr (FunPtr C_TagForeachFunc))
forall a. Maybe a
Nothing (TagForeachFunc -> TagForeachFunc_WithClosures
Gst.Callbacks.drop_closures_TagForeachFunc TagForeachFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr TagList -> FunPtr C_TagForeachFunc -> Ptr () -> IO ()
gst_tag_list_foreach Ptr TagList
list' FunPtr C_TagForeachFunc
func' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_TagForeachFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_TagForeachFunc
func'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TagListForeachMethodInfo
instance (signature ~ (Gst.Callbacks.TagForeachFunc -> m ()), MonadIO m) => O.MethodInfo TagListForeachMethodInfo TagList signature where
    overloadedMethod = tagListForeach

#endif

-- method TagList::get_boolean
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_boolean" gst_tag_list_get_boolean :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Ptr CInt ->                             -- value : TBasicType TBoolean
    IO CInt

-- | Copies the contents for the given tag into the value, merging multiple values
-- into one if multiple values are associated with the tag.
tagListGetBoolean ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> m ((Bool, Bool))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetBoolean :: TagList -> Text -> m (Bool, Bool)
tagListGetBoolean TagList
list Text
tag = IO (Bool, Bool) -> m (Bool, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Bool) -> m (Bool, Bool))
-> IO (Bool, Bool) -> m (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr CInt
value <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    CInt
result <- Ptr TagList -> CString -> Ptr CInt -> IO CInt
gst_tag_list_get_boolean Ptr TagList
list' CString
tag' Ptr CInt
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CInt
value' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
value
    let value'' :: Bool
value'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
value'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
value
    (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Bool
value'')

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

#endif

-- method TagList::get_boolean_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entry to read out"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_boolean_index" gst_tag_list_get_boolean_index :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Word32 ->                               -- index : TBasicType TUInt
    Ptr CInt ->                             -- value : TBasicType TBoolean
    IO CInt

-- | Gets the value that is at the given index for the given tag in the given
-- list.
tagListGetBooleanIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> Word32
    -- ^ /@index@/: number of entry to read out
    -> m ((Bool, Bool))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetBooleanIndex :: TagList -> Text -> Word32 -> m (Bool, Bool)
tagListGetBooleanIndex TagList
list Text
tag Word32
index = IO (Bool, Bool) -> m (Bool, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Bool) -> m (Bool, Bool))
-> IO (Bool, Bool) -> m (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr CInt
value <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    CInt
result <- Ptr TagList -> CString -> Word32 -> Ptr CInt -> IO CInt
gst_tag_list_get_boolean_index Ptr TagList
list' CString
tag' Word32
index Ptr CInt
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CInt
value' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
value
    let value'' :: Bool
value'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
value'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
value
    (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Bool
value'')

#if defined(ENABLE_OVERLOADING)
data TagListGetBooleanIndexMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ((Bool, Bool))), MonadIO m) => O.MethodInfo TagListGetBooleanIndexMethodInfo TagList signature where
    overloadedMethod = tagListGetBooleanIndex

#endif

-- method TagList::get_date
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TInterface Name { namespace = "GLib" , name = "Date" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "address of a GDate pointer\n    variable to store the result into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_date" gst_tag_list_get_date :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Ptr (Ptr GLib.Date.Date) ->             -- value : TInterface (Name {namespace = "GLib", name = "Date"})
    IO CInt

-- | Copies the first date for the given tag in the taglist into the variable
-- pointed to by /@value@/. Free the date with 'GI.GLib.Structs.Date.dateFree' when it is no longer
-- needed.
-- 
-- Free-function: g_date_free
tagListGetDate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> m ((Bool, GLib.Date.Date))
    -- ^ __Returns:__ 'P.True', if a date was copied, 'P.False' if the tag didn\'t exist in the
    --              given list or if it was 'P.Nothing'.
tagListGetDate :: TagList -> Text -> m (Bool, Date)
tagListGetDate TagList
list Text
tag = IO (Bool, Date) -> m (Bool, Date)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Date) -> m (Bool, Date))
-> IO (Bool, Date) -> m (Bool, Date)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr (Ptr Date)
value <- IO (Ptr (Ptr Date))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr GLib.Date.Date))
    CInt
result <- Ptr TagList -> CString -> Ptr (Ptr Date) -> IO CInt
gst_tag_list_get_date Ptr TagList
list' CString
tag' Ptr (Ptr Date)
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Date
value' <- Ptr (Ptr Date) -> IO (Ptr Date)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Date)
value
    Date
value'' <- ((ManagedPtr Date -> Date) -> Ptr Date -> IO Date
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Date -> Date
GLib.Date.Date) Ptr Date
value'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr (Ptr Date) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Date)
value
    (Bool, Date) -> IO (Bool, Date)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Date
value'')

#if defined(ENABLE_OVERLOADING)
data TagListGetDateMethodInfo
instance (signature ~ (T.Text -> m ((Bool, GLib.Date.Date))), MonadIO m) => O.MethodInfo TagListGetDateMethodInfo TagList signature where
    overloadedMethod = tagListGetDate

#endif

-- method TagList::get_date_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entry to read out"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TInterface Name { namespace = "GLib" , name = "Date" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_date_index" gst_tag_list_get_date_index :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Word32 ->                               -- index : TBasicType TUInt
    Ptr (Ptr GLib.Date.Date) ->             -- value : TInterface (Name {namespace = "GLib", name = "Date"})
    IO CInt

-- | Gets the date that is at the given index for the given tag in the given
-- list and copies it into the variable pointed to by /@value@/. Free the date
-- with 'GI.GLib.Structs.Date.dateFree' when it is no longer needed.
-- 
-- Free-function: g_date_free
tagListGetDateIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> Word32
    -- ^ /@index@/: number of entry to read out
    -> m ((Bool, GLib.Date.Date))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list or if it was 'P.Nothing'.
tagListGetDateIndex :: TagList -> Text -> Word32 -> m (Bool, Date)
tagListGetDateIndex TagList
list Text
tag Word32
index = IO (Bool, Date) -> m (Bool, Date)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Date) -> m (Bool, Date))
-> IO (Bool, Date) -> m (Bool, Date)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr (Ptr Date)
value <- IO (Ptr (Ptr Date))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr GLib.Date.Date))
    CInt
result <- Ptr TagList -> CString -> Word32 -> Ptr (Ptr Date) -> IO CInt
gst_tag_list_get_date_index Ptr TagList
list' CString
tag' Word32
index Ptr (Ptr Date)
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Date
value' <- Ptr (Ptr Date) -> IO (Ptr Date)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Date)
value
    Date
value'' <- ((ManagedPtr Date -> Date) -> Ptr Date -> IO Date
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Date -> Date
GLib.Date.Date) Ptr Date
value'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr (Ptr Date) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Date)
value
    (Bool, Date) -> IO (Bool, Date)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Date
value'')

#if defined(ENABLE_OVERLOADING)
data TagListGetDateIndexMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ((Bool, GLib.Date.Date))), MonadIO m) => O.MethodInfo TagListGetDateIndexMethodInfo TagList signature where
    overloadedMethod = tagListGetDateIndex

#endif

-- method TagList::get_date_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "address of a #GstDateTime\n    pointer variable to store the result into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_date_time" gst_tag_list_get_date_time :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Ptr (Ptr Gst.DateTime.DateTime) ->      -- value : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO CInt

-- | Copies the first datetime for the given tag in the taglist into the variable
-- pointed to by /@value@/. Unref the date with 'GI.Gst.Structs.DateTime.dateTimeUnref' when
-- it is no longer needed.
-- 
-- Free-function: gst_date_time_unref
tagListGetDateTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> m ((Bool, Gst.DateTime.DateTime))
    -- ^ __Returns:__ 'P.True', if a datetime was copied, 'P.False' if the tag didn\'t exist in
    --              the given list or if it was 'P.Nothing'.
tagListGetDateTime :: TagList -> Text -> m (Bool, DateTime)
tagListGetDateTime TagList
list Text
tag = IO (Bool, DateTime) -> m (Bool, DateTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, DateTime) -> m (Bool, DateTime))
-> IO (Bool, DateTime) -> m (Bool, DateTime)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr (Ptr DateTime)
value <- IO (Ptr (Ptr DateTime))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.DateTime.DateTime))
    CInt
result <- Ptr TagList -> CString -> Ptr (Ptr DateTime) -> IO CInt
gst_tag_list_get_date_time Ptr TagList
list' CString
tag' Ptr (Ptr DateTime)
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr DateTime
value' <- Ptr (Ptr DateTime) -> IO (Ptr DateTime)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr DateTime)
value
    DateTime
value'' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
Gst.DateTime.DateTime) Ptr DateTime
value'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr (Ptr DateTime) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr DateTime)
value
    (Bool, DateTime) -> IO (Bool, DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', DateTime
value'')

#if defined(ENABLE_OVERLOADING)
data TagListGetDateTimeMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Gst.DateTime.DateTime))), MonadIO m) => O.MethodInfo TagListGetDateTimeMethodInfo TagList signature where
    overloadedMethod = tagListGetDateTime

#endif

-- method TagList::get_date_time_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entry to read out"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_date_time_index" gst_tag_list_get_date_time_index :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Word32 ->                               -- index : TBasicType TUInt
    Ptr (Ptr Gst.DateTime.DateTime) ->      -- value : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO CInt

-- | Gets the datetime that is at the given index for the given tag in the given
-- list and copies it into the variable pointed to by /@value@/. Unref the datetime
-- with 'GI.Gst.Structs.DateTime.dateTimeUnref' when it is no longer needed.
-- 
-- Free-function: gst_date_time_unref
tagListGetDateTimeIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> Word32
    -- ^ /@index@/: number of entry to read out
    -> m ((Bool, Gst.DateTime.DateTime))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list or if it was 'P.Nothing'.
tagListGetDateTimeIndex :: TagList -> Text -> Word32 -> m (Bool, DateTime)
tagListGetDateTimeIndex TagList
list Text
tag Word32
index = IO (Bool, DateTime) -> m (Bool, DateTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, DateTime) -> m (Bool, DateTime))
-> IO (Bool, DateTime) -> m (Bool, DateTime)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr (Ptr DateTime)
value <- IO (Ptr (Ptr DateTime))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.DateTime.DateTime))
    CInt
result <- Ptr TagList -> CString -> Word32 -> Ptr (Ptr DateTime) -> IO CInt
gst_tag_list_get_date_time_index Ptr TagList
list' CString
tag' Word32
index Ptr (Ptr DateTime)
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr DateTime
value' <- Ptr (Ptr DateTime) -> IO (Ptr DateTime)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr DateTime)
value
    DateTime
value'' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
Gst.DateTime.DateTime) Ptr DateTime
value'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr (Ptr DateTime) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr DateTime)
value
    (Bool, DateTime) -> IO (Bool, DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', DateTime
value'')

#if defined(ENABLE_OVERLOADING)
data TagListGetDateTimeIndexMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ((Bool, Gst.DateTime.DateTime))), MonadIO m) => O.MethodInfo TagListGetDateTimeIndexMethodInfo TagList signature where
    overloadedMethod = tagListGetDateTimeIndex

#endif

-- method TagList::get_double
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_double" gst_tag_list_get_double :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Ptr CDouble ->                          -- value : TBasicType TDouble
    IO CInt

-- | Copies the contents for the given tag into the value, merging multiple values
-- into one if multiple values are associated with the tag.
tagListGetDouble ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> m ((Bool, Double))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetDouble :: TagList -> Text -> m (Bool, Double)
tagListGetDouble TagList
list Text
tag = IO (Bool, Double) -> m (Bool, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double) -> m (Bool, Double))
-> IO (Bool, Double) -> m (Bool, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr CDouble
value <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr TagList -> CString -> Ptr CDouble -> IO CInt
gst_tag_list_get_double Ptr TagList
list' CString
tag' Ptr CDouble
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
value' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
value
    let value'' :: Double
value'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
value'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
value
    (Bool, Double) -> IO (Bool, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
value'')

#if defined(ENABLE_OVERLOADING)
data TagListGetDoubleMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Double))), MonadIO m) => O.MethodInfo TagListGetDoubleMethodInfo TagList signature where
    overloadedMethod = tagListGetDouble

#endif

-- method TagList::get_double_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entry to read out"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_double_index" gst_tag_list_get_double_index :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Word32 ->                               -- index : TBasicType TUInt
    Ptr CDouble ->                          -- value : TBasicType TDouble
    IO CInt

-- | Gets the value that is at the given index for the given tag in the given
-- list.
tagListGetDoubleIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> Word32
    -- ^ /@index@/: number of entry to read out
    -> m ((Bool, Double))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetDoubleIndex :: TagList -> Text -> Word32 -> m (Bool, Double)
tagListGetDoubleIndex TagList
list Text
tag Word32
index = IO (Bool, Double) -> m (Bool, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double) -> m (Bool, Double))
-> IO (Bool, Double) -> m (Bool, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr CDouble
value <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr TagList -> CString -> Word32 -> Ptr CDouble -> IO CInt
gst_tag_list_get_double_index Ptr TagList
list' CString
tag' Word32
index Ptr CDouble
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
value' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
value
    let value'' :: Double
value'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
value'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
value
    (Bool, Double) -> IO (Bool, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
value'')

#if defined(ENABLE_OVERLOADING)
data TagListGetDoubleIndexMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ((Bool, Double))), MonadIO m) => O.MethodInfo TagListGetDoubleIndexMethodInfo TagList signature where
    overloadedMethod = tagListGetDoubleIndex

#endif

-- method TagList::get_float
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_float" gst_tag_list_get_float :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Ptr CFloat ->                           -- value : TBasicType TFloat
    IO CInt

-- | Copies the contents for the given tag into the value, merging multiple values
-- into one if multiple values are associated with the tag.
tagListGetFloat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> m ((Bool, Float))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetFloat :: TagList -> Text -> m (Bool, Float)
tagListGetFloat TagList
list Text
tag = IO (Bool, Float) -> m (Bool, Float)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Float) -> m (Bool, Float))
-> IO (Bool, Float) -> m (Bool, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr CFloat
value <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    CInt
result <- Ptr TagList -> CString -> Ptr CFloat -> IO CInt
gst_tag_list_get_float Ptr TagList
list' CString
tag' Ptr CFloat
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CFloat
value' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
value
    let value'' :: Float
value'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
value'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
value
    (Bool, Float) -> IO (Bool, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Float
value'')

#if defined(ENABLE_OVERLOADING)
data TagListGetFloatMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Float))), MonadIO m) => O.MethodInfo TagListGetFloatMethodInfo TagList signature where
    overloadedMethod = tagListGetFloat

#endif

-- method TagList::get_float_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entry to read out"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_float_index" gst_tag_list_get_float_index :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Word32 ->                               -- index : TBasicType TUInt
    Ptr CFloat ->                           -- value : TBasicType TFloat
    IO CInt

-- | Gets the value that is at the given index for the given tag in the given
-- list.
tagListGetFloatIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> Word32
    -- ^ /@index@/: number of entry to read out
    -> m ((Bool, Float))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetFloatIndex :: TagList -> Text -> Word32 -> m (Bool, Float)
tagListGetFloatIndex TagList
list Text
tag Word32
index = IO (Bool, Float) -> m (Bool, Float)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Float) -> m (Bool, Float))
-> IO (Bool, Float) -> m (Bool, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr CFloat
value <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    CInt
result <- Ptr TagList -> CString -> Word32 -> Ptr CFloat -> IO CInt
gst_tag_list_get_float_index Ptr TagList
list' CString
tag' Word32
index Ptr CFloat
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CFloat
value' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
value
    let value'' :: Float
value'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
value'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
value
    (Bool, Float) -> IO (Bool, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Float
value'')

#if defined(ENABLE_OVERLOADING)
data TagListGetFloatIndexMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ((Bool, Float))), MonadIO m) => O.MethodInfo TagListGetFloatIndexMethodInfo TagList signature where
    overloadedMethod = tagListGetFloatIndex

#endif

-- method TagList::get_int
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_int" gst_tag_list_get_int :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Ptr Int32 ->                            -- value : TBasicType TInt
    IO CInt

-- | Copies the contents for the given tag into the value, merging multiple values
-- into one if multiple values are associated with the tag.
tagListGetInt ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> m ((Bool, Int32))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetInt :: TagList -> Text -> m (Bool, Int32)
tagListGetInt TagList
list Text
tag = IO (Bool, Int32) -> m (Bool, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32) -> m (Bool, Int32))
-> IO (Bool, Int32) -> m (Bool, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr Int32
value <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr TagList -> CString -> Ptr Int32 -> IO CInt
gst_tag_list_get_int Ptr TagList
list' CString
tag' Ptr Int32
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int32
value' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
value
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
value
    (Bool, Int32) -> IO (Bool, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
value')

#if defined(ENABLE_OVERLOADING)
data TagListGetIntMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Int32))), MonadIO m) => O.MethodInfo TagListGetIntMethodInfo TagList signature where
    overloadedMethod = tagListGetInt

#endif

-- method TagList::get_int64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_int64" gst_tag_list_get_int64 :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Ptr Int64 ->                            -- value : TBasicType TInt64
    IO CInt

-- | Copies the contents for the given tag into the value, merging multiple values
-- into one if multiple values are associated with the tag.
tagListGetInt64 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> m ((Bool, Int64))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetInt64 :: TagList -> Text -> m (Bool, Int64)
tagListGetInt64 TagList
list Text
tag = IO (Bool, Int64) -> m (Bool, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64) -> m (Bool, Int64))
-> IO (Bool, Int64) -> m (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr Int64
value <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr TagList -> CString -> Ptr Int64 -> IO CInt
gst_tag_list_get_int64 Ptr TagList
list' CString
tag' Ptr Int64
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
value' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
value
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
value
    (Bool, Int64) -> IO (Bool, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
value')

#if defined(ENABLE_OVERLOADING)
data TagListGetInt64MethodInfo
instance (signature ~ (T.Text -> m ((Bool, Int64))), MonadIO m) => O.MethodInfo TagListGetInt64MethodInfo TagList signature where
    overloadedMethod = tagListGetInt64

#endif

-- method TagList::get_int64_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entry to read out"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_int64_index" gst_tag_list_get_int64_index :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Word32 ->                               -- index : TBasicType TUInt
    Ptr Int64 ->                            -- value : TBasicType TInt64
    IO CInt

-- | Gets the value that is at the given index for the given tag in the given
-- list.
tagListGetInt64Index ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> Word32
    -- ^ /@index@/: number of entry to read out
    -> m ((Bool, Int64))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetInt64Index :: TagList -> Text -> Word32 -> m (Bool, Int64)
tagListGetInt64Index TagList
list Text
tag Word32
index = IO (Bool, Int64) -> m (Bool, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64) -> m (Bool, Int64))
-> IO (Bool, Int64) -> m (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr Int64
value <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr TagList -> CString -> Word32 -> Ptr Int64 -> IO CInt
gst_tag_list_get_int64_index Ptr TagList
list' CString
tag' Word32
index Ptr Int64
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
value' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
value
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
value
    (Bool, Int64) -> IO (Bool, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
value')

#if defined(ENABLE_OVERLOADING)
data TagListGetInt64IndexMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ((Bool, Int64))), MonadIO m) => O.MethodInfo TagListGetInt64IndexMethodInfo TagList signature where
    overloadedMethod = tagListGetInt64Index

#endif

-- method TagList::get_int_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entry to read out"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_int_index" gst_tag_list_get_int_index :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Word32 ->                               -- index : TBasicType TUInt
    Ptr Int32 ->                            -- value : TBasicType TInt
    IO CInt

-- | Gets the value that is at the given index for the given tag in the given
-- list.
tagListGetIntIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> Word32
    -- ^ /@index@/: number of entry to read out
    -> m ((Bool, Int32))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetIntIndex :: TagList -> Text -> Word32 -> m (Bool, Int32)
tagListGetIntIndex TagList
list Text
tag Word32
index = IO (Bool, Int32) -> m (Bool, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32) -> m (Bool, Int32))
-> IO (Bool, Int32) -> m (Bool, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr Int32
value <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr TagList -> CString -> Word32 -> Ptr Int32 -> IO CInt
gst_tag_list_get_int_index Ptr TagList
list' CString
tag' Word32
index Ptr Int32
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int32
value' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
value
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
value
    (Bool, Int32) -> IO (Bool, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
value')

#if defined(ENABLE_OVERLOADING)
data TagListGetIntIndexMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ((Bool, Int32))), MonadIO m) => O.MethodInfo TagListGetIntIndexMethodInfo TagList signature where
    overloadedMethod = tagListGetIntIndex

#endif

-- method TagList::get_pointer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TPtr
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , 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_tag_list_get_pointer" gst_tag_list_get_pointer :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Ptr (Ptr ()) ->                         -- value : TBasicType TPtr
    IO CInt

-- | Copies the contents for the given tag into the value, merging multiple values
-- into one if multiple values are associated with the tag.
tagListGetPointer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> m ((Bool, Ptr ()))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetPointer :: TagList -> Text -> m (Bool, Ptr ())
tagListGetPointer TagList
list Text
tag = IO (Bool, Ptr ()) -> m (Bool, Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Ptr ()) -> m (Bool, Ptr ()))
-> IO (Bool, Ptr ()) -> m (Bool, Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr (Ptr ())
value <- IO (Ptr (Ptr ()))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr ()))
    CInt
result <- Ptr TagList -> CString -> Ptr (Ptr ()) -> IO CInt
gst_tag_list_get_pointer Ptr TagList
list' CString
tag' Ptr (Ptr ())
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr ()
value' <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
value
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr (Ptr ()) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr ())
value
    (Bool, Ptr ()) -> IO (Bool, Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Ptr ()
value')

#if defined(ENABLE_OVERLOADING)
data TagListGetPointerMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Ptr ()))), MonadIO m) => O.MethodInfo TagListGetPointerMethodInfo TagList signature where
    overloadedMethod = tagListGetPointer

#endif

-- method TagList::get_pointer_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entry to read out"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TPtr
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , 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_tag_list_get_pointer_index" gst_tag_list_get_pointer_index :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Word32 ->                               -- index : TBasicType TUInt
    Ptr (Ptr ()) ->                         -- value : TBasicType TPtr
    IO CInt

-- | Gets the value that is at the given index for the given tag in the given
-- list.
tagListGetPointerIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> Word32
    -- ^ /@index@/: number of entry to read out
    -> m ((Bool, Ptr ()))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetPointerIndex :: TagList -> Text -> Word32 -> m (Bool, Ptr ())
tagListGetPointerIndex TagList
list Text
tag Word32
index = IO (Bool, Ptr ()) -> m (Bool, Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Ptr ()) -> m (Bool, Ptr ()))
-> IO (Bool, Ptr ()) -> m (Bool, Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr (Ptr ())
value <- IO (Ptr (Ptr ()))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr ()))
    CInt
result <- Ptr TagList -> CString -> Word32 -> Ptr (Ptr ()) -> IO CInt
gst_tag_list_get_pointer_index Ptr TagList
list' CString
tag' Word32
index Ptr (Ptr ())
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr ()
value' <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
value
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr (Ptr ()) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr ())
value
    (Bool, Ptr ()) -> IO (Bool, Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Ptr ()
value')

#if defined(ENABLE_OVERLOADING)
data TagListGetPointerIndexMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ((Bool, Ptr ()))), MonadIO m) => O.MethodInfo TagListGetPointerIndexMethodInfo TagList signature where
    overloadedMethod = tagListGetPointerIndex

#endif

-- method TagList::get_sample
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sample"
--           , argType = TInterface Name { namespace = "Gst" , name = "Sample" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "address of a GstSample\n    pointer variable to store the result into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_sample" gst_tag_list_get_sample :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Ptr (Ptr Gst.Sample.Sample) ->          -- sample : TInterface (Name {namespace = "Gst", name = "Sample"})
    IO CInt

-- | Copies the first sample for the given tag in the taglist into the variable
-- pointed to by /@sample@/. Free the sample with @/gst_sample_unref()/@ when it is
-- no longer needed. You can retrieve the buffer from the sample using
-- 'GI.Gst.Structs.Sample.sampleGetBuffer' and the associated caps (if any) with
-- 'GI.Gst.Structs.Sample.sampleGetCaps'.
-- 
-- Free-function: gst_sample_unref
tagListGetSample ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> m ((Bool, Gst.Sample.Sample))
    -- ^ __Returns:__ 'P.True', if a sample was returned, 'P.False' if the tag didn\'t exist in
    --              the given list or if it was 'P.Nothing'.
tagListGetSample :: TagList -> Text -> m (Bool, Sample)
tagListGetSample TagList
list Text
tag = IO (Bool, Sample) -> m (Bool, Sample)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Sample) -> m (Bool, Sample))
-> IO (Bool, Sample) -> m (Bool, Sample)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr (Ptr Sample)
sample <- IO (Ptr (Ptr Sample))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Sample.Sample))
    CInt
result <- Ptr TagList -> CString -> Ptr (Ptr Sample) -> IO CInt
gst_tag_list_get_sample Ptr TagList
list' CString
tag' Ptr (Ptr Sample)
sample
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Sample
sample' <- Ptr (Ptr Sample) -> IO (Ptr Sample)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Sample)
sample
    Sample
sample'' <- ((ManagedPtr Sample -> Sample) -> Ptr Sample -> IO Sample
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Sample -> Sample
Gst.Sample.Sample) Ptr Sample
sample'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr (Ptr Sample) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Sample)
sample
    (Bool, Sample) -> IO (Bool, Sample)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Sample
sample'')

#if defined(ENABLE_OVERLOADING)
data TagListGetSampleMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Gst.Sample.Sample))), MonadIO m) => O.MethodInfo TagListGetSampleMethodInfo TagList signature where
    overloadedMethod = tagListGetSample

#endif

-- method TagList::get_sample_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entry to read out"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sample"
--           , argType = TInterface Name { namespace = "Gst" , name = "Sample" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "address of a GstSample\n    pointer variable to store the result into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_sample_index" gst_tag_list_get_sample_index :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Word32 ->                               -- index : TBasicType TUInt
    Ptr (Ptr Gst.Sample.Sample) ->          -- sample : TInterface (Name {namespace = "Gst", name = "Sample"})
    IO CInt

-- | Gets the sample that is at the given index for the given tag in the given
-- list and copies it into the variable pointed to by /@sample@/. Free the sample
-- with @/gst_sample_unref()/@ when it is no longer needed. You can retrieve the
-- buffer from the sample using 'GI.Gst.Structs.Sample.sampleGetBuffer' and the associated
-- caps (if any) with 'GI.Gst.Structs.Sample.sampleGetCaps'.
-- 
-- Free-function: gst_sample_unref
tagListGetSampleIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> Word32
    -- ^ /@index@/: number of entry to read out
    -> m ((Bool, Gst.Sample.Sample))
    -- ^ __Returns:__ 'P.True', if a sample was copied, 'P.False' if the tag didn\'t exist in the
    --              given list or if it was 'P.Nothing'.
tagListGetSampleIndex :: TagList -> Text -> Word32 -> m (Bool, Sample)
tagListGetSampleIndex TagList
list Text
tag Word32
index = IO (Bool, Sample) -> m (Bool, Sample)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Sample) -> m (Bool, Sample))
-> IO (Bool, Sample) -> m (Bool, Sample)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr (Ptr Sample)
sample <- IO (Ptr (Ptr Sample))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Sample.Sample))
    CInt
result <- Ptr TagList -> CString -> Word32 -> Ptr (Ptr Sample) -> IO CInt
gst_tag_list_get_sample_index Ptr TagList
list' CString
tag' Word32
index Ptr (Ptr Sample)
sample
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Sample
sample' <- Ptr (Ptr Sample) -> IO (Ptr Sample)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Sample)
sample
    Sample
sample'' <- ((ManagedPtr Sample -> Sample) -> Ptr Sample -> IO Sample
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Sample -> Sample
Gst.Sample.Sample) Ptr Sample
sample'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr (Ptr Sample) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Sample)
sample
    (Bool, Sample) -> IO (Bool, Sample)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Sample
sample'')

#if defined(ENABLE_OVERLOADING)
data TagListGetSampleIndexMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ((Bool, Gst.Sample.Sample))), MonadIO m) => O.MethodInfo TagListGetSampleIndexMethodInfo TagList signature where
    overloadedMethod = tagListGetSampleIndex

#endif

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

foreign import ccall "gst_tag_list_get_scope" gst_tag_list_get_scope :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    IO CUInt

-- | Gets the scope of /@list@/.
tagListGetScope ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList'
    -> m Gst.Enums.TagScope
    -- ^ __Returns:__ The scope of /@list@/
tagListGetScope :: TagList -> m TagScope
tagListGetScope TagList
list = IO TagScope -> m TagScope
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TagScope -> m TagScope) -> IO TagScope -> m TagScope
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CUInt
result <- Ptr TagList -> IO CUInt
gst_tag_list_get_scope Ptr TagList
list'
    let result' :: TagScope
result' = (Int -> TagScope
forall a. Enum a => Int -> a
toEnum (Int -> TagScope) -> (CUInt -> Int) -> CUInt -> TagScope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    TagScope -> IO TagScope
forall (m :: * -> *) a. Monad m => a -> m a
return TagScope
result'

#if defined(ENABLE_OVERLOADING)
data TagListGetScopeMethodInfo
instance (signature ~ (m Gst.Enums.TagScope), MonadIO m) => O.MethodInfo TagListGetScopeMethodInfo TagList signature where
    overloadedMethod = tagListGetScope

#endif

-- method TagList::get_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_string" gst_tag_list_get_string :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Ptr CString ->                          -- value : TBasicType TUTF8
    IO CInt

-- | Copies the contents for the given tag into the value, possibly merging
-- multiple values into one if multiple values are associated with the tag.
-- 
-- Use gst_tag_list_get_string_index (list, tag, 0, value) if you want
-- to retrieve the first string associated with this tag unmodified.
-- 
-- The resulting string in /@value@/ will be in UTF-8 encoding and should be
-- freed by the caller using g_free when no longer needed. The
-- returned string is also guaranteed to be non-'P.Nothing' and non-empty.
-- 
-- Free-function: g_free
tagListGetString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> m ((Bool, T.Text))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetString :: TagList -> Text -> m (Bool, Text)
tagListGetString TagList
list Text
tag = IO (Bool, Text) -> m (Bool, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Text) -> m (Bool, Text))
-> IO (Bool, Text) -> m (Bool, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr CString
value <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    CInt
result <- Ptr TagList -> CString -> Ptr CString -> IO CInt
gst_tag_list_get_string Ptr TagList
list' CString
tag' Ptr CString
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString
value' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
value
    Text
value'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
value'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
value
    (Bool, Text) -> IO (Bool, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Text
value'')

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

#endif

-- method TagList::get_string_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entry to read out"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_string_index" gst_tag_list_get_string_index :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Word32 ->                               -- index : TBasicType TUInt
    Ptr CString ->                          -- value : TBasicType TUTF8
    IO CInt

-- | Gets the value that is at the given index for the given tag in the given
-- list.
-- 
-- The resulting string in /@value@/ will be in UTF-8 encoding and should be
-- freed by the caller using g_free when no longer needed. The
-- returned string is also guaranteed to be non-'P.Nothing' and non-empty.
-- 
-- Free-function: g_free
tagListGetStringIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> Word32
    -- ^ /@index@/: number of entry to read out
    -> m ((Bool, T.Text))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetStringIndex :: TagList -> Text -> Word32 -> m (Bool, Text)
tagListGetStringIndex TagList
list Text
tag Word32
index = IO (Bool, Text) -> m (Bool, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Text) -> m (Bool, Text))
-> IO (Bool, Text) -> m (Bool, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr CString
value <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    CInt
result <- Ptr TagList -> CString -> Word32 -> Ptr CString -> IO CInt
gst_tag_list_get_string_index Ptr TagList
list' CString
tag' Word32
index Ptr CString
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString
value' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
value
    Text
value'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
value'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
value
    (Bool, Text) -> IO (Bool, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Text
value'')

#if defined(ENABLE_OVERLOADING)
data TagListGetStringIndexMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ((Bool, T.Text))), MonadIO m) => O.MethodInfo TagListGetStringIndexMethodInfo TagList signature where
    overloadedMethod = tagListGetStringIndex

#endif

-- method TagList::get_tag_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a taglist" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the tag to query" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_tag_size" gst_tag_list_get_tag_size :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    IO Word32

-- | Checks how many value are stored in this tag list for the given tag.
tagListGetTagSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a taglist
    -> T.Text
    -- ^ /@tag@/: the tag to query
    -> m Word32
    -- ^ __Returns:__ The number of tags stored
tagListGetTagSize :: TagList -> Text -> m Word32
tagListGetTagSize TagList
list Text
tag = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Word32
result <- Ptr TagList -> CString -> IO Word32
gst_tag_list_get_tag_size Ptr TagList
list' CString
tag'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TagListGetTagSizeMethodInfo
instance (signature ~ (T.Text -> m Word32), MonadIO m) => O.MethodInfo TagListGetTagSizeMethodInfo TagList signature where
    overloadedMethod = tagListGetTagSize

#endif

-- method TagList::get_uint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_uint" gst_tag_list_get_uint :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Ptr Word32 ->                           -- value : TBasicType TUInt
    IO CInt

-- | Copies the contents for the given tag into the value, merging multiple values
-- into one if multiple values are associated with the tag.
tagListGetUint ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetUint :: TagList -> Text -> m (Bool, Word32)
tagListGetUint TagList
list Text
tag = IO (Bool, Word32) -> m (Bool, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr Word32
value <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr TagList -> CString -> Ptr Word32 -> IO CInt
gst_tag_list_get_uint Ptr TagList
list' CString
tag' Ptr Word32
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
value' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
value
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
value
    (Bool, Word32) -> IO (Bool, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
value')

#if defined(ENABLE_OVERLOADING)
data TagListGetUintMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Word32))), MonadIO m) => O.MethodInfo TagListGetUintMethodInfo TagList signature where
    overloadedMethod = tagListGetUint

#endif

-- method TagList::get_uint64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_uint64" gst_tag_list_get_uint64 :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Ptr Word64 ->                           -- value : TBasicType TUInt64
    IO CInt

-- | Copies the contents for the given tag into the value, merging multiple values
-- into one if multiple values are associated with the tag.
tagListGetUint64 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> m ((Bool, Word64))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetUint64 :: TagList -> Text -> m (Bool, Word64)
tagListGetUint64 TagList
list Text
tag = IO (Bool, Word64) -> m (Bool, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word64) -> m (Bool, Word64))
-> IO (Bool, Word64) -> m (Bool, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr Word64
value <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CInt
result <- Ptr TagList -> CString -> Ptr Word64 -> IO CInt
gst_tag_list_get_uint64 Ptr TagList
list' CString
tag' Ptr Word64
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word64
value' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
value
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
value
    (Bool, Word64) -> IO (Bool, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word64
value')

#if defined(ENABLE_OVERLOADING)
data TagListGetUint64MethodInfo
instance (signature ~ (T.Text -> m ((Bool, Word64))), MonadIO m) => O.MethodInfo TagListGetUint64MethodInfo TagList signature where
    overloadedMethod = tagListGetUint64

#endif

-- method TagList::get_uint64_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entry to read out"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_uint64_index" gst_tag_list_get_uint64_index :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Word32 ->                               -- index : TBasicType TUInt
    Ptr Word64 ->                           -- value : TBasicType TUInt64
    IO CInt

-- | Gets the value that is at the given index for the given tag in the given
-- list.
tagListGetUint64Index ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> Word32
    -- ^ /@index@/: number of entry to read out
    -> m ((Bool, Word64))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetUint64Index :: TagList -> Text -> Word32 -> m (Bool, Word64)
tagListGetUint64Index TagList
list Text
tag Word32
index = IO (Bool, Word64) -> m (Bool, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word64) -> m (Bool, Word64))
-> IO (Bool, Word64) -> m (Bool, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr Word64
value <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CInt
result <- Ptr TagList -> CString -> Word32 -> Ptr Word64 -> IO CInt
gst_tag_list_get_uint64_index Ptr TagList
list' CString
tag' Word32
index Ptr Word64
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word64
value' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
value
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
value
    (Bool, Word64) -> IO (Bool, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word64
value')

#if defined(ENABLE_OVERLOADING)
data TagListGetUint64IndexMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ((Bool, Word64))), MonadIO m) => O.MethodInfo TagListGetUint64IndexMethodInfo TagList signature where
    overloadedMethod = tagListGetUint64Index

#endif

-- method TagList::get_uint_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entry to read out"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_uint_index" gst_tag_list_get_uint_index :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Word32 ->                               -- index : TBasicType TUInt
    Ptr Word32 ->                           -- value : TBasicType TUInt
    IO CInt

-- | Gets the value that is at the given index for the given tag in the given
-- list.
tagListGetUintIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> Word32
    -- ^ /@index@/: number of entry to read out
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListGetUintIndex :: TagList -> Text -> Word32 -> m (Bool, Word32)
tagListGetUintIndex TagList
list Text
tag Word32
index = IO (Bool, Word32) -> m (Bool, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr Word32
value <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr TagList -> CString -> Word32 -> Ptr Word32 -> IO CInt
gst_tag_list_get_uint_index Ptr TagList
list' CString
tag' Word32
index Ptr Word32
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
value' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
value
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
value
    (Bool, Word32) -> IO (Bool, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
value')

#if defined(ENABLE_OVERLOADING)
data TagListGetUintIndexMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ((Bool, Word32))), MonadIO m) => O.MethodInfo TagListGetUintIndexMethodInfo TagList signature where
    overloadedMethod = tagListGetUintIndex

#endif

-- method TagList::get_value_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entry to read out"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TGValue
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_get_value_index" gst_tag_list_get_value_index :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Word32 ->                               -- index : TBasicType TUInt
    IO (Ptr GValue)

-- | Gets the value that is at the given index for the given tag in the given
-- list.
tagListGetValueIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList'
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> Word32
    -- ^ /@index@/: number of entry to read out
    -> m (Maybe GValue)
    -- ^ __Returns:__ The GValue for the specified
    --          entry or 'P.Nothing' if the tag wasn\'t available or the tag
    --          doesn\'t have as many entries
tagListGetValueIndex :: TagList -> Text -> Word32 -> m (Maybe GValue)
tagListGetValueIndex TagList
list Text
tag Word32
index = IO (Maybe GValue) -> m (Maybe GValue)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GValue) -> m (Maybe GValue))
-> IO (Maybe GValue) -> m (Maybe GValue)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr GValue
result <- Ptr TagList -> CString -> Word32 -> IO (Ptr GValue)
gst_tag_list_get_value_index Ptr TagList
list' CString
tag' Word32
index
    Maybe GValue
maybeResult <- Ptr GValue -> (Ptr GValue -> IO GValue) -> IO (Maybe GValue)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GValue
result ((Ptr GValue -> IO GValue) -> IO (Maybe GValue))
-> (Ptr GValue -> IO GValue) -> IO (Maybe GValue)
forall a b. (a -> b) -> a -> b
$ \Ptr GValue
result' -> do
        GValue
result'' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
result'
        GValue -> IO GValue
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
result''
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Maybe GValue -> IO (Maybe GValue)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GValue
maybeResult

#if defined(ENABLE_OVERLOADING)
data TagListGetValueIndexMethodInfo
instance (signature ~ (T.Text -> Word32 -> m (Maybe GValue)), MonadIO m) => O.MethodInfo TagListGetValueIndexMethodInfo TagList signature where
    overloadedMethod = tagListGetValueIndex

#endif

-- method TagList::insert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "into"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "list to merge into" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "from"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "list to merge from" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagMergeMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mode to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_insert" gst_tag_list_insert :: 
    Ptr TagList ->                          -- into : TInterface (Name {namespace = "Gst", name = "TagList"})
    Ptr TagList ->                          -- from : TInterface (Name {namespace = "Gst", name = "TagList"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gst", name = "TagMergeMode"})
    IO ()

-- | Inserts the tags of the /@from@/ list into the first list using the given mode.
tagListInsert ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@into@/: list to merge into
    -> TagList
    -- ^ /@from@/: list to merge from
    -> Gst.Enums.TagMergeMode
    -- ^ /@mode@/: the mode to use
    -> m ()
tagListInsert :: TagList -> TagList -> TagMergeMode -> m ()
tagListInsert TagList
into TagList
from TagMergeMode
mode = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
into' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
into
    Ptr TagList
from' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
from
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TagMergeMode -> Int) -> TagMergeMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagMergeMode -> Int
forall a. Enum a => a -> Int
fromEnum) TagMergeMode
mode
    Ptr TagList -> Ptr TagList -> CUInt -> IO ()
gst_tag_list_insert Ptr TagList
into' Ptr TagList
from' CUInt
mode'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
into
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
from
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TagListInsertMethodInfo
instance (signature ~ (TagList -> Gst.Enums.TagMergeMode -> m ()), MonadIO m) => O.MethodInfo TagListInsertMethodInfo TagList signature where
    overloadedMethod = tagListInsert

#endif

-- method TagList::is_empty
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTagList." , 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_tag_list_is_empty" gst_tag_list_is_empty :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    IO CInt

-- | Checks if the given taglist is empty.
tagListIsEmpty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: A t'GI.Gst.Structs.TagList.TagList'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the taglist is empty, otherwise 'P.False'.
tagListIsEmpty :: TagList -> m Bool
tagListIsEmpty TagList
list = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CInt
result <- Ptr TagList -> IO CInt
gst_tag_list_is_empty Ptr TagList
list'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TagListIsEmptyMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo TagListIsEmptyMethodInfo TagList signature where
    overloadedMethod = tagListIsEmpty

#endif

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

-- | Checks if the two given taglists are equal.
tagListIsEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list1@/: a t'GI.Gst.Structs.TagList.TagList'.
    -> TagList
    -- ^ /@list2@/: a t'GI.Gst.Structs.TagList.TagList'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the taglists are equal, otherwise 'P.False'
tagListIsEqual :: TagList -> TagList -> m Bool
tagListIsEqual TagList
list1 TagList
list2 = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list1' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list1
    Ptr TagList
list2' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list2
    CInt
result <- Ptr TagList -> Ptr TagList -> IO CInt
gst_tag_list_is_equal Ptr TagList
list1' Ptr TagList
list2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list1
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TagListIsEqualMethodInfo
instance (signature ~ (TagList -> m Bool), MonadIO m) => O.MethodInfo TagListIsEqualMethodInfo TagList signature where
    overloadedMethod = tagListIsEqual

#endif

-- method TagList::merge
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list1"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "first list to merge"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "list2"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "second list to merge"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagMergeMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mode to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "TagList" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_merge" gst_tag_list_merge :: 
    Ptr TagList ->                          -- list1 : TInterface (Name {namespace = "Gst", name = "TagList"})
    Ptr TagList ->                          -- list2 : TInterface (Name {namespace = "Gst", name = "TagList"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gst", name = "TagMergeMode"})
    IO (Ptr TagList)

-- | Merges the two given lists into a new list. If one of the lists is 'P.Nothing', a
-- copy of the other is returned. If both lists are 'P.Nothing', 'P.Nothing' is returned.
-- 
-- Free-function: gst_tag_list_unref
tagListMerge ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list1@/: first list to merge
    -> Maybe (TagList)
    -- ^ /@list2@/: second list to merge
    -> Gst.Enums.TagMergeMode
    -- ^ /@mode@/: the mode to use
    -> m (Maybe TagList)
    -- ^ __Returns:__ the new list
tagListMerge :: TagList -> Maybe TagList -> TagMergeMode -> m (Maybe TagList)
tagListMerge TagList
list1 Maybe TagList
list2 TagMergeMode
mode = IO (Maybe TagList) -> m (Maybe TagList)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TagList) -> m (Maybe TagList))
-> IO (Maybe TagList) -> m (Maybe TagList)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list1' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list1
    Ptr TagList
maybeList2 <- case Maybe TagList
list2 of
        Maybe TagList
Nothing -> Ptr TagList -> IO (Ptr TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
forall a. Ptr a
nullPtr
        Just TagList
jList2 -> do
            Ptr TagList
jList2' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
jList2
            Ptr TagList -> IO (Ptr TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
jList2'
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TagMergeMode -> Int) -> TagMergeMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagMergeMode -> Int
forall a. Enum a => a -> Int
fromEnum) TagMergeMode
mode
    Ptr TagList
result <- Ptr TagList -> Ptr TagList -> CUInt -> IO (Ptr TagList)
gst_tag_list_merge Ptr TagList
list1' Ptr TagList
maybeList2 CUInt
mode'
    Maybe TagList
maybeResult <- Ptr TagList -> (Ptr TagList -> IO TagList) -> IO (Maybe TagList)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TagList
result ((Ptr TagList -> IO TagList) -> IO (Maybe TagList))
-> (Ptr TagList -> IO TagList) -> IO (Maybe TagList)
forall a b. (a -> b) -> a -> b
$ \Ptr TagList
result' -> do
        TagList
result'' <- ((ManagedPtr TagList -> TagList) -> Ptr TagList -> IO TagList
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TagList -> TagList
TagList) Ptr TagList
result'
        TagList -> IO TagList
forall (m :: * -> *) a. Monad m => a -> m a
return TagList
result''
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list1
    Maybe TagList -> (TagList -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe TagList
list2 TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe TagList -> IO (Maybe TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TagList
maybeResult

#if defined(ENABLE_OVERLOADING)
data TagListMergeMethodInfo
instance (signature ~ (Maybe (TagList) -> Gst.Enums.TagMergeMode -> m (Maybe TagList)), MonadIO m) => O.MethodInfo TagListMergeMethodInfo TagList signature where
    overloadedMethod = tagListMerge

#endif

-- method TagList::n_tags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTagList." , 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_tag_list_n_tags" gst_tag_list_n_tags :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    IO Int32

-- | Get the number of tags in /@list@/.
tagListNTags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: A t'GI.Gst.Structs.TagList.TagList'.
    -> m Int32
    -- ^ __Returns:__ The number of tags in /@list@/.
tagListNTags :: TagList -> m Int32
tagListNTags TagList
list = 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 TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    Int32
result <- Ptr TagList -> IO Int32
gst_tag_list_n_tags Ptr TagList
list'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TagListNTagsMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo TagListNTagsMethodInfo TagList signature where
    overloadedMethod = tagListNTags

#endif

-- method TagList::nth_tag_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTagList." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_nth_tag_name" gst_tag_list_nth_tag_name :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    Word32 ->                               -- index : TBasicType TUInt
    IO CString

-- | Get the name of the tag in /@list@/ at /@index@/.
tagListNthTagName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: A t'GI.Gst.Structs.TagList.TagList'.
    -> Word32
    -- ^ /@index@/: the index
    -> m T.Text
    -- ^ __Returns:__ The name of the tag at /@index@/.
tagListNthTagName :: TagList -> Word32 -> m Text
tagListNthTagName TagList
list Word32
index = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
result <- Ptr TagList -> Word32 -> IO CString
gst_tag_list_nth_tag_name Ptr TagList
list' Word32
index
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tagListNthTagName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data TagListNthTagNameMethodInfo
instance (signature ~ (Word32 -> m T.Text), MonadIO m) => O.MethodInfo TagListNthTagNameMethodInfo TagList signature where
    overloadedMethod = tagListNthTagName

#endif

-- method TagList::peek_string_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entry to read out"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the result"
--                 , 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_tag_list_peek_string_index" gst_tag_list_peek_string_index :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    Word32 ->                               -- index : TBasicType TUInt
    Ptr CString ->                          -- value : TBasicType TUTF8
    IO CInt

-- | Peeks at the value that is at the given index for the given tag in the given
-- list.
-- 
-- The resulting string in /@value@/ will be in UTF-8 encoding and doesn\'t need
-- to be freed by the caller. The returned string is also guaranteed to
-- be non-'P.Nothing' and non-empty.
tagListPeekStringIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList' to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> Word32
    -- ^ /@index@/: number of entry to read out
    -> m ((Bool, T.Text))
    -- ^ __Returns:__ 'P.True', if a value was set, 'P.False' if the tag didn\'t exist in the
    --              given list.
tagListPeekStringIndex :: TagList -> Text -> Word32 -> m (Bool, Text)
tagListPeekStringIndex TagList
list Text
tag Word32
index = IO (Bool, Text) -> m (Bool, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Text) -> m (Bool, Text))
-> IO (Bool, Text) -> m (Bool, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr CString
value <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    CInt
result <- Ptr TagList -> CString -> Word32 -> Ptr CString -> IO CInt
gst_tag_list_peek_string_index Ptr TagList
list' CString
tag' Word32
index Ptr CString
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString
value' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
value
    Text
value'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
value'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
value
    (Bool, Text) -> IO (Bool, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Text
value'')

#if defined(ENABLE_OVERLOADING)
data TagListPeekStringIndexMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ((Bool, T.Text))), MonadIO m) => O.MethodInfo TagListPeekStringIndexMethodInfo TagList signature where
    overloadedMethod = tagListPeekStringIndex

#endif

-- method TagList::remove_tag
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "list to remove tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to remove" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_remove_tag" gst_tag_list_remove_tag :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    IO ()

-- | Removes the given tag from the taglist.
tagListRemoveTag ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: list to remove tag from
    -> T.Text
    -- ^ /@tag@/: tag to remove
    -> m ()
tagListRemoveTag :: TagList -> Text -> m ()
tagListRemoveTag TagList
list Text
tag = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    Ptr TagList -> CString -> IO ()
gst_tag_list_remove_tag Ptr TagList
list' CString
tag'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TagListRemoveTagMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.MethodInfo TagListRemoveTagMethodInfo TagList signature where
    overloadedMethod = tagListRemoveTag

#endif

-- method TagList::set_scope
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scope"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagScope" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new scope for @list"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_tag_list_set_scope" gst_tag_list_set_scope :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CUInt ->                                -- scope : TInterface (Name {namespace = "Gst", name = "TagScope"})
    IO ()

-- | Sets the scope of /@list@/ to /@scope@/. By default the scope
-- of a taglist is stream scope.
tagListSetScope ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList'
    -> Gst.Enums.TagScope
    -- ^ /@scope@/: new scope for /@list@/
    -> m ()
tagListSetScope :: TagList -> TagScope -> m ()
tagListSetScope TagList
list TagScope
scope = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    let scope' :: CUInt
scope' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TagScope -> Int) -> TagScope -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagScope -> Int
forall a. Enum a => a -> Int
fromEnum) TagScope
scope
    Ptr TagList -> CUInt -> IO ()
gst_tag_list_set_scope Ptr TagList
list' CUInt
scope'
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TagListSetScopeMethodInfo
instance (signature ~ (Gst.Enums.TagScope -> m ()), MonadIO m) => O.MethodInfo TagListSetScopeMethodInfo TagList signature where
    overloadedMethod = tagListSetScope

#endif

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

foreign import ccall "gst_tag_list_to_string" gst_tag_list_to_string :: 
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    IO CString

-- | Serializes a tag list to a string.
tagListToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: a t'GI.Gst.Structs.TagList.TagList'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a newly-allocated string, or 'P.Nothing' in case of
    --     an error. The string must be freed with 'GI.GLib.Functions.free' when no longer
    --     needed.
tagListToString :: TagList -> m (Maybe Text)
tagListToString TagList
list = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
result <- Ptr TagList -> IO CString
gst_tag_list_to_string Ptr TagList
list'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data TagListToStringMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.MethodInfo TagListToStringMethodInfo TagList signature where
    overloadedMethod = tagListToString

#endif

-- method TagList::copy_value
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "dest"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "uninitialized #GValue to copy into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "list to get the tag from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag to read out" , 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_tag_list_copy_value" gst_tag_list_copy_value :: 
    Ptr GValue ->                           -- dest : TGValue
    Ptr TagList ->                          -- list : TInterface (Name {namespace = "Gst", name = "TagList"})
    CString ->                              -- tag : TBasicType TUTF8
    IO CInt

-- | Copies the contents for the given tag into the value,
-- merging multiple values into one if multiple values are associated
-- with the tag.
-- You must 'GI.GObject.Structs.Value.valueUnset' the value after use.
tagListCopyValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TagList
    -- ^ /@list@/: list to get the tag from
    -> T.Text
    -- ^ /@tag@/: tag to read out
    -> m ((Bool, GValue))
    -- ^ __Returns:__ 'P.True', if a value was copied, 'P.False' if the tag didn\'t exist in the
    --          given list.
tagListCopyValue :: TagList -> Text -> m (Bool, GValue)
tagListCopyValue TagList
list Text
tag = IO (Bool, GValue) -> m (Bool, GValue)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, GValue) -> m (Bool, GValue))
-> IO (Bool, GValue) -> m (Bool, GValue)
forall a b. (a -> b) -> a -> b
$ do
    Ptr GValue
dest <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    Ptr TagList
list' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
list
    CString
tag' <- Text -> IO CString
textToCString Text
tag
    CInt
result <- Ptr GValue -> Ptr TagList -> CString -> IO CInt
gst_tag_list_copy_value Ptr GValue
dest Ptr TagList
list' CString
tag'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    GValue
dest' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
dest
    Ptr GValue -> IO ()
B.GValue.unsetGValue Ptr GValue
dest
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tag'
    (Bool, GValue) -> IO (Bool, GValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', GValue
dest')

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTagListMethod (t :: Symbol) (o :: *) :: * where
    ResolveTagListMethod "addValue" o = TagListAddValueMethodInfo
    ResolveTagListMethod "foreach" o = TagListForeachMethodInfo
    ResolveTagListMethod "insert" o = TagListInsertMethodInfo
    ResolveTagListMethod "isEmpty" o = TagListIsEmptyMethodInfo
    ResolveTagListMethod "isEqual" o = TagListIsEqualMethodInfo
    ResolveTagListMethod "merge" o = TagListMergeMethodInfo
    ResolveTagListMethod "nTags" o = TagListNTagsMethodInfo
    ResolveTagListMethod "nthTagName" o = TagListNthTagNameMethodInfo
    ResolveTagListMethod "peekStringIndex" o = TagListPeekStringIndexMethodInfo
    ResolveTagListMethod "removeTag" o = TagListRemoveTagMethodInfo
    ResolveTagListMethod "toString" o = TagListToStringMethodInfo
    ResolveTagListMethod "getBoolean" o = TagListGetBooleanMethodInfo
    ResolveTagListMethod "getBooleanIndex" o = TagListGetBooleanIndexMethodInfo
    ResolveTagListMethod "getDate" o = TagListGetDateMethodInfo
    ResolveTagListMethod "getDateIndex" o = TagListGetDateIndexMethodInfo
    ResolveTagListMethod "getDateTime" o = TagListGetDateTimeMethodInfo
    ResolveTagListMethod "getDateTimeIndex" o = TagListGetDateTimeIndexMethodInfo
    ResolveTagListMethod "getDouble" o = TagListGetDoubleMethodInfo
    ResolveTagListMethod "getDoubleIndex" o = TagListGetDoubleIndexMethodInfo
    ResolveTagListMethod "getFloat" o = TagListGetFloatMethodInfo
    ResolveTagListMethod "getFloatIndex" o = TagListGetFloatIndexMethodInfo
    ResolveTagListMethod "getInt" o = TagListGetIntMethodInfo
    ResolveTagListMethod "getInt64" o = TagListGetInt64MethodInfo
    ResolveTagListMethod "getInt64Index" o = TagListGetInt64IndexMethodInfo
    ResolveTagListMethod "getIntIndex" o = TagListGetIntIndexMethodInfo
    ResolveTagListMethod "getPointer" o = TagListGetPointerMethodInfo
    ResolveTagListMethod "getPointerIndex" o = TagListGetPointerIndexMethodInfo
    ResolveTagListMethod "getSample" o = TagListGetSampleMethodInfo
    ResolveTagListMethod "getSampleIndex" o = TagListGetSampleIndexMethodInfo
    ResolveTagListMethod "getScope" o = TagListGetScopeMethodInfo
    ResolveTagListMethod "getString" o = TagListGetStringMethodInfo
    ResolveTagListMethod "getStringIndex" o = TagListGetStringIndexMethodInfo
    ResolveTagListMethod "getTagSize" o = TagListGetTagSizeMethodInfo
    ResolveTagListMethod "getUint" o = TagListGetUintMethodInfo
    ResolveTagListMethod "getUint64" o = TagListGetUint64MethodInfo
    ResolveTagListMethod "getUint64Index" o = TagListGetUint64IndexMethodInfo
    ResolveTagListMethod "getUintIndex" o = TagListGetUintIndexMethodInfo
    ResolveTagListMethod "getValueIndex" o = TagListGetValueIndexMethodInfo
    ResolveTagListMethod "setScope" o = TagListSetScopeMethodInfo
    ResolveTagListMethod l o = O.MethodResolutionFailed l o

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

#endif