{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.GObject.Objects.Object.Object' that implements t'GI.GES.Interfaces.MetaContainer.MetaContainer' can have metadata set on
-- it, that is data that is unimportant to its function within GES, but
-- may hold some useful information. In particular,
-- 'GI.GES.Interfaces.MetaContainer.metaContainerSetMeta' can be used to store any t'GI.GObject.Structs.Value.Value' under
-- any generic field (specified by a string key). The same method can also
-- be used to remove the field by passing 'P.Nothing'. A number of convenience
-- methods are also provided to make it easier to set common value types.
-- The metadata can then be read with 'GI.GES.Interfaces.MetaContainer.metaContainerGetMeta' and
-- similar convenience methods.
-- 
-- == Registered Fields
-- 
-- By default, any t'GI.GObject.Structs.Value.Value' can be set for a metadata field. However, you
-- can register some fields as static, that is they only allow values of a
-- specific type to be set under them, using
-- 'GI.GES.Interfaces.MetaContainer.metaContainerRegisterMeta' or
-- 'GI.GES.Interfaces.MetaContainer.metaContainerRegisterStaticMeta'. The set t'GI.GES.Flags.MetaFlag' will
-- determine whether the value can be changed, but even if it can be
-- changed, it must be changed to a value of the same type.
-- 
-- Internally, some GES objects will be initialized with static metadata
-- fields. These will correspond to some standard keys, such as
-- 'GI.GES.Constants.META_VOLUME'.

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

module GI.GES.Interfaces.MetaContainer
    ( 

-- * Exported types
    MetaContainer(..)                       ,
    IsMetaContainer                         ,
    toMetaContainer                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addMetasFromString]("GI.GES.Interfaces.MetaContainer#g:method:addMetasFromString"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [checkMetaRegistered]("GI.GES.Interfaces.MetaContainer#g:method:checkMetaRegistered"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [foreach]("GI.GES.Interfaces.MetaContainer#g:method:foreach"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [metasToString]("GI.GES.Interfaces.MetaContainer#g:method:metasToString"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [registerMeta]("GI.GES.Interfaces.MetaContainer#g:method:registerMeta"), [registerMetaBoolean]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaBoolean"), [registerMetaDate]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaDate"), [registerMetaDateTime]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaDateTime"), [registerMetaDouble]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaDouble"), [registerMetaFloat]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaFloat"), [registerMetaInt]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaInt"), [registerMetaInt64]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaInt64"), [registerMetaString]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaString"), [registerMetaUint]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaUint"), [registerMetaUint64]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaUint64"), [registerStaticMeta]("GI.GES.Interfaces.MetaContainer#g:method:registerStaticMeta"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getBoolean]("GI.GES.Interfaces.MetaContainer#g:method:getBoolean"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDate]("GI.GES.Interfaces.MetaContainer#g:method:getDate"), [getDateTime]("GI.GES.Interfaces.MetaContainer#g:method:getDateTime"), [getDouble]("GI.GES.Interfaces.MetaContainer#g:method:getDouble"), [getFloat]("GI.GES.Interfaces.MetaContainer#g:method:getFloat"), [getInt]("GI.GES.Interfaces.MetaContainer#g:method:getInt"), [getInt64]("GI.GES.Interfaces.MetaContainer#g:method:getInt64"), [getMarkerList]("GI.GES.Interfaces.MetaContainer#g:method:getMarkerList"), [getMeta]("GI.GES.Interfaces.MetaContainer#g:method:getMeta"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getString]("GI.GES.Interfaces.MetaContainer#g:method:getString"), [getUint]("GI.GES.Interfaces.MetaContainer#g:method:getUint"), [getUint64]("GI.GES.Interfaces.MetaContainer#g:method:getUint64").
-- 
-- ==== Setters
-- [setBoolean]("GI.GES.Interfaces.MetaContainer#g:method:setBoolean"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDate]("GI.GES.Interfaces.MetaContainer#g:method:setDate"), [setDateTime]("GI.GES.Interfaces.MetaContainer#g:method:setDateTime"), [setDouble]("GI.GES.Interfaces.MetaContainer#g:method:setDouble"), [setFloat]("GI.GES.Interfaces.MetaContainer#g:method:setFloat"), [setInt]("GI.GES.Interfaces.MetaContainer#g:method:setInt"), [setInt64]("GI.GES.Interfaces.MetaContainer#g:method:setInt64"), [setMarkerList]("GI.GES.Interfaces.MetaContainer#g:method:setMarkerList"), [setMeta]("GI.GES.Interfaces.MetaContainer#g:method:setMeta"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setString]("GI.GES.Interfaces.MetaContainer#g:method:setString"), [setUint]("GI.GES.Interfaces.MetaContainer#g:method:setUint"), [setUint64]("GI.GES.Interfaces.MetaContainer#g:method:setUint64").

#if defined(ENABLE_OVERLOADING)
    ResolveMetaContainerMethod              ,
#endif

-- ** addMetasFromString #method:addMetasFromString#

#if defined(ENABLE_OVERLOADING)
    MetaContainerAddMetasFromStringMethodInfo,
#endif
    metaContainerAddMetasFromString         ,


-- ** checkMetaRegistered #method:checkMetaRegistered#

#if defined(ENABLE_OVERLOADING)
    MetaContainerCheckMetaRegisteredMethodInfo,
#endif
    metaContainerCheckMetaRegistered        ,


-- ** foreach #method:foreach#

#if defined(ENABLE_OVERLOADING)
    MetaContainerForeachMethodInfo          ,
#endif
    metaContainerForeach                    ,


-- ** getBoolean #method:getBoolean#

#if defined(ENABLE_OVERLOADING)
    MetaContainerGetBooleanMethodInfo       ,
#endif
    metaContainerGetBoolean                 ,


-- ** getDate #method:getDate#

#if defined(ENABLE_OVERLOADING)
    MetaContainerGetDateMethodInfo          ,
#endif
    metaContainerGetDate                    ,


-- ** getDateTime #method:getDateTime#

#if defined(ENABLE_OVERLOADING)
    MetaContainerGetDateTimeMethodInfo      ,
#endif
    metaContainerGetDateTime                ,


-- ** getDouble #method:getDouble#

#if defined(ENABLE_OVERLOADING)
    MetaContainerGetDoubleMethodInfo        ,
#endif
    metaContainerGetDouble                  ,


-- ** getFloat #method:getFloat#

#if defined(ENABLE_OVERLOADING)
    MetaContainerGetFloatMethodInfo         ,
#endif
    metaContainerGetFloat                   ,


-- ** getInt #method:getInt#

#if defined(ENABLE_OVERLOADING)
    MetaContainerGetIntMethodInfo           ,
#endif
    metaContainerGetInt                     ,


-- ** getInt64 #method:getInt64#

#if defined(ENABLE_OVERLOADING)
    MetaContainerGetInt64MethodInfo         ,
#endif
    metaContainerGetInt64                   ,


-- ** getMarkerList #method:getMarkerList#

#if defined(ENABLE_OVERLOADING)
    MetaContainerGetMarkerListMethodInfo    ,
#endif
    metaContainerGetMarkerList              ,


-- ** getMeta #method:getMeta#

#if defined(ENABLE_OVERLOADING)
    MetaContainerGetMetaMethodInfo          ,
#endif
    metaContainerGetMeta                    ,


-- ** getString #method:getString#

#if defined(ENABLE_OVERLOADING)
    MetaContainerGetStringMethodInfo        ,
#endif
    metaContainerGetString                  ,


-- ** getUint #method:getUint#

#if defined(ENABLE_OVERLOADING)
    MetaContainerGetUintMethodInfo          ,
#endif
    metaContainerGetUint                    ,


-- ** getUint64 #method:getUint64#

#if defined(ENABLE_OVERLOADING)
    MetaContainerGetUint64MethodInfo        ,
#endif
    metaContainerGetUint64                  ,


-- ** metasToString #method:metasToString#

#if defined(ENABLE_OVERLOADING)
    MetaContainerMetasToStringMethodInfo    ,
#endif
    metaContainerMetasToString              ,


-- ** registerMeta #method:registerMeta#

#if defined(ENABLE_OVERLOADING)
    MetaContainerRegisterMetaMethodInfo     ,
#endif
    metaContainerRegisterMeta               ,


-- ** registerMetaBoolean #method:registerMetaBoolean#

#if defined(ENABLE_OVERLOADING)
    MetaContainerRegisterMetaBooleanMethodInfo,
#endif
    metaContainerRegisterMetaBoolean        ,


-- ** registerMetaDate #method:registerMetaDate#

#if defined(ENABLE_OVERLOADING)
    MetaContainerRegisterMetaDateMethodInfo ,
#endif
    metaContainerRegisterMetaDate           ,


-- ** registerMetaDateTime #method:registerMetaDateTime#

#if defined(ENABLE_OVERLOADING)
    MetaContainerRegisterMetaDateTimeMethodInfo,
#endif
    metaContainerRegisterMetaDateTime       ,


-- ** registerMetaDouble #method:registerMetaDouble#

#if defined(ENABLE_OVERLOADING)
    MetaContainerRegisterMetaDoubleMethodInfo,
#endif
    metaContainerRegisterMetaDouble         ,


-- ** registerMetaFloat #method:registerMetaFloat#

#if defined(ENABLE_OVERLOADING)
    MetaContainerRegisterMetaFloatMethodInfo,
#endif
    metaContainerRegisterMetaFloat          ,


-- ** registerMetaInt #method:registerMetaInt#

#if defined(ENABLE_OVERLOADING)
    MetaContainerRegisterMetaIntMethodInfo  ,
#endif
    metaContainerRegisterMetaInt            ,


-- ** registerMetaInt64 #method:registerMetaInt64#

#if defined(ENABLE_OVERLOADING)
    MetaContainerRegisterMetaInt64MethodInfo,
#endif
    metaContainerRegisterMetaInt64          ,


-- ** registerMetaString #method:registerMetaString#

#if defined(ENABLE_OVERLOADING)
    MetaContainerRegisterMetaStringMethodInfo,
#endif
    metaContainerRegisterMetaString         ,


-- ** registerMetaUint #method:registerMetaUint#

#if defined(ENABLE_OVERLOADING)
    MetaContainerRegisterMetaUintMethodInfo ,
#endif
    metaContainerRegisterMetaUint           ,


-- ** registerMetaUint64 #method:registerMetaUint64#

#if defined(ENABLE_OVERLOADING)
    MetaContainerRegisterMetaUint64MethodInfo,
#endif
    metaContainerRegisterMetaUint64         ,


-- ** registerStaticMeta #method:registerStaticMeta#

#if defined(ENABLE_OVERLOADING)
    MetaContainerRegisterStaticMetaMethodInfo,
#endif
    metaContainerRegisterStaticMeta         ,


-- ** setBoolean #method:setBoolean#

#if defined(ENABLE_OVERLOADING)
    MetaContainerSetBooleanMethodInfo       ,
#endif
    metaContainerSetBoolean                 ,


-- ** setDate #method:setDate#

#if defined(ENABLE_OVERLOADING)
    MetaContainerSetDateMethodInfo          ,
#endif
    metaContainerSetDate                    ,


-- ** setDateTime #method:setDateTime#

#if defined(ENABLE_OVERLOADING)
    MetaContainerSetDateTimeMethodInfo      ,
#endif
    metaContainerSetDateTime                ,


-- ** setDouble #method:setDouble#

#if defined(ENABLE_OVERLOADING)
    MetaContainerSetDoubleMethodInfo        ,
#endif
    metaContainerSetDouble                  ,


-- ** setFloat #method:setFloat#

#if defined(ENABLE_OVERLOADING)
    MetaContainerSetFloatMethodInfo         ,
#endif
    metaContainerSetFloat                   ,


-- ** setInt #method:setInt#

#if defined(ENABLE_OVERLOADING)
    MetaContainerSetIntMethodInfo           ,
#endif
    metaContainerSetInt                     ,


-- ** setInt64 #method:setInt64#

#if defined(ENABLE_OVERLOADING)
    MetaContainerSetInt64MethodInfo         ,
#endif
    metaContainerSetInt64                   ,


-- ** setMarkerList #method:setMarkerList#

#if defined(ENABLE_OVERLOADING)
    MetaContainerSetMarkerListMethodInfo    ,
#endif
    metaContainerSetMarkerList              ,


-- ** setMeta #method:setMeta#

#if defined(ENABLE_OVERLOADING)
    MetaContainerSetMetaMethodInfo          ,
#endif
    metaContainerSetMeta                    ,


-- ** setString #method:setString#

#if defined(ENABLE_OVERLOADING)
    MetaContainerSetStringMethodInfo        ,
#endif
    metaContainerSetString                  ,


-- ** setUint #method:setUint#

#if defined(ENABLE_OVERLOADING)
    MetaContainerSetUintMethodInfo          ,
#endif
    metaContainerSetUint                    ,


-- ** setUint64 #method:setUint64#

#if defined(ENABLE_OVERLOADING)
    MetaContainerSetUint64MethodInfo        ,
#endif
    metaContainerSetUint64                  ,




 -- * Signals


-- ** notifyMeta #signal:notifyMeta#

    MetaContainerNotifyMetaCallback         ,
#if defined(ENABLE_OVERLOADING)
    MetaContainerNotifyMetaSignalInfo       ,
#endif
    afterMetaContainerNotifyMeta            ,
    onMetaContainerNotifyMeta               ,




    ) where

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

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

import qualified GI.GES.Callbacks as GES.Callbacks
import {-# SOURCE #-} qualified GI.GES.Flags as GES.Flags
import {-# SOURCE #-} qualified GI.GES.Objects.MarkerList as GES.MarkerList
import qualified GI.GLib.Structs.Date as GLib.Date
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gst.Structs.DateTime as Gst.DateTime

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

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

foreign import ccall "ges_meta_container_get_type"
    c_ges_meta_container_get_type :: IO B.Types.GType

instance B.Types.TypedObject MetaContainer where
    glibType :: IO GType
glibType = IO GType
c_ges_meta_container_get_type

instance B.Types.GObject MetaContainer

-- | Type class for types which can be safely cast to `MetaContainer`, for instance with `toMetaContainer`.
class (SP.GObject o, O.IsDescendantOf MetaContainer o) => IsMetaContainer o
instance (SP.GObject o, O.IsDescendantOf MetaContainer o) => IsMetaContainer o

instance O.HasParentTypes MetaContainer
type instance O.ParentTypes MetaContainer = '[GObject.Object.Object]

-- | Cast to `MetaContainer`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toMetaContainer :: (MIO.MonadIO m, IsMetaContainer o) => o -> m MetaContainer
toMetaContainer :: forall (m :: * -> *) o.
(MonadIO m, IsMetaContainer o) =>
o -> m MetaContainer
toMetaContainer = IO MetaContainer -> m MetaContainer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO MetaContainer -> m MetaContainer)
-> (o -> IO MetaContainer) -> o -> m MetaContainer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr MetaContainer -> MetaContainer)
-> o -> IO MetaContainer
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr MetaContainer -> MetaContainer
MetaContainer

-- | Convert 'MetaContainer' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe MetaContainer) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ges_meta_container_get_type
    gvalueSet_ :: Ptr GValue -> Maybe MetaContainer -> IO ()
gvalueSet_ Ptr GValue
gv Maybe MetaContainer
P.Nothing = Ptr GValue -> Ptr MetaContainer -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr MetaContainer
forall a. Ptr a
FP.nullPtr :: FP.Ptr MetaContainer)
    gvalueSet_ Ptr GValue
gv (P.Just MetaContainer
obj) = MetaContainer -> (Ptr MetaContainer -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr MetaContainer
obj (Ptr GValue -> Ptr MetaContainer -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe MetaContainer)
gvalueGet_ Ptr GValue
gv = do
        Ptr MetaContainer
ptr <- Ptr GValue -> IO (Ptr MetaContainer)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr MetaContainer)
        if Ptr MetaContainer
ptr Ptr MetaContainer -> Ptr MetaContainer -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr MetaContainer
forall a. Ptr a
FP.nullPtr
        then MetaContainer -> Maybe MetaContainer
forall a. a -> Maybe a
P.Just (MetaContainer -> Maybe MetaContainer)
-> IO MetaContainer -> IO (Maybe MetaContainer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr MetaContainer -> MetaContainer)
-> Ptr MetaContainer -> IO MetaContainer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr MetaContainer -> MetaContainer
MetaContainer Ptr MetaContainer
ptr
        else Maybe MetaContainer -> IO (Maybe MetaContainer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MetaContainer
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MetaContainer
type instance O.AttributeList MetaContainer = MetaContainerAttributeList
type MetaContainerAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMetaContainerMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveMetaContainerMethod "addMetasFromString" o = MetaContainerAddMetasFromStringMethodInfo
    ResolveMetaContainerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMetaContainerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMetaContainerMethod "checkMetaRegistered" o = MetaContainerCheckMetaRegisteredMethodInfo
    ResolveMetaContainerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMetaContainerMethod "foreach" o = MetaContainerForeachMethodInfo
    ResolveMetaContainerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMetaContainerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMetaContainerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMetaContainerMethod "metasToString" o = MetaContainerMetasToStringMethodInfo
    ResolveMetaContainerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMetaContainerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMetaContainerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMetaContainerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMetaContainerMethod "registerMeta" o = MetaContainerRegisterMetaMethodInfo
    ResolveMetaContainerMethod "registerMetaBoolean" o = MetaContainerRegisterMetaBooleanMethodInfo
    ResolveMetaContainerMethod "registerMetaDate" o = MetaContainerRegisterMetaDateMethodInfo
    ResolveMetaContainerMethod "registerMetaDateTime" o = MetaContainerRegisterMetaDateTimeMethodInfo
    ResolveMetaContainerMethod "registerMetaDouble" o = MetaContainerRegisterMetaDoubleMethodInfo
    ResolveMetaContainerMethod "registerMetaFloat" o = MetaContainerRegisterMetaFloatMethodInfo
    ResolveMetaContainerMethod "registerMetaInt" o = MetaContainerRegisterMetaIntMethodInfo
    ResolveMetaContainerMethod "registerMetaInt64" o = MetaContainerRegisterMetaInt64MethodInfo
    ResolveMetaContainerMethod "registerMetaString" o = MetaContainerRegisterMetaStringMethodInfo
    ResolveMetaContainerMethod "registerMetaUint" o = MetaContainerRegisterMetaUintMethodInfo
    ResolveMetaContainerMethod "registerMetaUint64" o = MetaContainerRegisterMetaUint64MethodInfo
    ResolveMetaContainerMethod "registerStaticMeta" o = MetaContainerRegisterStaticMetaMethodInfo
    ResolveMetaContainerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMetaContainerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMetaContainerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMetaContainerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMetaContainerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMetaContainerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMetaContainerMethod "getBoolean" o = MetaContainerGetBooleanMethodInfo
    ResolveMetaContainerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMetaContainerMethod "getDate" o = MetaContainerGetDateMethodInfo
    ResolveMetaContainerMethod "getDateTime" o = MetaContainerGetDateTimeMethodInfo
    ResolveMetaContainerMethod "getDouble" o = MetaContainerGetDoubleMethodInfo
    ResolveMetaContainerMethod "getFloat" o = MetaContainerGetFloatMethodInfo
    ResolveMetaContainerMethod "getInt" o = MetaContainerGetIntMethodInfo
    ResolveMetaContainerMethod "getInt64" o = MetaContainerGetInt64MethodInfo
    ResolveMetaContainerMethod "getMarkerList" o = MetaContainerGetMarkerListMethodInfo
    ResolveMetaContainerMethod "getMeta" o = MetaContainerGetMetaMethodInfo
    ResolveMetaContainerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMetaContainerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMetaContainerMethod "getString" o = MetaContainerGetStringMethodInfo
    ResolveMetaContainerMethod "getUint" o = MetaContainerGetUintMethodInfo
    ResolveMetaContainerMethod "getUint64" o = MetaContainerGetUint64MethodInfo
    ResolveMetaContainerMethod "setBoolean" o = MetaContainerSetBooleanMethodInfo
    ResolveMetaContainerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMetaContainerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMetaContainerMethod "setDate" o = MetaContainerSetDateMethodInfo
    ResolveMetaContainerMethod "setDateTime" o = MetaContainerSetDateTimeMethodInfo
    ResolveMetaContainerMethod "setDouble" o = MetaContainerSetDoubleMethodInfo
    ResolveMetaContainerMethod "setFloat" o = MetaContainerSetFloatMethodInfo
    ResolveMetaContainerMethod "setInt" o = MetaContainerSetIntMethodInfo
    ResolveMetaContainerMethod "setInt64" o = MetaContainerSetInt64MethodInfo
    ResolveMetaContainerMethod "setMarkerList" o = MetaContainerSetMarkerListMethodInfo
    ResolveMetaContainerMethod "setMeta" o = MetaContainerSetMetaMethodInfo
    ResolveMetaContainerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMetaContainerMethod "setString" o = MetaContainerSetStringMethodInfo
    ResolveMetaContainerMethod "setUint" o = MetaContainerSetUintMethodInfo
    ResolveMetaContainerMethod "setUint64" o = MetaContainerSetUint64MethodInfo
    ResolveMetaContainerMethod l o = O.MethodResolutionFailed l o

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

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

#endif

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

#endif

-- method MetaContainer::add_metas_from_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A string to deserialize and add to @container"
--                 , 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 "ges_meta_container_add_metas_from_string" ges_meta_container_add_metas_from_string :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- str : TBasicType TUTF8
    IO CInt

-- | Deserializes the given string, and adds and sets the found fields and
-- their values on the container. The string should be the return of
-- 'GI.GES.Interfaces.MetaContainer.metaContainerMetasToString'.
metaContainerAddMetasFromString ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@str@/: A string to deserialize and add to /@container@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the fields in /@str@/ was successfully deserialized
    -- and added to /@container@/.
metaContainerAddMetasFromString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> m Bool
metaContainerAddMetasFromString a
container Text
str = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
str' <- Text -> IO CString
textToCString Text
str
    CInt
result <- Ptr MetaContainer -> CString -> IO CInt
ges_meta_container_add_metas_from_string Ptr MetaContainer
container' CString
str'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerAddMetasFromStringMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerAddMetasFromStringMethodInfo a signature where
    overloadedMethod = metaContainerAddMetasFromString

instance O.OverloadedMethodInfo MetaContainerAddMetasFromStringMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerAddMetasFromString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerAddMetasFromString"
        })


#endif

-- method MetaContainer::check_meta_registered
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to check"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaFlag" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A destination to get the registered flags of\nthe field, or %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A destination to get the registered type of\nthe field, or %NULL to ignore"
--                 , 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 "ges_meta_container_check_meta_registered" ges_meta_container_check_meta_registered :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr CUInt ->                            -- flags : TInterface (Name {namespace = "GES", name = "MetaFlag"})
    Ptr CGType ->                           -- type : TBasicType TGType
    IO CInt

-- | Checks whether the specified field has been registered as static, and
-- gets the registered type and flags of the field, as used in
-- 'GI.GES.Interfaces.MetaContainer.metaContainerRegisterMeta' and
-- 'GI.GES.Interfaces.MetaContainer.metaContainerRegisterStaticMeta'.
metaContainerCheckMetaRegistered ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to check
    -> m ((Bool, [GES.Flags.MetaFlag], GType))
    -- ^ __Returns:__ 'P.True' if the /@metaItem@/ field has been registered on
    -- /@container@/.
metaContainerCheckMetaRegistered :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> m (Bool, [MetaFlag], GType)
metaContainerCheckMetaRegistered a
container Text
metaItem = IO (Bool, [MetaFlag], GType) -> m (Bool, [MetaFlag], GType)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, [MetaFlag], GType) -> m (Bool, [MetaFlag], GType))
-> IO (Bool, [MetaFlag], GType) -> m (Bool, [MetaFlag], GType)
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr CUInt
flags <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr CGType
type_ <- IO (Ptr CGType)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CGType)
    CInt
result <- Ptr MetaContainer -> CString -> Ptr CUInt -> Ptr CGType -> IO CInt
ges_meta_container_check_meta_registered Ptr MetaContainer
container' CString
metaItem' Ptr CUInt
flags Ptr CGType
type_
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CUInt
flags' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
flags
    let flags'' :: [MetaFlag]
flags'' = CUInt -> [MetaFlag]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
flags'
    CGType
type_' <- Ptr CGType -> IO CGType
forall a. Storable a => Ptr a -> IO a
peek Ptr CGType
type_
    let type_'' :: GType
type_'' = CGType -> GType
GType CGType
type_'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
flags
    Ptr CGType -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CGType
type_
    (Bool, [MetaFlag], GType) -> IO (Bool, [MetaFlag], GType)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', [MetaFlag]
flags'', GType
type_'')

#if defined(ENABLE_OVERLOADING)
data MetaContainerCheckMetaRegisteredMethodInfo
instance (signature ~ (T.Text -> m ((Bool, [GES.Flags.MetaFlag], GType))), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerCheckMetaRegisteredMethodInfo a signature where
    overloadedMethod = metaContainerCheckMetaRegistered

instance O.OverloadedMethodInfo MetaContainerCheckMetaRegisteredMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerCheckMetaRegistered",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerCheckMetaRegistered"
        })


#endif

-- method MetaContainer::foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaForeachFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A function to call on each of @container's set\nmetadata fields"
--                 , 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 data to send to @func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ges_meta_container_foreach" ges_meta_container_foreach :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    FunPtr GES.Callbacks.C_MetaForeachFunc -> -- func : TInterface (Name {namespace = "GES", name = "MetaForeachFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Calls the given function on each of the meta container\'s set metadata
-- fields.
metaContainerForeach ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> GES.Callbacks.MetaForeachFunc
    -- ^ /@func@/: A function to call on each of /@container@/\'s set
    -- metadata fields
    -> m ()
metaContainerForeach :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> MetaForeachFunc -> m ()
metaContainerForeach a
container MetaForeachFunc
func = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    FunPtr C_MetaForeachFunc
func' <- C_MetaForeachFunc -> IO (FunPtr C_MetaForeachFunc)
GES.Callbacks.mk_MetaForeachFunc (Maybe (Ptr (FunPtr C_MetaForeachFunc))
-> MetaForeachFunc_WithClosures -> C_MetaForeachFunc
GES.Callbacks.wrap_MetaForeachFunc Maybe (Ptr (FunPtr C_MetaForeachFunc))
forall a. Maybe a
Nothing (MetaForeachFunc -> MetaForeachFunc_WithClosures
GES.Callbacks.drop_closures_MetaForeachFunc MetaForeachFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr MetaContainer -> FunPtr C_MetaForeachFunc -> Ptr () -> IO ()
ges_meta_container_foreach Ptr MetaContainer
container' FunPtr C_MetaForeachFunc
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_MetaForeachFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_MetaForeachFunc
func'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MetaContainerForeachMethodInfo
instance (signature ~ (GES.Callbacks.MetaForeachFunc -> m ()), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerForeachMethodInfo a signature where
    overloadedMethod = metaContainerForeach

instance O.OverloadedMethodInfo MetaContainerForeachMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerForeach",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerForeach"
        })


#endif

-- method MetaContainer::get_boolean
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Destination into which the value under @meta_item\nshould be copied."
--                 , 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 "ges_meta_container_get_boolean" ges_meta_container_get_boolean :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr CInt ->                             -- dest : TBasicType TBoolean
    IO CInt

-- | Gets the current boolean value of the specified field of the meta
-- container. If the field does not have a set value, or it is of the
-- wrong type, the method will fail.
metaContainerGetBoolean ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to get
    -> m ((Bool, Bool))
    -- ^ __Returns:__ 'P.True' if the boolean value under /@metaItem@/ was copied
    -- to /@dest@/.
metaContainerGetBoolean :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> m (Bool, Bool)
metaContainerGetBoolean a
container Text
metaItem = IO (Bool, Bool) -> m (Bool, Bool)
forall a. IO a -> m a
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 MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr CInt
dest <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    CInt
result <- Ptr MetaContainer -> CString -> Ptr CInt -> IO CInt
ges_meta_container_get_boolean Ptr MetaContainer
container' CString
metaItem' Ptr CInt
dest
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CInt
dest' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
dest
    let dest'' :: Bool
dest'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
dest'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
dest
    (Bool, Bool) -> IO (Bool, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Bool
dest'')

#if defined(ENABLE_OVERLOADING)
data MetaContainerGetBooleanMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Bool))), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerGetBooleanMethodInfo a signature where
    overloadedMethod = metaContainerGetBoolean

instance O.OverloadedMethodInfo MetaContainerGetBooleanMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerGetBoolean",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerGetBoolean"
        })


#endif

-- method MetaContainer::get_date
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TInterface Name { namespace = "GLib" , name = "Date" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Destination into which the value under @meta_item\nshould be copied."
--                 , 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 "ges_meta_container_get_date" ges_meta_container_get_date :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr (Ptr GLib.Date.Date) ->             -- dest : TInterface (Name {namespace = "GLib", name = "Date"})
    IO CInt

-- | Gets the current date value of the specified field of the meta
-- container. If the field does not have a set value, or it is of the
-- wrong type, the method will fail.
metaContainerGetDate ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to get
    -> m ((Bool, GLib.Date.Date))
    -- ^ __Returns:__ 'P.True' if the date value under /@metaItem@/ was copied
    -- to /@dest@/.
metaContainerGetDate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> m (Bool, Date)
metaContainerGetDate a
container Text
metaItem = IO (Bool, Date) -> m (Bool, Date)
forall a. IO a -> m a
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 MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr (Ptr Date)
dest <- IO (Ptr (Ptr Date))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr GLib.Date.Date))
    CInt
result <- Ptr MetaContainer -> CString -> Ptr (Ptr Date) -> IO CInt
ges_meta_container_get_date Ptr MetaContainer
container' CString
metaItem' Ptr (Ptr Date)
dest
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Date
dest' <- Ptr (Ptr Date) -> IO (Ptr Date)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Date)
dest
    Date
dest'' <- ((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
dest'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Ptr (Ptr Date) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Date)
dest
    (Bool, Date) -> IO (Bool, Date)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Date
dest'')

#if defined(ENABLE_OVERLOADING)
data MetaContainerGetDateMethodInfo
instance (signature ~ (T.Text -> m ((Bool, GLib.Date.Date))), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerGetDateMethodInfo a signature where
    overloadedMethod = metaContainerGetDate

instance O.OverloadedMethodInfo MetaContainerGetDateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerGetDate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerGetDate"
        })


#endif

-- method MetaContainer::get_date_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Destination into which the value under @meta_item\nshould be copied."
--                 , 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 "ges_meta_container_get_date_time" ges_meta_container_get_date_time :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr (Ptr Gst.DateTime.DateTime) ->      -- dest : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO CInt

-- | Gets the current date time value of the specified field of the meta
-- container. If the field does not have a set value, or it is of the
-- wrong type, the method will fail.
metaContainerGetDateTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to get
    -> m ((Bool, Gst.DateTime.DateTime))
    -- ^ __Returns:__ 'P.True' if the date time value under /@metaItem@/ was copied
    -- to /@dest@/.
metaContainerGetDateTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> m (Bool, DateTime)
metaContainerGetDateTime a
container Text
metaItem = IO (Bool, DateTime) -> m (Bool, DateTime)
forall a. IO a -> m a
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 MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr (Ptr DateTime)
dest <- IO (Ptr (Ptr DateTime))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.DateTime.DateTime))
    CInt
result <- Ptr MetaContainer -> CString -> Ptr (Ptr DateTime) -> IO CInt
ges_meta_container_get_date_time Ptr MetaContainer
container' CString
metaItem' Ptr (Ptr DateTime)
dest
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr DateTime
dest' <- Ptr (Ptr DateTime) -> IO (Ptr DateTime)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr DateTime)
dest
    DateTime
dest'' <- ((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
dest'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Ptr (Ptr DateTime) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr DateTime)
dest
    (Bool, DateTime) -> IO (Bool, DateTime)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', DateTime
dest'')

#if defined(ENABLE_OVERLOADING)
data MetaContainerGetDateTimeMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Gst.DateTime.DateTime))), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerGetDateTimeMethodInfo a signature where
    overloadedMethod = metaContainerGetDateTime

instance O.OverloadedMethodInfo MetaContainerGetDateTimeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerGetDateTime",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerGetDateTime"
        })


#endif

-- method MetaContainer::get_double
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Destination into which the value under @meta_item\nshould be copied."
--                 , 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 "ges_meta_container_get_double" ges_meta_container_get_double :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr CDouble ->                          -- dest : TBasicType TDouble
    IO CInt

-- | Gets the current double value of the specified field of the meta
-- container. If the field does not have a set value, or it is of the
-- wrong type, the method will fail.
metaContainerGetDouble ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to get
    -> m ((Bool, Double))
    -- ^ __Returns:__ 'P.True' if the double value under /@metaItem@/ was copied
    -- to /@dest@/.
metaContainerGetDouble :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> m (Bool, Double)
metaContainerGetDouble a
container Text
metaItem = IO (Bool, Double) -> m (Bool, Double)
forall a. IO a -> m a
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 MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr CDouble
dest <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr MetaContainer -> CString -> Ptr CDouble -> IO CInt
ges_meta_container_get_double Ptr MetaContainer
container' CString
metaItem' Ptr CDouble
dest
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
dest' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
dest
    let dest'' :: Double
dest'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
dest'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
dest
    (Bool, Double) -> IO (Bool, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
dest'')

#if defined(ENABLE_OVERLOADING)
data MetaContainerGetDoubleMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Double))), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerGetDoubleMethodInfo a signature where
    overloadedMethod = metaContainerGetDouble

instance O.OverloadedMethodInfo MetaContainerGetDoubleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerGetDouble",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerGetDouble"
        })


#endif

-- method MetaContainer::get_float
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Destination into which the value under @meta_item\nshould be copied."
--                 , 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 "ges_meta_container_get_float" ges_meta_container_get_float :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr CFloat ->                           -- dest : TBasicType TFloat
    IO CInt

-- | Gets the current float value of the specified field of the meta
-- container. If the field does not have a set value, or it is of the
-- wrong type, the method will fail.
metaContainerGetFloat ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to get
    -> m ((Bool, Float))
    -- ^ __Returns:__ 'P.True' if the float value under /@metaItem@/ was copied
    -- to /@dest@/.
metaContainerGetFloat :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> m (Bool, Float)
metaContainerGetFloat a
container Text
metaItem = IO (Bool, Float) -> m (Bool, Float)
forall a. IO a -> m a
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 MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr CFloat
dest <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    CInt
result <- Ptr MetaContainer -> CString -> Ptr CFloat -> IO CInt
ges_meta_container_get_float Ptr MetaContainer
container' CString
metaItem' Ptr CFloat
dest
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CFloat
dest' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
dest
    let dest'' :: Float
dest'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
dest'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
dest
    (Bool, Float) -> IO (Bool, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Float
dest'')

#if defined(ENABLE_OVERLOADING)
data MetaContainerGetFloatMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Float))), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerGetFloatMethodInfo a signature where
    overloadedMethod = metaContainerGetFloat

instance O.OverloadedMethodInfo MetaContainerGetFloatMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerGetFloat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerGetFloat"
        })


#endif

-- method MetaContainer::get_int
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Destination into which the value under @meta_item\nshould be copied."
--                 , 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 "ges_meta_container_get_int" ges_meta_container_get_int :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr Int32 ->                            -- dest : TBasicType TInt
    IO CInt

-- | Gets the current int value of the specified field of the meta
-- container. If the field does not have a set value, or it is of the
-- wrong type, the method will fail.
metaContainerGetInt ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to get
    -> m ((Bool, Int32))
    -- ^ __Returns:__ 'P.True' if the int value under /@metaItem@/ was copied
    -- to /@dest@/.
metaContainerGetInt :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> m (Bool, Int32)
metaContainerGetInt a
container Text
metaItem = IO (Bool, Int32) -> m (Bool, Int32)
forall a. IO a -> m a
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 MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr Int32
dest <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr MetaContainer -> CString -> Ptr Int32 -> IO CInt
ges_meta_container_get_int Ptr MetaContainer
container' CString
metaItem' Ptr Int32
dest
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int32
dest' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
dest
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
dest
    (Bool, Int32) -> IO (Bool, Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
dest')

#if defined(ENABLE_OVERLOADING)
data MetaContainerGetIntMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Int32))), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerGetIntMethodInfo a signature where
    overloadedMethod = metaContainerGetInt

instance O.OverloadedMethodInfo MetaContainerGetIntMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerGetInt",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerGetInt"
        })


#endif

-- method MetaContainer::get_int64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Destination into which the value under @meta_item\nshould be copied."
--                 , 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 "ges_meta_container_get_int64" ges_meta_container_get_int64 :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr Int64 ->                            -- dest : TBasicType TInt64
    IO CInt

-- | Gets the current int64 value of the specified field of the meta
-- container. If the field does not have a set value, or it is of the
-- wrong type, the method will fail.
metaContainerGetInt64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to get
    -> m ((Bool, Int64))
    -- ^ __Returns:__ 'P.True' if the int64 value under /@metaItem@/ was copied
    -- to /@dest@/.
metaContainerGetInt64 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> m (Bool, Int64)
metaContainerGetInt64 a
container Text
metaItem = IO (Bool, Int64) -> m (Bool, Int64)
forall a. IO a -> m a
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 MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr Int64
dest <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr MetaContainer -> CString -> Ptr Int64 -> IO CInt
ges_meta_container_get_int64 Ptr MetaContainer
container' CString
metaItem' Ptr Int64
dest
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
dest' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
dest
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
dest
    (Bool, Int64) -> IO (Bool, Int64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
dest')

#if defined(ENABLE_OVERLOADING)
data MetaContainerGetInt64MethodInfo
instance (signature ~ (T.Text -> m ((Bool, Int64))), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerGetInt64MethodInfo a signature where
    overloadedMethod = metaContainerGetInt64

instance O.OverloadedMethodInfo MetaContainerGetInt64MethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerGetInt64",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerGetInt64"
        })


#endif

-- method MetaContainer::get_marker_list
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GES" , name = "MarkerList" })
-- throws : False
-- Skip return : False

foreign import ccall "ges_meta_container_get_marker_list" ges_meta_container_get_marker_list :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- key : TBasicType TUTF8
    IO (Ptr GES.MarkerList.MarkerList)

-- | Gets the current marker list value of the specified field of the meta
-- container. If the field does not have a set value, or it is of the
-- wrong type, the method will fail.
-- 
-- /Since: 1.18/
metaContainerGetMarkerList ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@key@/: The key for the /@container@/ field to get
    -> m (Maybe GES.MarkerList.MarkerList)
    -- ^ __Returns:__ A copy of the marker list value under /@key@/,
    -- or 'P.Nothing' if it could not be fetched.
metaContainerGetMarkerList :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> m (Maybe MarkerList)
metaContainerGetMarkerList a
container Text
key = IO (Maybe MarkerList) -> m (Maybe MarkerList)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe MarkerList) -> m (Maybe MarkerList))
-> IO (Maybe MarkerList) -> m (Maybe MarkerList)
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr MarkerList
result <- Ptr MetaContainer -> CString -> IO (Ptr MarkerList)
ges_meta_container_get_marker_list Ptr MetaContainer
container' CString
key'
    Maybe MarkerList
maybeResult <- Ptr MarkerList
-> (Ptr MarkerList -> IO MarkerList) -> IO (Maybe MarkerList)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr MarkerList
result ((Ptr MarkerList -> IO MarkerList) -> IO (Maybe MarkerList))
-> (Ptr MarkerList -> IO MarkerList) -> IO (Maybe MarkerList)
forall a b. (a -> b) -> a -> b
$ \Ptr MarkerList
result' -> do
        MarkerList
result'' <- ((ManagedPtr MarkerList -> MarkerList)
-> Ptr MarkerList -> IO MarkerList
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr MarkerList -> MarkerList
GES.MarkerList.MarkerList) Ptr MarkerList
result'
        MarkerList -> IO MarkerList
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MarkerList
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    Maybe MarkerList -> IO (Maybe MarkerList)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MarkerList
maybeResult

#if defined(ENABLE_OVERLOADING)
data MetaContainerGetMarkerListMethodInfo
instance (signature ~ (T.Text -> m (Maybe GES.MarkerList.MarkerList)), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerGetMarkerListMethodInfo a signature where
    overloadedMethod = metaContainerGetMarkerList

instance O.OverloadedMethodInfo MetaContainerGetMarkerListMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerGetMarkerList",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerGetMarkerList"
        })


#endif

-- method MetaContainer::get_meta
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TGValue
-- throws : False
-- Skip return : False

foreign import ccall "ges_meta_container_get_meta" ges_meta_container_get_meta :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- key : TBasicType TUTF8
    IO (Ptr GValue)

-- | Gets the current value of the specified field of the meta container.
metaContainerGetMeta ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@key@/: The key for the /@container@/ field to get
    -> m (Maybe GValue)
    -- ^ __Returns:__ The value under /@key@/, or 'P.Nothing' if /@container@/
    -- does not have the field set.
metaContainerGetMeta :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> m (Maybe GValue)
metaContainerGetMeta a
container Text
key = IO (Maybe GValue) -> m (Maybe GValue)
forall a. IO a -> m a
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 MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr GValue
result <- Ptr MetaContainer -> CString -> IO (Ptr GValue)
ges_meta_container_get_meta Ptr MetaContainer
container' CString
key'
    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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    Maybe GValue -> IO (Maybe GValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GValue
maybeResult

#if defined(ENABLE_OVERLOADING)
data MetaContainerGetMetaMethodInfo
instance (signature ~ (T.Text -> m (Maybe GValue)), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerGetMetaMethodInfo a signature where
    overloadedMethod = metaContainerGetMeta

instance O.OverloadedMethodInfo MetaContainerGetMetaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerGetMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerGetMeta"
        })


#endif

-- method MetaContainer::get_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to get"
--                 , 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 "ges_meta_container_get_string" ges_meta_container_get_string :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    IO CString

-- | Gets the current string value of the specified field of the meta
-- container. If the field does not have a set value, or it is of the
-- wrong type, the method will fail.
metaContainerGetString ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to get
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The string value under /@metaItem@/, or 'P.Nothing'
    -- if it could not be fetched.
metaContainerGetString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> m (Maybe Text)
metaContainerGetString a
container Text
metaItem = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
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 MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    CString
result <- Ptr MetaContainer -> CString -> IO CString
ges_meta_container_get_string Ptr MetaContainer
container' CString
metaItem'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data MetaContainerGetStringMethodInfo
instance (signature ~ (T.Text -> m (Maybe T.Text)), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerGetStringMethodInfo a signature where
    overloadedMethod = metaContainerGetString

instance O.OverloadedMethodInfo MetaContainerGetStringMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerGetString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerGetString"
        })


#endif

-- method MetaContainer::get_uint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Destination into which the value under @meta_item\nshould be copied."
--                 , 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 "ges_meta_container_get_uint" ges_meta_container_get_uint :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr Word32 ->                           -- dest : TBasicType TUInt
    IO CInt

-- | Gets the current uint value of the specified field of the meta
-- container. If the field does not have a set value, or it is of the
-- wrong type, the method will fail.
metaContainerGetUint ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to get
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' if the uint value under /@metaItem@/ was copied
    -- to /@dest@/.
metaContainerGetUint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> m (Bool, Word32)
metaContainerGetUint a
container Text
metaItem = IO (Bool, Word32) -> m (Bool, Word32)
forall a. IO a -> m a
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 MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr Word32
dest <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr MetaContainer -> CString -> Ptr Word32 -> IO CInt
ges_meta_container_get_uint Ptr MetaContainer
container' CString
metaItem' Ptr Word32
dest
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
dest' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
dest
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
dest
    (Bool, Word32) -> IO (Bool, Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
dest')

#if defined(ENABLE_OVERLOADING)
data MetaContainerGetUintMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Word32))), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerGetUintMethodInfo a signature where
    overloadedMethod = metaContainerGetUint

instance O.OverloadedMethodInfo MetaContainerGetUintMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerGetUint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerGetUint"
        })


#endif

-- method MetaContainer::get_uint64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Destination into which the value under @meta_item\nshould be copied."
--                 , 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 "ges_meta_container_get_uint64" ges_meta_container_get_uint64 :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr Word64 ->                           -- dest : TBasicType TUInt64
    IO CInt

-- | Gets the current uint64 value of the specified field of the meta
-- container. If the field does not have a set value, or it is of the
-- wrong type, the method will fail.
metaContainerGetUint64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to get
    -> m ((Bool, Word64))
    -- ^ __Returns:__ 'P.True' if the uint64 value under /@metaItem@/ was copied
    -- to /@dest@/.
metaContainerGetUint64 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> m (Bool, CGType)
metaContainerGetUint64 a
container Text
metaItem = IO (Bool, CGType) -> m (Bool, CGType)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, CGType) -> m (Bool, CGType))
-> IO (Bool, CGType) -> m (Bool, CGType)
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr CGType
dest <- IO (Ptr CGType)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CInt
result <- Ptr MetaContainer -> CString -> Ptr CGType -> IO CInt
ges_meta_container_get_uint64 Ptr MetaContainer
container' CString
metaItem' Ptr CGType
dest
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CGType
dest' <- Ptr CGType -> IO CGType
forall a. Storable a => Ptr a -> IO a
peek Ptr CGType
dest
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Ptr CGType -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CGType
dest
    (Bool, CGType) -> IO (Bool, CGType)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', CGType
dest')

#if defined(ENABLE_OVERLOADING)
data MetaContainerGetUint64MethodInfo
instance (signature ~ (T.Text -> m ((Bool, Word64))), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerGetUint64MethodInfo a signature where
    overloadedMethod = metaContainerGetUint64

instance O.OverloadedMethodInfo MetaContainerGetUint64MethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerGetUint64",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerGetUint64"
        })


#endif

-- method MetaContainer::metas_to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , 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 "ges_meta_container_metas_to_string" ges_meta_container_metas_to_string :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    IO CString

-- | Serializes the set metadata fields of the meta container to a string.
metaContainerMetasToString ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> m T.Text
    -- ^ __Returns:__ A serialized /@container@/.
metaContainerMetasToString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> m Text
metaContainerMetasToString a
container = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
result <- Ptr MetaContainer -> IO CString
ges_meta_container_metas_to_string Ptr MetaContainer
container'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"metaContainerMetasToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerMetasToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerMetasToStringMethodInfo a signature where
    overloadedMethod = metaContainerMetasToString

instance O.OverloadedMethodInfo MetaContainerMetasToStringMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerMetasToString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerMetasToString"
        })


#endif

-- method MetaContainer::register_meta
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaFlag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags to be used for the registered field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to register"
--                 , 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 "The value to set for the registered field"
--                 , 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 "ges_meta_container_register_meta" ges_meta_container_register_meta :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GES", name = "MetaFlag"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given value, and registers the field to only hold a value of the
-- same type. After calling this, only values of the same type as /@value@/
-- can be set for this field. The given flags can be set to make this
-- field only readable after calling this method.
metaContainerRegisterMeta ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> [GES.Flags.MetaFlag]
    -- ^ /@flags@/: Flags to be used for the registered field
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to register
    -> GValue
    -- ^ /@value@/: The value to set for the registered field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@metaItem@/ field was successfully registered on
    -- /@container@/ to only hold /@value@/ types, with the given /@flags@/, and the
    -- field was successfully set to /@value@/.
metaContainerRegisterMeta :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> [MetaFlag] -> Text -> GValue -> m Bool
metaContainerRegisterMeta a
container [MetaFlag]
flags Text
metaItem GValue
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    let flags' :: CUInt
flags' = [MetaFlag] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MetaFlag]
flags
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    CInt
result <- Ptr MetaContainer -> CUInt -> CString -> Ptr GValue -> IO CInt
ges_meta_container_register_meta Ptr MetaContainer
container' CUInt
flags' CString
metaItem' Ptr GValue
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerRegisterMetaMethodInfo
instance (signature ~ ([GES.Flags.MetaFlag] -> T.Text -> GValue -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerRegisterMetaMethodInfo a signature where
    overloadedMethod = metaContainerRegisterMeta

instance O.OverloadedMethodInfo MetaContainerRegisterMetaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerRegisterMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerRegisterMeta"
        })


#endif

-- method MetaContainer::register_meta_boolean
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaFlag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags to be used for the registered field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to register"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set for the registered field"
--                 , 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 "ges_meta_container_register_meta_boolean" ges_meta_container_register_meta_boolean :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GES", name = "MetaFlag"})
    CString ->                              -- meta_item : TBasicType TUTF8
    CInt ->                                 -- value : TBasicType TBoolean
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given boolean value, and registers the field to only hold a boolean
-- typed value. After calling this, only boolean values can be set for
-- this field. The given flags can be set to make this field only
-- readable after calling this method.
metaContainerRegisterMetaBoolean ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> [GES.Flags.MetaFlag]
    -- ^ /@flags@/: Flags to be used for the registered field
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to register
    -> Bool
    -- ^ /@value@/: The value to set for the registered field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@metaItem@/ field was successfully registered on
    -- /@container@/ to only hold boolean typed values, with the given /@flags@/,
    -- and the field was successfully set to /@value@/.
metaContainerRegisterMetaBoolean :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> [MetaFlag] -> Text -> Bool -> m Bool
metaContainerRegisterMetaBoolean a
container [MetaFlag]
flags Text
metaItem Bool
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    let flags' :: CUInt
flags' = [MetaFlag] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MetaFlag]
flags
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    let value' :: CInt
value' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
value
    CInt
result <- Ptr MetaContainer -> CUInt -> CString -> CInt -> IO CInt
ges_meta_container_register_meta_boolean Ptr MetaContainer
container' CUInt
flags' CString
metaItem' CInt
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerRegisterMetaBooleanMethodInfo
instance (signature ~ ([GES.Flags.MetaFlag] -> T.Text -> Bool -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerRegisterMetaBooleanMethodInfo a signature where
    overloadedMethod = metaContainerRegisterMetaBoolean

instance O.OverloadedMethodInfo MetaContainerRegisterMetaBooleanMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerRegisterMetaBoolean",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerRegisterMetaBoolean"
        })


#endif

-- method MetaContainer::register_meta_date
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaFlag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags to be used for the registered field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to register"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TInterface Name { namespace = "GLib" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set for the registered field"
--                 , 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 "ges_meta_container_register_meta_date" ges_meta_container_register_meta_date :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GES", name = "MetaFlag"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr GLib.Date.Date ->                   -- value : TInterface (Name {namespace = "GLib", name = "Date"})
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given date value, and registers the field to only hold a date
-- typed value. After calling this, only date values can be set for
-- this field. The given flags can be set to make this field only
-- readable after calling this method.
metaContainerRegisterMetaDate ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> [GES.Flags.MetaFlag]
    -- ^ /@flags@/: Flags to be used for the registered field
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to register
    -> GLib.Date.Date
    -- ^ /@value@/: The value to set for the registered field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@metaItem@/ field was successfully registered on
    -- /@container@/ to only hold date typed values, with the given /@flags@/,
    -- and the field was successfully set to /@value@/.
metaContainerRegisterMetaDate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> [MetaFlag] -> Text -> Date -> m Bool
metaContainerRegisterMetaDate a
container [MetaFlag]
flags Text
metaItem Date
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    let flags' :: CUInt
flags' = [MetaFlag] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MetaFlag]
flags
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr Date
value' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
value
    CInt
result <- Ptr MetaContainer -> CUInt -> CString -> Ptr Date -> IO CInt
ges_meta_container_register_meta_date Ptr MetaContainer
container' CUInt
flags' CString
metaItem' Ptr Date
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerRegisterMetaDateMethodInfo
instance (signature ~ ([GES.Flags.MetaFlag] -> T.Text -> GLib.Date.Date -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerRegisterMetaDateMethodInfo a signature where
    overloadedMethod = metaContainerRegisterMetaDate

instance O.OverloadedMethodInfo MetaContainerRegisterMetaDateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerRegisterMetaDate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerRegisterMetaDate"
        })


#endif

-- method MetaContainer::register_meta_date_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaFlag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags to be used for the registered field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to register"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set for the registered field"
--                 , 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 "ges_meta_container_register_meta_date_time" ges_meta_container_register_meta_date_time :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GES", name = "MetaFlag"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr Gst.DateTime.DateTime ->            -- value : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given date time value, and registers the field to only hold a date time
-- typed value. After calling this, only date time values can be set for
-- this field. The given flags can be set to make this field only
-- readable after calling this method.
metaContainerRegisterMetaDateTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> [GES.Flags.MetaFlag]
    -- ^ /@flags@/: Flags to be used for the registered field
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to register
    -> Gst.DateTime.DateTime
    -- ^ /@value@/: The value to set for the registered field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@metaItem@/ field was successfully registered on
    -- /@container@/ to only hold date time typed values, with the given /@flags@/,
    -- and the field was successfully set to /@value@/.
metaContainerRegisterMetaDateTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> [MetaFlag] -> Text -> DateTime -> m Bool
metaContainerRegisterMetaDateTime a
container [MetaFlag]
flags Text
metaItem DateTime
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    let flags' :: CUInt
flags' = [MetaFlag] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MetaFlag]
flags
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr DateTime
value' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
value
    CInt
result <- Ptr MetaContainer -> CUInt -> CString -> Ptr DateTime -> IO CInt
ges_meta_container_register_meta_date_time Ptr MetaContainer
container' CUInt
flags' CString
metaItem' Ptr DateTime
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerRegisterMetaDateTimeMethodInfo
instance (signature ~ ([GES.Flags.MetaFlag] -> T.Text -> Gst.DateTime.DateTime -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerRegisterMetaDateTimeMethodInfo a signature where
    overloadedMethod = metaContainerRegisterMetaDateTime

instance O.OverloadedMethodInfo MetaContainerRegisterMetaDateTimeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerRegisterMetaDateTime",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerRegisterMetaDateTime"
        })


#endif

-- method MetaContainer::register_meta_double
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaFlag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags to be used for the registered field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to register"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set for the registered field"
--                 , 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 "ges_meta_container_register_meta_double" ges_meta_container_register_meta_double :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GES", name = "MetaFlag"})
    CString ->                              -- meta_item : TBasicType TUTF8
    CDouble ->                              -- value : TBasicType TDouble
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given double value, and registers the field to only hold a double
-- typed value. After calling this, only double values can be set for
-- this field. The given flags can be set to make this field only
-- readable after calling this method.
metaContainerRegisterMetaDouble ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> [GES.Flags.MetaFlag]
    -- ^ /@flags@/: Flags to be used for the registered field
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to register
    -> Double
    -- ^ /@value@/: The value to set for the registered field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@metaItem@/ field was successfully registered on
    -- /@container@/ to only hold double typed values, with the given /@flags@/,
    -- and the field was successfully set to /@value@/.
metaContainerRegisterMetaDouble :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> [MetaFlag] -> Text -> Double -> m Bool
metaContainerRegisterMetaDouble a
container [MetaFlag]
flags Text
metaItem Double
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    let flags' :: CUInt
flags' = [MetaFlag] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MetaFlag]
flags
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    CInt
result <- Ptr MetaContainer -> CUInt -> CString -> CDouble -> IO CInt
ges_meta_container_register_meta_double Ptr MetaContainer
container' CUInt
flags' CString
metaItem' CDouble
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerRegisterMetaDoubleMethodInfo
instance (signature ~ ([GES.Flags.MetaFlag] -> T.Text -> Double -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerRegisterMetaDoubleMethodInfo a signature where
    overloadedMethod = metaContainerRegisterMetaDouble

instance O.OverloadedMethodInfo MetaContainerRegisterMetaDoubleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerRegisterMetaDouble",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerRegisterMetaDouble"
        })


#endif

-- method MetaContainer::register_meta_float
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaFlag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags to be used for the registered field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to register"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set for the registered field"
--                 , 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 "ges_meta_container_register_meta_float" ges_meta_container_register_meta_float :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GES", name = "MetaFlag"})
    CString ->                              -- meta_item : TBasicType TUTF8
    CFloat ->                               -- value : TBasicType TFloat
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given float value, and registers the field to only hold a float
-- typed value. After calling this, only float values can be set for
-- this field. The given flags can be set to make this field only
-- readable after calling this method.
metaContainerRegisterMetaFloat ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> [GES.Flags.MetaFlag]
    -- ^ /@flags@/: Flags to be used for the registered field
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to register
    -> Float
    -- ^ /@value@/: The value to set for the registered field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@metaItem@/ field was successfully registered on
    -- /@container@/ to only hold float typed values, with the given /@flags@/,
    -- and the field was successfully set to /@value@/.
metaContainerRegisterMetaFloat :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> [MetaFlag] -> Text -> Float -> m Bool
metaContainerRegisterMetaFloat a
container [MetaFlag]
flags Text
metaItem Float
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    let flags' :: CUInt
flags' = [MetaFlag] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MetaFlag]
flags
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    let value' :: CFloat
value' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
value
    CInt
result <- Ptr MetaContainer -> CUInt -> CString -> CFloat -> IO CInt
ges_meta_container_register_meta_float Ptr MetaContainer
container' CUInt
flags' CString
metaItem' CFloat
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerRegisterMetaFloatMethodInfo
instance (signature ~ ([GES.Flags.MetaFlag] -> T.Text -> Float -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerRegisterMetaFloatMethodInfo a signature where
    overloadedMethod = metaContainerRegisterMetaFloat

instance O.OverloadedMethodInfo MetaContainerRegisterMetaFloatMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerRegisterMetaFloat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerRegisterMetaFloat"
        })


#endif

-- method MetaContainer::register_meta_int
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaFlag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags to be used for the registered field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to register"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set for the registered field"
--                 , 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 "ges_meta_container_register_meta_int" ges_meta_container_register_meta_int :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GES", name = "MetaFlag"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Int32 ->                                -- value : TBasicType TInt
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given int value, and registers the field to only hold an int
-- typed value. After calling this, only int values can be set for
-- this field. The given flags can be set to make this field only
-- readable after calling this method.
metaContainerRegisterMetaInt ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> [GES.Flags.MetaFlag]
    -- ^ /@flags@/: Flags to be used for the registered field
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to register
    -> Int32
    -- ^ /@value@/: The value to set for the registered field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@metaItem@/ field was successfully registered on
    -- /@container@/ to only hold int typed values, with the given /@flags@/,
    -- and the field was successfully set to /@value@/.
metaContainerRegisterMetaInt :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> [MetaFlag] -> Text -> Int32 -> m Bool
metaContainerRegisterMetaInt a
container [MetaFlag]
flags Text
metaItem Int32
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    let flags' :: CUInt
flags' = [MetaFlag] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MetaFlag]
flags
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    CInt
result <- Ptr MetaContainer -> CUInt -> CString -> Int32 -> IO CInt
ges_meta_container_register_meta_int Ptr MetaContainer
container' CUInt
flags' CString
metaItem' Int32
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerRegisterMetaIntMethodInfo
instance (signature ~ ([GES.Flags.MetaFlag] -> T.Text -> Int32 -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerRegisterMetaIntMethodInfo a signature where
    overloadedMethod = metaContainerRegisterMetaInt

instance O.OverloadedMethodInfo MetaContainerRegisterMetaIntMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerRegisterMetaInt",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerRegisterMetaInt"
        })


#endif

-- method MetaContainer::register_meta_int64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaFlag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags to be used for the registered field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to register"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set for the registered field"
--                 , 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 "ges_meta_container_register_meta_int64" ges_meta_container_register_meta_int64 :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GES", name = "MetaFlag"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Int64 ->                                -- value : TBasicType TInt64
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given int64 value, and registers the field to only hold an int64
-- typed value. After calling this, only int64 values can be set for
-- this field. The given flags can be set to make this field only
-- readable after calling this method.
metaContainerRegisterMetaInt64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> [GES.Flags.MetaFlag]
    -- ^ /@flags@/: Flags to be used for the registered field
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to register
    -> Int64
    -- ^ /@value@/: The value to set for the registered field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@metaItem@/ field was successfully registered on
    -- /@container@/ to only hold int64 typed values, with the given /@flags@/,
    -- and the field was successfully set to /@value@/.
metaContainerRegisterMetaInt64 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> [MetaFlag] -> Text -> Int64 -> m Bool
metaContainerRegisterMetaInt64 a
container [MetaFlag]
flags Text
metaItem Int64
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    let flags' :: CUInt
flags' = [MetaFlag] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MetaFlag]
flags
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    CInt
result <- Ptr MetaContainer -> CUInt -> CString -> Int64 -> IO CInt
ges_meta_container_register_meta_int64 Ptr MetaContainer
container' CUInt
flags' CString
metaItem' Int64
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerRegisterMetaInt64MethodInfo
instance (signature ~ ([GES.Flags.MetaFlag] -> T.Text -> Int64 -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerRegisterMetaInt64MethodInfo a signature where
    overloadedMethod = metaContainerRegisterMetaInt64

instance O.OverloadedMethodInfo MetaContainerRegisterMetaInt64MethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerRegisterMetaInt64",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerRegisterMetaInt64"
        })


#endif

-- method MetaContainer::register_meta_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaFlag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags to be used for the registered field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to register"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set for the registered field"
--                 , 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 "ges_meta_container_register_meta_string" ges_meta_container_register_meta_string :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GES", name = "MetaFlag"})
    CString ->                              -- meta_item : TBasicType TUTF8
    CString ->                              -- value : TBasicType TUTF8
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given string value, and registers the field to only hold a string
-- typed value. After calling this, only string values can be set for
-- this field. The given flags can be set to make this field only
-- readable after calling this method.
metaContainerRegisterMetaString ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> [GES.Flags.MetaFlag]
    -- ^ /@flags@/: Flags to be used for the registered field
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to register
    -> T.Text
    -- ^ /@value@/: The value to set for the registered field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@metaItem@/ field was successfully registered on
    -- /@container@/ to only hold string typed values, with the given /@flags@/,
    -- and the field was successfully set to /@value@/.
metaContainerRegisterMetaString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> [MetaFlag] -> Text -> Text -> m Bool
metaContainerRegisterMetaString a
container [MetaFlag]
flags Text
metaItem Text
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    let flags' :: CUInt
flags' = [MetaFlag] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MetaFlag]
flags
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    CString
value' <- Text -> IO CString
textToCString Text
value
    CInt
result <- Ptr MetaContainer -> CUInt -> CString -> CString -> IO CInt
ges_meta_container_register_meta_string Ptr MetaContainer
container' CUInt
flags' CString
metaItem' CString
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerRegisterMetaStringMethodInfo
instance (signature ~ ([GES.Flags.MetaFlag] -> T.Text -> T.Text -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerRegisterMetaStringMethodInfo a signature where
    overloadedMethod = metaContainerRegisterMetaString

instance O.OverloadedMethodInfo MetaContainerRegisterMetaStringMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerRegisterMetaString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerRegisterMetaString"
        })


#endif

-- method MetaContainer::register_meta_uint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaFlag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags to be used for the registered field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to register"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set for the registered field"
--                 , 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 "ges_meta_container_register_meta_uint" ges_meta_container_register_meta_uint :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GES", name = "MetaFlag"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Word32 ->                               -- value : TBasicType TUInt
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given uint value, and registers the field to only hold a uint
-- typed value. After calling this, only uint values can be set for
-- this field. The given flags can be set to make this field only
-- readable after calling this method.
metaContainerRegisterMetaUint ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> [GES.Flags.MetaFlag]
    -- ^ /@flags@/: Flags to be used for the registered field
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to register
    -> Word32
    -- ^ /@value@/: The value to set for the registered field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@metaItem@/ field was successfully registered on
    -- /@container@/ to only hold uint typed values, with the given /@flags@/,
    -- and the field was successfully set to /@value@/.
metaContainerRegisterMetaUint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> [MetaFlag] -> Text -> Word32 -> m Bool
metaContainerRegisterMetaUint a
container [MetaFlag]
flags Text
metaItem Word32
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    let flags' :: CUInt
flags' = [MetaFlag] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MetaFlag]
flags
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    CInt
result <- Ptr MetaContainer -> CUInt -> CString -> Word32 -> IO CInt
ges_meta_container_register_meta_uint Ptr MetaContainer
container' CUInt
flags' CString
metaItem' Word32
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerRegisterMetaUintMethodInfo
instance (signature ~ ([GES.Flags.MetaFlag] -> T.Text -> Word32 -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerRegisterMetaUintMethodInfo a signature where
    overloadedMethod = metaContainerRegisterMetaUint

instance O.OverloadedMethodInfo MetaContainerRegisterMetaUintMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerRegisterMetaUint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerRegisterMetaUint"
        })


#endif

-- method MetaContainer::register_meta_uint64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaFlag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags to be used for the registered field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to register"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set for the registered field"
--                 , 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 "ges_meta_container_register_meta_uint64" ges_meta_container_register_meta_uint64 :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GES", name = "MetaFlag"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Word64 ->                               -- value : TBasicType TUInt64
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given uint64 value, and registers the field to only hold a uint64
-- typed value. After calling this, only uint64 values can be set for
-- this field. The given flags can be set to make this field only
-- readable after calling this method.
metaContainerRegisterMetaUint64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> [GES.Flags.MetaFlag]
    -- ^ /@flags@/: Flags to be used for the registered field
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to register
    -> Word64
    -- ^ /@value@/: The value to set for the registered field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@metaItem@/ field was successfully registered on
    -- /@container@/ to only hold uint64 typed values, with the given /@flags@/,
    -- and the field was successfully set to /@value@/.
metaContainerRegisterMetaUint64 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> [MetaFlag] -> Text -> CGType -> m Bool
metaContainerRegisterMetaUint64 a
container [MetaFlag]
flags Text
metaItem CGType
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    let flags' :: CUInt
flags' = [MetaFlag] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MetaFlag]
flags
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    CInt
result <- Ptr MetaContainer -> CUInt -> CString -> CGType -> IO CInt
ges_meta_container_register_meta_uint64 Ptr MetaContainer
container' CUInt
flags' CString
metaItem' CGType
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerRegisterMetaUint64MethodInfo
instance (signature ~ ([GES.Flags.MetaFlag] -> T.Text -> Word64 -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerRegisterMetaUint64MethodInfo a signature where
    overloadedMethod = metaContainerRegisterMetaUint64

instance O.OverloadedMethodInfo MetaContainerRegisterMetaUint64MethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerRegisterMetaUint64",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerRegisterMetaUint64"
        })


#endif

-- method MetaContainer::register_static_meta
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaFlag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags to be used for the registered field"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to register"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The required value type for the registered field"
--                 , 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 "ges_meta_container_register_static_meta" ges_meta_container_register_static_meta :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GES", name = "MetaFlag"})
    CString ->                              -- meta_item : TBasicType TUTF8
    CGType ->                               -- type : TBasicType TGType
    IO CInt

-- | Registers a static metadata field on the container to only hold the
-- specified type. After calling this, setting a value under this field
-- can only succeed if its type matches the registered type of the field.
-- 
-- Unlike 'GI.GES.Interfaces.MetaContainer.metaContainerRegisterMeta', no (initial) value is set
-- for this field, which means you can use this method to reserve the
-- space to be _optionally_ set later.
-- 
-- Note that if a value has already been set for the field being
-- registered, then its type must match the registering type, and its
-- value will be left in place. If the field has no set value, then
-- you will likely want to include @/GES_META_WRITABLE/@ in /@flags@/ to allow
-- the value to be set later.
-- 
-- /Since: 1.18/
metaContainerRegisterStaticMeta ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> [GES.Flags.MetaFlag]
    -- ^ /@flags@/: Flags to be used for the registered field
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to register
    -> GType
    -- ^ /@type@/: The required value type for the registered field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@metaItem@/ field was successfully registered on
    -- /@container@/ to only hold /@type@/ values, with the given /@flags@/.
metaContainerRegisterStaticMeta :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> [MetaFlag] -> Text -> GType -> m Bool
metaContainerRegisterStaticMeta a
container [MetaFlag]
flags Text
metaItem GType
type_ = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    let flags' :: CUInt
flags' = [MetaFlag] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MetaFlag]
flags
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    CInt
result <- Ptr MetaContainer -> CUInt -> CString -> CGType -> IO CInt
ges_meta_container_register_static_meta Ptr MetaContainer
container' CUInt
flags' CString
metaItem' CGType
type_'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerRegisterStaticMetaMethodInfo
instance (signature ~ ([GES.Flags.MetaFlag] -> T.Text -> GType -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerRegisterStaticMetaMethodInfo a signature where
    overloadedMethod = metaContainerRegisterStaticMeta

instance O.OverloadedMethodInfo MetaContainerRegisterStaticMetaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerRegisterStaticMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerRegisterStaticMeta"
        })


#endif

-- method MetaContainer::set_boolean
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set under @meta_item"
--                 , 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 "ges_meta_container_set_boolean" ges_meta_container_set_boolean :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    CInt ->                                 -- value : TBasicType TBoolean
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given boolean value.
metaContainerSetBoolean ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to set
    -> Bool
    -- ^ /@value@/: The value to set under /@metaItem@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@value@/ was set under /@metaItem@/ for /@container@/.
metaContainerSetBoolean :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> Bool -> m Bool
metaContainerSetBoolean a
container Text
metaItem Bool
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    let value' :: CInt
value' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
value
    CInt
result <- Ptr MetaContainer -> CString -> CInt -> IO CInt
ges_meta_container_set_boolean Ptr MetaContainer
container' CString
metaItem' CInt
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerSetBooleanMethodInfo
instance (signature ~ (T.Text -> Bool -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerSetBooleanMethodInfo a signature where
    overloadedMethod = metaContainerSetBoolean

instance O.OverloadedMethodInfo MetaContainerSetBooleanMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerSetBoolean",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerSetBoolean"
        })


#endif

-- method MetaContainer::set_date
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TInterface Name { namespace = "GLib" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set under @meta_item"
--                 , 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 "ges_meta_container_set_date" ges_meta_container_set_date :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr GLib.Date.Date ->                   -- value : TInterface (Name {namespace = "GLib", name = "Date"})
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given date value.
metaContainerSetDate ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to set
    -> GLib.Date.Date
    -- ^ /@value@/: The value to set under /@metaItem@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@value@/ was set under /@metaItem@/ for /@container@/.
metaContainerSetDate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> Date -> m Bool
metaContainerSetDate a
container Text
metaItem Date
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr Date
value' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
value
    CInt
result <- Ptr MetaContainer -> CString -> Ptr Date -> IO CInt
ges_meta_container_set_date Ptr MetaContainer
container' CString
metaItem' Ptr Date
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerSetDateMethodInfo
instance (signature ~ (T.Text -> GLib.Date.Date -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerSetDateMethodInfo a signature where
    overloadedMethod = metaContainerSetDate

instance O.OverloadedMethodInfo MetaContainerSetDateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerSetDate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerSetDate"
        })


#endif

-- method MetaContainer::set_date_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set under @meta_item"
--                 , 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 "ges_meta_container_set_date_time" ges_meta_container_set_date_time :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr Gst.DateTime.DateTime ->            -- value : TInterface (Name {namespace = "Gst", name = "DateTime"})
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given date time value.
metaContainerSetDateTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to set
    -> Gst.DateTime.DateTime
    -- ^ /@value@/: The value to set under /@metaItem@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@value@/ was set under /@metaItem@/ for /@container@/.
metaContainerSetDateTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> DateTime -> m Bool
metaContainerSetDateTime a
container Text
metaItem DateTime
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr DateTime
value' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
value
    CInt
result <- Ptr MetaContainer -> CString -> Ptr DateTime -> IO CInt
ges_meta_container_set_date_time Ptr MetaContainer
container' CString
metaItem' Ptr DateTime
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerSetDateTimeMethodInfo
instance (signature ~ (T.Text -> Gst.DateTime.DateTime -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerSetDateTimeMethodInfo a signature where
    overloadedMethod = metaContainerSetDateTime

instance O.OverloadedMethodInfo MetaContainerSetDateTimeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerSetDateTime",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerSetDateTime"
        })


#endif

-- method MetaContainer::set_double
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set under @meta_item"
--                 , 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 "ges_meta_container_set_double" ges_meta_container_set_double :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    CDouble ->                              -- value : TBasicType TDouble
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given double value.
metaContainerSetDouble ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to set
    -> Double
    -- ^ /@value@/: The value to set under /@metaItem@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@value@/ was set under /@metaItem@/ for /@container@/.
metaContainerSetDouble :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> Double -> m Bool
metaContainerSetDouble a
container Text
metaItem Double
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    CInt
result <- Ptr MetaContainer -> CString -> CDouble -> IO CInt
ges_meta_container_set_double Ptr MetaContainer
container' CString
metaItem' CDouble
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerSetDoubleMethodInfo
instance (signature ~ (T.Text -> Double -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerSetDoubleMethodInfo a signature where
    overloadedMethod = metaContainerSetDouble

instance O.OverloadedMethodInfo MetaContainerSetDoubleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerSetDouble",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerSetDouble"
        })


#endif

-- method MetaContainer::set_float
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set under @meta_item"
--                 , 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 "ges_meta_container_set_float" ges_meta_container_set_float :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    CFloat ->                               -- value : TBasicType TFloat
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given float value.
metaContainerSetFloat ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to set
    -> Float
    -- ^ /@value@/: The value to set under /@metaItem@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@value@/ was set under /@metaItem@/ for /@container@/.
metaContainerSetFloat :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> Float -> m Bool
metaContainerSetFloat a
container Text
metaItem Float
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    let value' :: CFloat
value' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
value
    CInt
result <- Ptr MetaContainer -> CString -> CFloat -> IO CInt
ges_meta_container_set_float Ptr MetaContainer
container' CString
metaItem' CFloat
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerSetFloatMethodInfo
instance (signature ~ (T.Text -> Float -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerSetFloatMethodInfo a signature where
    overloadedMethod = metaContainerSetFloat

instance O.OverloadedMethodInfo MetaContainerSetFloatMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerSetFloat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerSetFloat"
        })


#endif

-- method MetaContainer::set_int
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set under @meta_item"
--                 , 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 "ges_meta_container_set_int" ges_meta_container_set_int :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Int32 ->                                -- value : TBasicType TInt
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given int value.
metaContainerSetInt ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to set
    -> Int32
    -- ^ /@value@/: The value to set under /@metaItem@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@value@/ was set under /@metaItem@/ for /@container@/.
metaContainerSetInt :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> Int32 -> m Bool
metaContainerSetInt a
container Text
metaItem Int32
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    CInt
result <- Ptr MetaContainer -> CString -> Int32 -> IO CInt
ges_meta_container_set_int Ptr MetaContainer
container' CString
metaItem' Int32
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerSetIntMethodInfo
instance (signature ~ (T.Text -> Int32 -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerSetIntMethodInfo a signature where
    overloadedMethod = metaContainerSetInt

instance O.OverloadedMethodInfo MetaContainerSetIntMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerSetInt",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerSetInt"
        })


#endif

-- method MetaContainer::set_int64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set under @meta_item"
--                 , 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 "ges_meta_container_set_int64" ges_meta_container_set_int64 :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Int64 ->                                -- value : TBasicType TInt64
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given int64 value.
metaContainerSetInt64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to set
    -> Int64
    -- ^ /@value@/: The value to set under /@metaItem@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@value@/ was set under /@metaItem@/ for /@container@/.
metaContainerSetInt64 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> Int64 -> m Bool
metaContainerSetInt64 a
container Text
metaItem Int64
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    CInt
result <- Ptr MetaContainer -> CString -> Int64 -> IO CInt
ges_meta_container_set_int64 Ptr MetaContainer
container' CString
metaItem' Int64
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerSetInt64MethodInfo
instance (signature ~ (T.Text -> Int64 -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerSetInt64MethodInfo a signature where
    overloadedMethod = metaContainerSetInt64

instance O.OverloadedMethodInfo MetaContainerSetInt64MethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerSetInt64",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerSetInt64"
        })


#endif

-- method MetaContainer::set_marker_list
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MarkerList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set under @meta_item"
--                 , 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 "ges_meta_container_set_marker_list" ges_meta_container_set_marker_list :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr GES.MarkerList.MarkerList ->        -- list : TInterface (Name {namespace = "GES", name = "MarkerList"})
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given marker list value.
-- 
-- /Since: 1.18/
metaContainerSetMarkerList ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a, GES.MarkerList.IsMarkerList b) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to set
    -> b
    -- ^ /@list@/: The value to set under /@metaItem@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@value@/ was set under /@metaItem@/ for /@container@/.
metaContainerSetMarkerList :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMetaContainer a, IsMarkerList b) =>
a -> Text -> b -> m Bool
metaContainerSetMarkerList a
container Text
metaItem b
list = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr MarkerList
list' <- b -> IO (Ptr MarkerList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
list
    CInt
result <- Ptr MetaContainer -> CString -> Ptr MarkerList -> IO CInt
ges_meta_container_set_marker_list Ptr MetaContainer
container' CString
metaItem' Ptr MarkerList
list'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerSetMarkerListMethodInfo
instance (signature ~ (T.Text -> b -> m Bool), MonadIO m, IsMetaContainer a, GES.MarkerList.IsMarkerList b) => O.OverloadedMethod MetaContainerSetMarkerListMethodInfo a signature where
    overloadedMethod = metaContainerSetMarkerList

instance O.OverloadedMethodInfo MetaContainerSetMarkerListMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerSetMarkerList",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerSetMarkerList"
        })


#endif

-- method MetaContainer::set_meta
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The value to set under @meta_item, or %NULL to\nremove the corresponding field"
--                 , 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 "ges_meta_container_set_meta" ges_meta_container_set_meta :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    IO CInt

-- | Sets the value of the specified field of the meta container to a
-- copy of the given value. If the given /@value@/ is 'P.Nothing', the field
-- given by /@metaItem@/ is removed and 'P.True' is returned.
metaContainerSetMeta ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to set
    -> Maybe (GValue)
    -- ^ /@value@/: The value to set under /@metaItem@/, or 'P.Nothing' to
    -- remove the corresponding field
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@value@/ was set under /@metaItem@/ for /@container@/.
metaContainerSetMeta :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> Maybe GValue -> m Bool
metaContainerSetMeta a
container Text
metaItem Maybe GValue
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    Ptr GValue
maybeValue <- case Maybe GValue
value of
        Maybe GValue
Nothing -> Ptr GValue -> IO (Ptr GValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GValue
forall a. Ptr a
nullPtr
        Just GValue
jValue -> do
            Ptr GValue
jValue' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
jValue
            Ptr GValue -> IO (Ptr GValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GValue
jValue'
    CInt
result <- Ptr MetaContainer -> CString -> Ptr GValue -> IO CInt
ges_meta_container_set_meta Ptr MetaContainer
container' CString
metaItem' Ptr GValue
maybeValue
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    Maybe GValue -> (GValue -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GValue
value GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerSetMetaMethodInfo
instance (signature ~ (T.Text -> Maybe (GValue) -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerSetMetaMethodInfo a signature where
    overloadedMethod = metaContainerSetMeta

instance O.OverloadedMethodInfo MetaContainerSetMetaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerSetMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerSetMeta"
        })


#endif

-- method MetaContainer::set_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set under @meta_item"
--                 , 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 "ges_meta_container_set_string" ges_meta_container_set_string :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    CString ->                              -- value : TBasicType TUTF8
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given string value.
metaContainerSetString ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to set
    -> T.Text
    -- ^ /@value@/: The value to set under /@metaItem@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@value@/ was set under /@metaItem@/ for /@container@/.
metaContainerSetString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> Text -> m Bool
metaContainerSetString a
container Text
metaItem Text
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    CString
value' <- Text -> IO CString
textToCString Text
value
    CInt
result <- Ptr MetaContainer -> CString -> CString -> IO CInt
ges_meta_container_set_string Ptr MetaContainer
container' CString
metaItem' CString
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerSetStringMethodInfo
instance (signature ~ (T.Text -> T.Text -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerSetStringMethodInfo a signature where
    overloadedMethod = metaContainerSetString

instance O.OverloadedMethodInfo MetaContainerSetStringMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerSetString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerSetString"
        })


#endif

-- method MetaContainer::set_uint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set under @meta_item"
--                 , 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 "ges_meta_container_set_uint" ges_meta_container_set_uint :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Word32 ->                               -- value : TBasicType TUInt
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given uint value.
metaContainerSetUint ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to set
    -> Word32
    -- ^ /@value@/: The value to set under /@metaItem@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@value@/ was set under /@metaItem@/ for /@container@/.
metaContainerSetUint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> Word32 -> m Bool
metaContainerSetUint a
container Text
metaItem Word32
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    CInt
result <- Ptr MetaContainer -> CString -> Word32 -> IO CInt
ges_meta_container_set_uint Ptr MetaContainer
container' CString
metaItem' Word32
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerSetUintMethodInfo
instance (signature ~ (T.Text -> Word32 -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerSetUintMethodInfo a signature where
    overloadedMethod = metaContainerSetUint

instance O.OverloadedMethodInfo MetaContainerSetUintMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerSetUint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerSetUint"
        })


#endif

-- method MetaContainer::set_uint64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "MetaContainer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESMetaContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "meta_item"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the @container field to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The value to set under @meta_item"
--                 , 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 "ges_meta_container_set_uint64" ges_meta_container_set_uint64 :: 
    Ptr MetaContainer ->                    -- container : TInterface (Name {namespace = "GES", name = "MetaContainer"})
    CString ->                              -- meta_item : TBasicType TUTF8
    Word64 ->                               -- value : TBasicType TUInt64
    IO CInt

-- | Sets the value of the specified field of the meta container to the
-- given uint64 value.
metaContainerSetUint64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsMetaContainer a) =>
    a
    -- ^ /@container@/: A t'GI.GES.Interfaces.MetaContainer.MetaContainer'
    -> T.Text
    -- ^ /@metaItem@/: The key for the /@container@/ field to set
    -> Word64
    -- ^ /@value@/: The value to set under /@metaItem@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@value@/ was set under /@metaItem@/ for /@container@/.
metaContainerSetUint64 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMetaContainer a) =>
a -> Text -> CGType -> m Bool
metaContainerSetUint64 a
container Text
metaItem CGType
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaContainer
container' <- a -> IO (Ptr MetaContainer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
metaItem' <- Text -> IO CString
textToCString Text
metaItem
    CInt
result <- Ptr MetaContainer -> CString -> CGType -> IO CInt
ges_meta_container_set_uint64 Ptr MetaContainer
container' CString
metaItem' CGType
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
metaItem'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MetaContainerSetUint64MethodInfo
instance (signature ~ (T.Text -> Word64 -> m Bool), MonadIO m, IsMetaContainer a) => O.OverloadedMethod MetaContainerSetUint64MethodInfo a signature where
    overloadedMethod = metaContainerSetUint64

instance O.OverloadedMethodInfo MetaContainerSetUint64MethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer.metaContainerSetUint64",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#v:metaContainerSetUint64"
        })


#endif

-- signal MetaContainer::notify-meta
-- | This is emitted for a meta container whenever the metadata under one
-- of its fields changes, is set for the first time, or is removed. In
-- the latter case, /@value@/ will be 'P.Nothing'.
type MetaContainerNotifyMetaCallback =
    T.Text
    -- ^ /@key@/: The key for the /@container@/ field that changed
    -> Maybe GValue
    -- ^ /@value@/: The new value under /@key@/
    -> IO ()

type C_MetaContainerNotifyMetaCallback =
    Ptr MetaContainer ->                    -- object
    CString ->
    Ptr GValue ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_MetaContainerNotifyMetaCallback`.
foreign import ccall "wrapper"
    mk_MetaContainerNotifyMetaCallback :: C_MetaContainerNotifyMetaCallback -> IO (FunPtr C_MetaContainerNotifyMetaCallback)

wrap_MetaContainerNotifyMetaCallback :: 
    GObject a => (a -> MetaContainerNotifyMetaCallback) ->
    C_MetaContainerNotifyMetaCallback
wrap_MetaContainerNotifyMetaCallback :: forall a.
GObject a =>
(a -> MetaContainerNotifyMetaCallback) -> C_MetaForeachFunc
wrap_MetaContainerNotifyMetaCallback a -> MetaContainerNotifyMetaCallback
gi'cb Ptr MetaContainer
gi'selfPtr CString
key Ptr GValue
value Ptr ()
_ = do
    Text
key' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
key
    Maybe GValue
maybeValue <-
        if Ptr GValue
value Ptr GValue -> Ptr GValue -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr GValue
forall a. Ptr a
nullPtr
        then Maybe GValue -> IO (Maybe GValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GValue
forall a. Maybe a
Nothing
        else do
            GValue
value' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
value
            Maybe GValue -> IO (Maybe GValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GValue -> IO (Maybe GValue))
-> Maybe GValue -> IO (Maybe GValue)
forall a b. (a -> b) -> a -> b
$ GValue -> Maybe GValue
forall a. a -> Maybe a
Just GValue
value'
    Ptr MetaContainer -> (MetaContainer -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr MetaContainer
gi'selfPtr ((MetaContainer -> IO ()) -> IO ())
-> (MetaContainer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \MetaContainer
gi'self -> a -> MetaContainerNotifyMetaCallback
gi'cb (MetaContainer -> a
forall a b. Coercible a b => a -> b
Coerce.coerce MetaContainer
gi'self)  Text
key' Maybe GValue
maybeValue


-- | Connect a signal handler for the [notifyMeta](#signal:notifyMeta) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' metaContainer #notifyMeta callback
-- @
-- 
-- This signal admits a optional parameter @detail@.
-- If it's not @Nothing@, we will connect to “@notify-meta::detail@” instead.
-- 
onMetaContainerNotifyMeta :: (IsMetaContainer a, MonadIO m) => a -> P.Maybe T.Text -> ((?self :: a) => MetaContainerNotifyMetaCallback) -> m SignalHandlerId
onMetaContainerNotifyMeta :: forall a (m :: * -> *).
(IsMetaContainer a, MonadIO m) =>
a
-> Maybe Text
-> ((?self::a) => MetaContainerNotifyMetaCallback)
-> m SignalHandlerId
onMetaContainerNotifyMeta a
obj Maybe Text
detail (?self::a) => MetaContainerNotifyMetaCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MetaContainerNotifyMetaCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MetaContainerNotifyMetaCallback
MetaContainerNotifyMetaCallback
cb
    let wrapped' :: C_MetaForeachFunc
wrapped' = (a -> MetaContainerNotifyMetaCallback) -> C_MetaForeachFunc
forall a.
GObject a =>
(a -> MetaContainerNotifyMetaCallback) -> C_MetaForeachFunc
wrap_MetaContainerNotifyMetaCallback a -> MetaContainerNotifyMetaCallback
wrapped
    FunPtr C_MetaForeachFunc
wrapped'' <- C_MetaForeachFunc -> IO (FunPtr C_MetaForeachFunc)
mk_MetaContainerNotifyMetaCallback C_MetaForeachFunc
wrapped'
    a
-> Text
-> FunPtr C_MetaForeachFunc
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"notify-meta" FunPtr C_MetaForeachFunc
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
detail

-- | Connect a signal handler for the [notifyMeta](#signal:notifyMeta) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' metaContainer #notifyMeta callback
-- @
-- 
-- This signal admits a optional parameter @detail@.
-- If it's not @Nothing@, we will connect to “@notify-meta::detail@” instead.
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterMetaContainerNotifyMeta :: (IsMetaContainer a, MonadIO m) => a -> P.Maybe T.Text -> ((?self :: a) => MetaContainerNotifyMetaCallback) -> m SignalHandlerId
afterMetaContainerNotifyMeta :: forall a (m :: * -> *).
(IsMetaContainer a, MonadIO m) =>
a
-> Maybe Text
-> ((?self::a) => MetaContainerNotifyMetaCallback)
-> m SignalHandlerId
afterMetaContainerNotifyMeta a
obj Maybe Text
detail (?self::a) => MetaContainerNotifyMetaCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> MetaContainerNotifyMetaCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => MetaContainerNotifyMetaCallback
MetaContainerNotifyMetaCallback
cb
    let wrapped' :: C_MetaForeachFunc
wrapped' = (a -> MetaContainerNotifyMetaCallback) -> C_MetaForeachFunc
forall a.
GObject a =>
(a -> MetaContainerNotifyMetaCallback) -> C_MetaForeachFunc
wrap_MetaContainerNotifyMetaCallback a -> MetaContainerNotifyMetaCallback
wrapped
    FunPtr C_MetaForeachFunc
wrapped'' <- C_MetaForeachFunc -> IO (FunPtr C_MetaForeachFunc)
mk_MetaContainerNotifyMetaCallback C_MetaForeachFunc
wrapped'
    a
-> Text
-> FunPtr C_MetaForeachFunc
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"notify-meta" FunPtr C_MetaForeachFunc
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
detail


#if defined(ENABLE_OVERLOADING)
data MetaContainerNotifyMetaSignalInfo
instance SignalInfo MetaContainerNotifyMetaSignalInfo where
    type HaskellCallbackType MetaContainerNotifyMetaSignalInfo = MetaContainerNotifyMetaCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MetaContainerNotifyMetaCallback cb
        cb'' <- mk_MetaContainerNotifyMetaCallback cb'
        connectSignalFunPtr obj "notify-meta" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Interfaces.MetaContainer::notify-meta"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Interfaces-MetaContainer.html#g:signal:notifyMeta"})

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList MetaContainer = MetaContainerSignalList
type MetaContainerSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo), '("notifyMeta", MetaContainerNotifyMetaSignalInfo)] :: [(Symbol, DK.Type)])

#endif