{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.GES.Objects.Group.Group' controls one or more t'GI.GES.Objects.Container.Container'-s (usually t'GI.GES.Objects.Clip.Clip'-s,
-- but it can also control other t'GI.GES.Objects.Group.Group'-s). Its children must share
-- the same t'GI.GES.Objects.Timeline.Timeline', but can otherwise lie in separate t'GI.GES.Objects.Layer.Layer'-s
-- and have different timings.
-- 
-- To initialise a group, you may want to use 'GI.GES.Objects.Container.containerGroup',
-- and similarly use 'GI.GES.Objects.Container.containerUngroup' to dispose of it.
-- 
-- A group will maintain the relative [TimelineElement:start]("GI.GES.Objects.TimelineElement#g:attr:start") times of
-- its children, as well as their relative layer [Layer:priority]("GI.GES.Objects.Layer#g:attr:priority").
-- Therefore, if one of its children has its [TimelineElement:start]("GI.GES.Objects.TimelineElement#g:attr:start")
-- set, all other children will have their [TimelineElement:start]("GI.GES.Objects.TimelineElement#g:attr:start")
-- shifted by the same amount. Similarly, if one of its children moves to
-- a new layer, the other children will also change layers to maintain the
-- difference in their layer priorities. For example, if a child moves
-- from a layer with [Layer:priority]("GI.GES.Objects.Layer#g:attr:priority") 1 to a layer with priority 3, then
-- another child that was in a layer with priority 0 will move to the
-- layer with priority 2.
-- 
-- The [Group:start]("GI.GES.Objects.Group#g:attr:start") of a group refers to the earliest start
-- time of its children. If the group\'s [Group:start]("GI.GES.Objects.Group#g:attr:start") is set, all the
-- children will be shifted equally such that the earliest start time
-- will match the set value. The [Group:duration]("GI.GES.Objects.Group#g:attr:duration") of a group is the
-- difference between the earliest start time and latest end time of its
-- children. If the group\'s [Group:duration]("GI.GES.Objects.Group#g:attr:duration") is increased, the children
-- whose end time matches the end of the group will be extended
-- accordingly. If it is decreased, then any child whose end time exceeds
-- the new end time will also have their duration decreased accordingly.
-- 
-- A group may span several layers, but for methods such as
-- 'GI.GES.Objects.TimelineElement.timelineElementGetLayerPriority' and
-- 'GI.GES.Objects.TimelineElement.timelineElementEdit' a group is considered to have a layer
-- priority that is the highest [Layer:priority]("GI.GES.Objects.Layer#g:attr:priority") (numerically, the
-- smallest) of all the layers it spans.

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

module GI.GES.Objects.Group
    ( 

-- * Exported types
    Group(..)                               ,
    IsGroup                                 ,
    toGroup                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [add]("GI.GES.Objects.Container#g:method:add"), [addChildProperty]("GI.GES.Objects.TimelineElement#g:method:addChildProperty"), [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"), [copy]("GI.GES.Objects.TimelineElement#g:method:copy"), [edit]("GI.GES.Objects.Container#g:method:edit"), [editFull]("GI.GES.Objects.TimelineElement#g:method:editFull"), [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"), [listChildrenProperties]("GI.GES.Objects.TimelineElement#g:method:listChildrenProperties"), [lookupChild]("GI.GES.Objects.TimelineElement#g:method:lookupChild"), [metasToString]("GI.GES.Interfaces.MetaContainer#g:method:metasToString"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [paste]("GI.GES.Objects.TimelineElement#g:method:paste"), [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"), [remove]("GI.GES.Objects.Container#g:method:remove"), [removeChildProperty]("GI.GES.Objects.TimelineElement#g:method:removeChildProperty"), [ripple]("GI.GES.Objects.TimelineElement#g:method:ripple"), [rippleEnd]("GI.GES.Objects.TimelineElement#g:method:rippleEnd"), [rollEnd]("GI.GES.Objects.TimelineElement#g:method:rollEnd"), [rollStart]("GI.GES.Objects.TimelineElement#g:method:rollStart"), [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"), [trim]("GI.GES.Objects.TimelineElement#g:method:trim"), [ungroup]("GI.GES.Objects.Container#g:method:ungroup"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAsset]("GI.GES.Interfaces.Extractable#g:method:getAsset"), [getBoolean]("GI.GES.Interfaces.MetaContainer#g:method:getBoolean"), [getChildProperty]("GI.GES.Objects.TimelineElement#g:method:getChildProperty"), [getChildPropertyByPspec]("GI.GES.Objects.TimelineElement#g:method:getChildPropertyByPspec"), [getChildren]("GI.GES.Objects.Container#g:method:getChildren"), [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"), [getDuration]("GI.GES.Objects.TimelineElement#g:method:getDuration"), [getFloat]("GI.GES.Interfaces.MetaContainer#g:method:getFloat"), [getId]("GI.GES.Interfaces.Extractable#g:method:getId"), [getInpoint]("GI.GES.Objects.TimelineElement#g:method:getInpoint"), [getInt]("GI.GES.Interfaces.MetaContainer#g:method:getInt"), [getInt64]("GI.GES.Interfaces.MetaContainer#g:method:getInt64"), [getLayerPriority]("GI.GES.Objects.TimelineElement#g:method:getLayerPriority"), [getMarkerList]("GI.GES.Interfaces.MetaContainer#g:method:getMarkerList"), [getMaxDuration]("GI.GES.Objects.TimelineElement#g:method:getMaxDuration"), [getMeta]("GI.GES.Interfaces.MetaContainer#g:method:getMeta"), [getName]("GI.GES.Objects.TimelineElement#g:method:getName"), [getNaturalFramerate]("GI.GES.Objects.TimelineElement#g:method:getNaturalFramerate"), [getParent]("GI.GES.Objects.TimelineElement#g:method:getParent"), [getPriority]("GI.GES.Objects.TimelineElement#g:method:getPriority"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getStart]("GI.GES.Objects.TimelineElement#g:method:getStart"), [getString]("GI.GES.Interfaces.MetaContainer#g:method:getString"), [getTimeline]("GI.GES.Objects.TimelineElement#g:method:getTimeline"), [getToplevelParent]("GI.GES.Objects.TimelineElement#g:method:getToplevelParent"), [getTrackTypes]("GI.GES.Objects.TimelineElement#g:method:getTrackTypes"), [getUint]("GI.GES.Interfaces.MetaContainer#g:method:getUint"), [getUint64]("GI.GES.Interfaces.MetaContainer#g:method:getUint64").
-- 
-- ==== Setters
-- [setAsset]("GI.GES.Interfaces.Extractable#g:method:setAsset"), [setBoolean]("GI.GES.Interfaces.MetaContainer#g:method:setBoolean"), [setChildProperty]("GI.GES.Objects.TimelineElement#g:method:setChildProperty"), [setChildPropertyByPspec]("GI.GES.Objects.TimelineElement#g:method:setChildPropertyByPspec"), [setChildPropertyFull]("GI.GES.Objects.TimelineElement#g:method:setChildPropertyFull"), [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"), [setDuration]("GI.GES.Objects.TimelineElement#g:method:setDuration"), [setFloat]("GI.GES.Interfaces.MetaContainer#g:method:setFloat"), [setInpoint]("GI.GES.Objects.TimelineElement#g:method:setInpoint"), [setInt]("GI.GES.Interfaces.MetaContainer#g:method:setInt"), [setInt64]("GI.GES.Interfaces.MetaContainer#g:method:setInt64"), [setMarkerList]("GI.GES.Interfaces.MetaContainer#g:method:setMarkerList"), [setMaxDuration]("GI.GES.Objects.TimelineElement#g:method:setMaxDuration"), [setMeta]("GI.GES.Interfaces.MetaContainer#g:method:setMeta"), [setName]("GI.GES.Objects.TimelineElement#g:method:setName"), [setParent]("GI.GES.Objects.TimelineElement#g:method:setParent"), [setPriority]("GI.GES.Objects.TimelineElement#g:method:setPriority"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setStart]("GI.GES.Objects.TimelineElement#g:method:setStart"), [setString]("GI.GES.Interfaces.MetaContainer#g:method:setString"), [setTimeline]("GI.GES.Objects.TimelineElement#g:method:setTimeline"), [setUint]("GI.GES.Interfaces.MetaContainer#g:method:setUint"), [setUint64]("GI.GES.Interfaces.MetaContainer#g:method:setUint64").

#if defined(ENABLE_OVERLOADING)
    ResolveGroupMethod                      ,
#endif

-- ** new #method:new#

    groupNew                                ,




 -- * Properties


-- ** duration #attr:duration#
-- | An overwrite of the [TimelineElement:duration]("GI.GES.Objects.TimelineElement#g:attr:duration") property. For a
-- t'GI.GES.Objects.Group.Group', this is the difference between the earliest
-- [TimelineElement:start]("GI.GES.Objects.TimelineElement#g:attr:start") time and the latest end time (given by
-- [TimelineElement:start]("GI.GES.Objects.TimelineElement#g:attr:start") + [TimelineElement:duration]("GI.GES.Objects.TimelineElement#g:attr:duration")) amongst
-- its children.

#if defined(ENABLE_OVERLOADING)
    GroupDurationPropertyInfo               ,
#endif
    constructGroupDuration                  ,
    getGroupDuration                        ,
#if defined(ENABLE_OVERLOADING)
    groupDuration                           ,
#endif
    setGroupDuration                        ,


-- ** inPoint #attr:inPoint#
-- | An overwrite of the [TimelineElement:inPoint]("GI.GES.Objects.TimelineElement#g:attr:inPoint") property. This has
-- no meaning for a group and should not be set.

#if defined(ENABLE_OVERLOADING)
    GroupInPointPropertyInfo                ,
#endif
    constructGroupInPoint                   ,
    getGroupInPoint                         ,
#if defined(ENABLE_OVERLOADING)
    groupInPoint                            ,
#endif
    setGroupInPoint                         ,


-- ** maxDuration #attr:maxDuration#
-- | An overwrite of the [TimelineElement:maxDuration]("GI.GES.Objects.TimelineElement#g:attr:maxDuration") property. This
-- has no meaning for a group and should not be set.

#if defined(ENABLE_OVERLOADING)
    GroupMaxDurationPropertyInfo            ,
#endif
    constructGroupMaxDuration               ,
    getGroupMaxDuration                     ,
#if defined(ENABLE_OVERLOADING)
    groupMaxDuration                        ,
#endif
    setGroupMaxDuration                     ,


-- ** priority #attr:priority#
-- | An overwrite of the [TimelineElement:priority]("GI.GES.Objects.TimelineElement#g:attr:priority") property.
-- Setting t'GI.GES.Objects.TimelineElement.TimelineElement' priorities is deprecated as all priority
-- management is now done by GES itself.

#if defined(ENABLE_OVERLOADING)
    GroupPriorityPropertyInfo               ,
#endif
    constructGroupPriority                  ,
    getGroupPriority                        ,
#if defined(ENABLE_OVERLOADING)
    groupPriority                           ,
#endif
    setGroupPriority                        ,


-- ** start #attr:start#
-- | An overwrite of the [TimelineElement:start]("GI.GES.Objects.TimelineElement#g:attr:start") property. For a
-- t'GI.GES.Objects.Group.Group', this is the earliest [TimelineElement:start]("GI.GES.Objects.TimelineElement#g:attr:start") time
-- amongst its children.

#if defined(ENABLE_OVERLOADING)
    GroupStartPropertyInfo                  ,
#endif
    constructGroupStart                     ,
    getGroupStart                           ,
#if defined(ENABLE_OVERLOADING)
    groupStart                              ,
#endif
    setGroupStart                           ,




    ) 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 {-# SOURCE #-} qualified GI.GES.Interfaces.Extractable as GES.Extractable
import {-# SOURCE #-} qualified GI.GES.Interfaces.MetaContainer as GES.MetaContainer
import {-# SOURCE #-} qualified GI.GES.Objects.Container as GES.Container
import {-# SOURCE #-} qualified GI.GES.Objects.TimelineElement as GES.TimelineElement
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "ges_group_get_type"
    c_ges_group_get_type :: IO B.Types.GType

instance B.Types.TypedObject Group where
    glibType :: IO GType
glibType = IO GType
c_ges_group_get_type

instance B.Types.GObject Group

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

instance O.HasParentTypes Group
type instance O.ParentTypes Group = '[GES.Container.Container, GES.TimelineElement.TimelineElement, GObject.Object.Object, GES.Extractable.Extractable, GES.MetaContainer.MetaContainer]

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

-- | Convert 'Group' 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 Group) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ges_group_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Group -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Group
P.Nothing = Ptr GValue -> Ptr Group -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Group
forall a. Ptr a
FP.nullPtr :: FP.Ptr Group)
    gvalueSet_ Ptr GValue
gv (P.Just Group
obj) = Group -> (Ptr Group -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Group
obj (Ptr GValue -> Ptr Group -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Group)
gvalueGet_ Ptr GValue
gv = do
        Ptr Group
ptr <- Ptr GValue -> IO (Ptr Group)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Group)
        if Ptr Group
ptr Ptr Group -> Ptr Group -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Group
forall a. Ptr a
FP.nullPtr
        then Group -> Maybe Group
forall a. a -> Maybe a
P.Just (Group -> Maybe Group) -> IO Group -> IO (Maybe Group)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Group -> Group) -> Ptr Group -> IO Group
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Group -> Group
Group Ptr Group
ptr
        else Maybe Group -> IO (Maybe Group)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Group
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveGroupMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveGroupMethod "add" o = GES.Container.ContainerAddMethodInfo
    ResolveGroupMethod "addChildProperty" o = GES.TimelineElement.TimelineElementAddChildPropertyMethodInfo
    ResolveGroupMethod "addMetasFromString" o = GES.MetaContainer.MetaContainerAddMetasFromStringMethodInfo
    ResolveGroupMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveGroupMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveGroupMethod "checkMetaRegistered" o = GES.MetaContainer.MetaContainerCheckMetaRegisteredMethodInfo
    ResolveGroupMethod "copy" o = GES.TimelineElement.TimelineElementCopyMethodInfo
    ResolveGroupMethod "edit" o = GES.Container.ContainerEditMethodInfo
    ResolveGroupMethod "editFull" o = GES.TimelineElement.TimelineElementEditFullMethodInfo
    ResolveGroupMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveGroupMethod "foreach" o = GES.MetaContainer.MetaContainerForeachMethodInfo
    ResolveGroupMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveGroupMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveGroupMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveGroupMethod "listChildrenProperties" o = GES.TimelineElement.TimelineElementListChildrenPropertiesMethodInfo
    ResolveGroupMethod "lookupChild" o = GES.TimelineElement.TimelineElementLookupChildMethodInfo
    ResolveGroupMethod "metasToString" o = GES.MetaContainer.MetaContainerMetasToStringMethodInfo
    ResolveGroupMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveGroupMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveGroupMethod "paste" o = GES.TimelineElement.TimelineElementPasteMethodInfo
    ResolveGroupMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveGroupMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveGroupMethod "registerMeta" o = GES.MetaContainer.MetaContainerRegisterMetaMethodInfo
    ResolveGroupMethod "registerMetaBoolean" o = GES.MetaContainer.MetaContainerRegisterMetaBooleanMethodInfo
    ResolveGroupMethod "registerMetaDate" o = GES.MetaContainer.MetaContainerRegisterMetaDateMethodInfo
    ResolveGroupMethod "registerMetaDateTime" o = GES.MetaContainer.MetaContainerRegisterMetaDateTimeMethodInfo
    ResolveGroupMethod "registerMetaDouble" o = GES.MetaContainer.MetaContainerRegisterMetaDoubleMethodInfo
    ResolveGroupMethod "registerMetaFloat" o = GES.MetaContainer.MetaContainerRegisterMetaFloatMethodInfo
    ResolveGroupMethod "registerMetaInt" o = GES.MetaContainer.MetaContainerRegisterMetaIntMethodInfo
    ResolveGroupMethod "registerMetaInt64" o = GES.MetaContainer.MetaContainerRegisterMetaInt64MethodInfo
    ResolveGroupMethod "registerMetaString" o = GES.MetaContainer.MetaContainerRegisterMetaStringMethodInfo
    ResolveGroupMethod "registerMetaUint" o = GES.MetaContainer.MetaContainerRegisterMetaUintMethodInfo
    ResolveGroupMethod "registerMetaUint64" o = GES.MetaContainer.MetaContainerRegisterMetaUint64MethodInfo
    ResolveGroupMethod "registerStaticMeta" o = GES.MetaContainer.MetaContainerRegisterStaticMetaMethodInfo
    ResolveGroupMethod "remove" o = GES.Container.ContainerRemoveMethodInfo
    ResolveGroupMethod "removeChildProperty" o = GES.TimelineElement.TimelineElementRemoveChildPropertyMethodInfo
    ResolveGroupMethod "ripple" o = GES.TimelineElement.TimelineElementRippleMethodInfo
    ResolveGroupMethod "rippleEnd" o = GES.TimelineElement.TimelineElementRippleEndMethodInfo
    ResolveGroupMethod "rollEnd" o = GES.TimelineElement.TimelineElementRollEndMethodInfo
    ResolveGroupMethod "rollStart" o = GES.TimelineElement.TimelineElementRollStartMethodInfo
    ResolveGroupMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveGroupMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveGroupMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveGroupMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveGroupMethod "trim" o = GES.TimelineElement.TimelineElementTrimMethodInfo
    ResolveGroupMethod "ungroup" o = GES.Container.ContainerUngroupMethodInfo
    ResolveGroupMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveGroupMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveGroupMethod "getAsset" o = GES.Extractable.ExtractableGetAssetMethodInfo
    ResolveGroupMethod "getBoolean" o = GES.MetaContainer.MetaContainerGetBooleanMethodInfo
    ResolveGroupMethod "getChildProperty" o = GES.TimelineElement.TimelineElementGetChildPropertyMethodInfo
    ResolveGroupMethod "getChildPropertyByPspec" o = GES.TimelineElement.TimelineElementGetChildPropertyByPspecMethodInfo
    ResolveGroupMethod "getChildren" o = GES.Container.ContainerGetChildrenMethodInfo
    ResolveGroupMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveGroupMethod "getDate" o = GES.MetaContainer.MetaContainerGetDateMethodInfo
    ResolveGroupMethod "getDateTime" o = GES.MetaContainer.MetaContainerGetDateTimeMethodInfo
    ResolveGroupMethod "getDouble" o = GES.MetaContainer.MetaContainerGetDoubleMethodInfo
    ResolveGroupMethod "getDuration" o = GES.TimelineElement.TimelineElementGetDurationMethodInfo
    ResolveGroupMethod "getFloat" o = GES.MetaContainer.MetaContainerGetFloatMethodInfo
    ResolveGroupMethod "getId" o = GES.Extractable.ExtractableGetIdMethodInfo
    ResolveGroupMethod "getInpoint" o = GES.TimelineElement.TimelineElementGetInpointMethodInfo
    ResolveGroupMethod "getInt" o = GES.MetaContainer.MetaContainerGetIntMethodInfo
    ResolveGroupMethod "getInt64" o = GES.MetaContainer.MetaContainerGetInt64MethodInfo
    ResolveGroupMethod "getLayerPriority" o = GES.TimelineElement.TimelineElementGetLayerPriorityMethodInfo
    ResolveGroupMethod "getMarkerList" o = GES.MetaContainer.MetaContainerGetMarkerListMethodInfo
    ResolveGroupMethod "getMaxDuration" o = GES.TimelineElement.TimelineElementGetMaxDurationMethodInfo
    ResolveGroupMethod "getMeta" o = GES.MetaContainer.MetaContainerGetMetaMethodInfo
    ResolveGroupMethod "getName" o = GES.TimelineElement.TimelineElementGetNameMethodInfo
    ResolveGroupMethod "getNaturalFramerate" o = GES.TimelineElement.TimelineElementGetNaturalFramerateMethodInfo
    ResolveGroupMethod "getParent" o = GES.TimelineElement.TimelineElementGetParentMethodInfo
    ResolveGroupMethod "getPriority" o = GES.TimelineElement.TimelineElementGetPriorityMethodInfo
    ResolveGroupMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveGroupMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveGroupMethod "getStart" o = GES.TimelineElement.TimelineElementGetStartMethodInfo
    ResolveGroupMethod "getString" o = GES.MetaContainer.MetaContainerGetStringMethodInfo
    ResolveGroupMethod "getTimeline" o = GES.TimelineElement.TimelineElementGetTimelineMethodInfo
    ResolveGroupMethod "getToplevelParent" o = GES.TimelineElement.TimelineElementGetToplevelParentMethodInfo
    ResolveGroupMethod "getTrackTypes" o = GES.TimelineElement.TimelineElementGetTrackTypesMethodInfo
    ResolveGroupMethod "getUint" o = GES.MetaContainer.MetaContainerGetUintMethodInfo
    ResolveGroupMethod "getUint64" o = GES.MetaContainer.MetaContainerGetUint64MethodInfo
    ResolveGroupMethod "setAsset" o = GES.Extractable.ExtractableSetAssetMethodInfo
    ResolveGroupMethod "setBoolean" o = GES.MetaContainer.MetaContainerSetBooleanMethodInfo
    ResolveGroupMethod "setChildProperty" o = GES.TimelineElement.TimelineElementSetChildPropertyMethodInfo
    ResolveGroupMethod "setChildPropertyByPspec" o = GES.TimelineElement.TimelineElementSetChildPropertyByPspecMethodInfo
    ResolveGroupMethod "setChildPropertyFull" o = GES.TimelineElement.TimelineElementSetChildPropertyFullMethodInfo
    ResolveGroupMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveGroupMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveGroupMethod "setDate" o = GES.MetaContainer.MetaContainerSetDateMethodInfo
    ResolveGroupMethod "setDateTime" o = GES.MetaContainer.MetaContainerSetDateTimeMethodInfo
    ResolveGroupMethod "setDouble" o = GES.MetaContainer.MetaContainerSetDoubleMethodInfo
    ResolveGroupMethod "setDuration" o = GES.TimelineElement.TimelineElementSetDurationMethodInfo
    ResolveGroupMethod "setFloat" o = GES.MetaContainer.MetaContainerSetFloatMethodInfo
    ResolveGroupMethod "setInpoint" o = GES.TimelineElement.TimelineElementSetInpointMethodInfo
    ResolveGroupMethod "setInt" o = GES.MetaContainer.MetaContainerSetIntMethodInfo
    ResolveGroupMethod "setInt64" o = GES.MetaContainer.MetaContainerSetInt64MethodInfo
    ResolveGroupMethod "setMarkerList" o = GES.MetaContainer.MetaContainerSetMarkerListMethodInfo
    ResolveGroupMethod "setMaxDuration" o = GES.TimelineElement.TimelineElementSetMaxDurationMethodInfo
    ResolveGroupMethod "setMeta" o = GES.MetaContainer.MetaContainerSetMetaMethodInfo
    ResolveGroupMethod "setName" o = GES.TimelineElement.TimelineElementSetNameMethodInfo
    ResolveGroupMethod "setParent" o = GES.TimelineElement.TimelineElementSetParentMethodInfo
    ResolveGroupMethod "setPriority" o = GES.TimelineElement.TimelineElementSetPriorityMethodInfo
    ResolveGroupMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveGroupMethod "setStart" o = GES.TimelineElement.TimelineElementSetStartMethodInfo
    ResolveGroupMethod "setString" o = GES.MetaContainer.MetaContainerSetStringMethodInfo
    ResolveGroupMethod "setTimeline" o = GES.TimelineElement.TimelineElementSetTimelineMethodInfo
    ResolveGroupMethod "setUint" o = GES.MetaContainer.MetaContainerSetUintMethodInfo
    ResolveGroupMethod "setUint64" o = GES.MetaContainer.MetaContainerSetUint64MethodInfo
    ResolveGroupMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

--- XXX Duplicated object with different types:
  --- Name {namespace = "GES", name = "Group"} -> Property {propName = "duration", propType = TBasicType TUInt64, propFlags = [PropertyReadable,PropertyWritable], propReadNullable = Nothing, propWriteNullable = Nothing, propTransfer = TransferNothing, propDoc = Documentation {rawDocText = Just "An overwrite of the #GESTimelineElement:duration property. For a\n#GESGroup, this is the difference between the earliest\n#GESTimelineElement:start time and the latest end time (given by\n#GESTimelineElement:start + #GESTimelineElement:duration) amongst\nits children.", sinceVersion = Nothing}, propDeprecated = Nothing}
  --- Name {namespace = "GES", name = "TimelineElement"} -> Property {propName = "duration", propType = TBasicType TUInt64, propFlags = [PropertyReadable,PropertyWritable], propReadNullable = Just False, propWriteNullable = Nothing, propTransfer = TransferNothing, propDoc = Documentation {rawDocText = Just "The duration that the element is in effect for in the timeline (a\ntime difference in nanoseconds using the time coordinates of the\ntimeline). For example, for a source element, this would determine\nfor how long it should output its internal content for. For an\noperation element, this would determine for how long its effect\nshould be applied to any source content.", sinceVersion = Nothing}, propDeprecated = Nothing}
--- XXX Duplicated object with different types:
  --- Name {namespace = "GES", name = "Group"} -> Property {propName = "in-point", propType = TBasicType TUInt64, propFlags = [PropertyReadable,PropertyWritable], propReadNullable = Nothing, propWriteNullable = Nothing, propTransfer = TransferNothing, propDoc = Documentation {rawDocText = Just "An overwrite of the #GESTimelineElement:in-point property. This has\nno meaning for a group and should not be set.", sinceVersion = Nothing}, propDeprecated = Nothing}
  --- Name {namespace = "GES", name = "TimelineElement"} -> Property {propName = "in-point", propType = TBasicType TUInt64, propFlags = [PropertyReadable,PropertyWritable], propReadNullable = Nothing, propWriteNullable = Nothing, propTransfer = TransferNothing, propDoc = Documentation {rawDocText = Just "The initial offset to use internally when outputting content (in\nnanoseconds, but in the time coordinates of the internal content).\n\nFor example, for a #GESVideoUriSource that references some media\nfile, the \"internal content\" is the media file data, and the\nin-point would correspond to some timestamp in the media file.\nWhen playing the timeline, and when the element is first reached at\ntimeline-time #GESTimelineElement:start, it will begin outputting the\ndata from the timestamp in-point **onwards**, until it reaches the\nend of its #GESTimelineElement:duration in the timeline.\n\nFor elements that have no internal content, this should be kept\nas 0.", sinceVersion = Nothing}, propDeprecated = Nothing}
--- XXX Duplicated object with different types:
  --- Name {namespace = "GES", name = "Group"} -> Property {propName = "max-duration", propType = TBasicType TUInt64, propFlags = [PropertyReadable,PropertyWritable,PropertyConstruct], propReadNullable = Nothing, propWriteNullable = Nothing, propTransfer = TransferNothing, propDoc = Documentation {rawDocText = Just "An overwrite of the #GESTimelineElement:max-duration property. This\nhas no meaning for a group and should not be set.", sinceVersion = Nothing}, propDeprecated = Nothing}
  --- Name {namespace = "GES", name = "TimelineElement"} -> Property {propName = "max-duration", propType = TBasicType TUInt64, propFlags = [PropertyReadable,PropertyWritable,PropertyConstruct], propReadNullable = Just False, propWriteNullable = Nothing, propTransfer = TransferNothing, propDoc = Documentation {rawDocText = Just "The full duration of internal content that is available (a time\ndifference in nanoseconds using the time coordinates of the internal\ncontent).\n\nThis will act as a cap on the #GESTimelineElement:in-point of the\nelement (which is in the same time coordinates), and will sometimes\nbe used to limit the #GESTimelineElement:duration of the element in\nthe timeline.\n\nFor example, for a #GESVideoUriSource that references some media\nfile, this would be the length of the media file.\n\nFor elements that have no internal content, or whose content is\nindefinite, this should be kept as #GST_CLOCK_TIME_NONE.", sinceVersion = Nothing}, propDeprecated = Nothing}
--- XXX Duplicated object with different types:
  --- Name {namespace = "GES", name = "Group"} -> Property {propName = "priority", propType = TBasicType TUInt, propFlags = [PropertyReadable,PropertyWritable], propReadNullable = Nothing, propWriteNullable = Nothing, propTransfer = TransferNothing, propDoc = Documentation {rawDocText = Just "An overwrite of the #GESTimelineElement:priority property.\nSetting #GESTimelineElement priorities is deprecated as all priority\nmanagement is now done by GES itself.", sinceVersion = Nothing}, propDeprecated = Nothing}
  --- Name {namespace = "GES", name = "TimelineElement"} -> Property {propName = "priority", propType = TBasicType TUInt, propFlags = [PropertyReadable,PropertyWritable], propReadNullable = Nothing, propWriteNullable = Nothing, propTransfer = TransferNothing, propDoc = Documentation {rawDocText = Just "The priority of the element.", sinceVersion = Nothing}, propDeprecated = Just (DeprecationInfo {deprecatedSinceVersion = Just "1.10", deprecationMessage = Just "Priority management is now done by GES itself."})}
--- XXX Duplicated object with different types:
  --- Name {namespace = "GES", name = "Group"} -> Property {propName = "start", propType = TBasicType TUInt64, propFlags = [PropertyReadable,PropertyWritable], propReadNullable = Nothing, propWriteNullable = Nothing, propTransfer = TransferNothing, propDoc = Documentation {rawDocText = Just "An overwrite of the #GESTimelineElement:start property. For a\n#GESGroup, this is the earliest #GESTimelineElement:start time\namongst its children.", sinceVersion = Nothing}, propDeprecated = Nothing}
  --- Name {namespace = "GES", name = "TimelineElement"} -> Property {propName = "start", propType = TBasicType TUInt64, propFlags = [PropertyReadable,PropertyWritable], propReadNullable = Just False, propWriteNullable = Nothing, propTransfer = TransferNothing, propDoc = Documentation {rawDocText = Just "The starting position of the element in the timeline (in nanoseconds\nand in the time coordinates of the timeline). For example, for a\nsource element, this would determine the time at which it should\nstart outputting its internal content. For an operation element, this\nwould determine the time at which it should start applying its effect\nto any source content.", sinceVersion = Nothing}, propDeprecated = Nothing}
-- VVV Prop "duration"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@duration@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' group #duration
-- @
getGroupDuration :: (MonadIO m, IsGroup o) => o -> m Word64
getGroupDuration :: forall (m :: * -> *) o. (MonadIO m, IsGroup o) => o -> m Word64
getGroupDuration o
obj = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"duration"

-- | Set the value of the “@duration@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' group [ #duration 'Data.GI.Base.Attributes.:=' value ]
-- @
setGroupDuration :: (MonadIO m, IsGroup o) => o -> Word64 -> m ()
setGroupDuration :: forall (m :: * -> *) o.
(MonadIO m, IsGroup o) =>
o -> Word64 -> m ()
setGroupDuration o
obj Word64
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"duration" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@duration@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructGroupDuration :: (IsGroup o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructGroupDuration :: forall o (m :: * -> *).
(IsGroup o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructGroupDuration Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"duration" Word64
val

#if defined(ENABLE_OVERLOADING)
data GroupDurationPropertyInfo
instance AttrInfo GroupDurationPropertyInfo where
    type AttrAllowedOps GroupDurationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GroupDurationPropertyInfo = IsGroup
    type AttrSetTypeConstraint GroupDurationPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint GroupDurationPropertyInfo = (~) Word64
    type AttrTransferType GroupDurationPropertyInfo = Word64
    type AttrGetType GroupDurationPropertyInfo = Word64
    type AttrLabel GroupDurationPropertyInfo = "duration"
    type AttrOrigin GroupDurationPropertyInfo = Group
    attrGet = getGroupDuration
    attrSet = setGroupDuration
    attrTransfer _ v = do
        return v
    attrConstruct = constructGroupDuration
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Group.duration"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Group.html#g:attr:duration"
        })
#endif

-- VVV Prop "in-point"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@in-point@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' group #inPoint
-- @
getGroupInPoint :: (MonadIO m, IsGroup o) => o -> m Word64
getGroupInPoint :: forall (m :: * -> *) o. (MonadIO m, IsGroup o) => o -> m Word64
getGroupInPoint o
obj = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"in-point"

-- | Set the value of the “@in-point@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' group [ #inPoint 'Data.GI.Base.Attributes.:=' value ]
-- @
setGroupInPoint :: (MonadIO m, IsGroup o) => o -> Word64 -> m ()
setGroupInPoint :: forall (m :: * -> *) o.
(MonadIO m, IsGroup o) =>
o -> Word64 -> m ()
setGroupInPoint o
obj Word64
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"in-point" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@in-point@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructGroupInPoint :: (IsGroup o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructGroupInPoint :: forall o (m :: * -> *).
(IsGroup o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructGroupInPoint Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"in-point" Word64
val

#if defined(ENABLE_OVERLOADING)
data GroupInPointPropertyInfo
instance AttrInfo GroupInPointPropertyInfo where
    type AttrAllowedOps GroupInPointPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GroupInPointPropertyInfo = IsGroup
    type AttrSetTypeConstraint GroupInPointPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint GroupInPointPropertyInfo = (~) Word64
    type AttrTransferType GroupInPointPropertyInfo = Word64
    type AttrGetType GroupInPointPropertyInfo = Word64
    type AttrLabel GroupInPointPropertyInfo = "in-point"
    type AttrOrigin GroupInPointPropertyInfo = Group
    attrGet = getGroupInPoint
    attrSet = setGroupInPoint
    attrTransfer _ v = do
        return v
    attrConstruct = constructGroupInPoint
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Group.inPoint"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Group.html#g:attr:inPoint"
        })
#endif

-- VVV Prop "max-duration"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@max-duration@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' group #maxDuration
-- @
getGroupMaxDuration :: (MonadIO m, IsGroup o) => o -> m Word64
getGroupMaxDuration :: forall (m :: * -> *) o. (MonadIO m, IsGroup o) => o -> m Word64
getGroupMaxDuration o
obj = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"max-duration"

-- | Set the value of the “@max-duration@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' group [ #maxDuration 'Data.GI.Base.Attributes.:=' value ]
-- @
setGroupMaxDuration :: (MonadIO m, IsGroup o) => o -> Word64 -> m ()
setGroupMaxDuration :: forall (m :: * -> *) o.
(MonadIO m, IsGroup o) =>
o -> Word64 -> m ()
setGroupMaxDuration o
obj Word64
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"max-duration" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@max-duration@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructGroupMaxDuration :: (IsGroup o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructGroupMaxDuration :: forall o (m :: * -> *).
(IsGroup o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructGroupMaxDuration Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"max-duration" Word64
val

#if defined(ENABLE_OVERLOADING)
data GroupMaxDurationPropertyInfo
instance AttrInfo GroupMaxDurationPropertyInfo where
    type AttrAllowedOps GroupMaxDurationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GroupMaxDurationPropertyInfo = IsGroup
    type AttrSetTypeConstraint GroupMaxDurationPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint GroupMaxDurationPropertyInfo = (~) Word64
    type AttrTransferType GroupMaxDurationPropertyInfo = Word64
    type AttrGetType GroupMaxDurationPropertyInfo = Word64
    type AttrLabel GroupMaxDurationPropertyInfo = "max-duration"
    type AttrOrigin GroupMaxDurationPropertyInfo = Group
    attrGet = getGroupMaxDuration
    attrSet = setGroupMaxDuration
    attrTransfer _ v = do
        return v
    attrConstruct = constructGroupMaxDuration
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Group.maxDuration"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Group.html#g:attr:maxDuration"
        })
#endif

-- VVV Prop "priority"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@priority@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' group #priority
-- @
getGroupPriority :: (MonadIO m, IsGroup o) => o -> m Word32
getGroupPriority :: forall (m :: * -> *) o. (MonadIO m, IsGroup o) => o -> m Word32
getGroupPriority o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"priority"

-- | Set the value of the “@priority@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' group [ #priority 'Data.GI.Base.Attributes.:=' value ]
-- @
setGroupPriority :: (MonadIO m, IsGroup o) => o -> Word32 -> m ()
setGroupPriority :: forall (m :: * -> *) o.
(MonadIO m, IsGroup o) =>
o -> Word32 -> m ()
setGroupPriority o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"priority" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@priority@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructGroupPriority :: (IsGroup o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructGroupPriority :: forall o (m :: * -> *).
(IsGroup o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructGroupPriority Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"priority" Word32
val

#if defined(ENABLE_OVERLOADING)
data GroupPriorityPropertyInfo
instance AttrInfo GroupPriorityPropertyInfo where
    type AttrAllowedOps GroupPriorityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GroupPriorityPropertyInfo = IsGroup
    type AttrSetTypeConstraint GroupPriorityPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint GroupPriorityPropertyInfo = (~) Word32
    type AttrTransferType GroupPriorityPropertyInfo = Word32
    type AttrGetType GroupPriorityPropertyInfo = Word32
    type AttrLabel GroupPriorityPropertyInfo = "priority"
    type AttrOrigin GroupPriorityPropertyInfo = Group
    attrGet = getGroupPriority
    attrSet = setGroupPriority
    attrTransfer _ v = do
        return v
    attrConstruct = constructGroupPriority
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Group.priority"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Group.html#g:attr:priority"
        })
#endif

-- VVV Prop "start"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@start@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' group #start
-- @
getGroupStart :: (MonadIO m, IsGroup o) => o -> m Word64
getGroupStart :: forall (m :: * -> *) o. (MonadIO m, IsGroup o) => o -> m Word64
getGroupStart o
obj = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"start"

-- | Set the value of the “@start@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' group [ #start 'Data.GI.Base.Attributes.:=' value ]
-- @
setGroupStart :: (MonadIO m, IsGroup o) => o -> Word64 -> m ()
setGroupStart :: forall (m :: * -> *) o.
(MonadIO m, IsGroup o) =>
o -> Word64 -> m ()
setGroupStart o
obj Word64
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"start" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@start@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructGroupStart :: (IsGroup o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructGroupStart :: forall o (m :: * -> *).
(IsGroup o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructGroupStart Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"start" Word64
val

#if defined(ENABLE_OVERLOADING)
data GroupStartPropertyInfo
instance AttrInfo GroupStartPropertyInfo where
    type AttrAllowedOps GroupStartPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint GroupStartPropertyInfo = IsGroup
    type AttrSetTypeConstraint GroupStartPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint GroupStartPropertyInfo = (~) Word64
    type AttrTransferType GroupStartPropertyInfo = Word64
    type AttrGetType GroupStartPropertyInfo = Word64
    type AttrLabel GroupStartPropertyInfo = "start"
    type AttrOrigin GroupStartPropertyInfo = Group
    attrGet = getGroupStart
    attrSet = setGroupStart
    attrTransfer _ v = do
        return v
    attrConstruct = constructGroupStart
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Group.start"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Group.html#g:attr:start"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Group
type instance O.AttributeList Group = GroupAttributeList
type GroupAttributeList = ('[ '("duration", GroupDurationPropertyInfo), '("height", GES.Container.ContainerHeightPropertyInfo), '("inPoint", GroupInPointPropertyInfo), '("maxDuration", GroupMaxDurationPropertyInfo), '("name", GES.TimelineElement.TimelineElementNamePropertyInfo), '("parent", GES.TimelineElement.TimelineElementParentPropertyInfo), '("priority", GroupPriorityPropertyInfo), '("serialize", GES.TimelineElement.TimelineElementSerializePropertyInfo), '("start", GroupStartPropertyInfo), '("timeline", GES.TimelineElement.TimelineElementTimelinePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
groupDuration :: AttrLabelProxy "duration"
groupDuration = AttrLabelProxy

groupInPoint :: AttrLabelProxy "inPoint"
groupInPoint = AttrLabelProxy

groupMaxDuration :: AttrLabelProxy "maxDuration"
groupMaxDuration = AttrLabelProxy

groupPriority :: AttrLabelProxy "priority"
groupPriority = AttrLabelProxy

groupStart :: AttrLabelProxy "start"
groupStart = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Group = GroupSignalList
type GroupSignalList = ('[ '("childAdded", GES.Container.ContainerChildAddedSignalInfo), '("childPropertyAdded", GES.TimelineElement.TimelineElementChildPropertyAddedSignalInfo), '("childPropertyRemoved", GES.TimelineElement.TimelineElementChildPropertyRemovedSignalInfo), '("childRemoved", GES.Container.ContainerChildRemovedSignalInfo), '("deepNotify", GES.TimelineElement.TimelineElementDeepNotifySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("notifyMeta", GES.MetaContainer.MetaContainerNotifyMetaSignalInfo)] :: [(Symbol, DK.Type)])

#endif

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

foreign import ccall "ges_group_new" ges_group_new :: 
    IO (Ptr Group)

-- | Created a new empty group. You may wish to use
-- 'GI.GES.Objects.Container.containerGroup' instead, which can return a different
-- t'GI.GES.Objects.Container.Container' subclass if possible.
groupNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Group
    -- ^ __Returns:__ The new empty group.
groupNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Group
groupNew  = IO Group -> m Group
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Group -> m Group) -> IO Group -> m Group
forall a b. (a -> b) -> a -> b
$ do
    Ptr Group
result <- IO (Ptr Group)
ges_group_new
    Text -> Ptr Group -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"groupNew" Ptr Group
result
    Group
result' <- ((ManagedPtr Group -> Group) -> Ptr Group -> IO Group
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Group -> Group
Group) Ptr Group
result
    Group -> IO Group
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Group
result'

#if defined(ENABLE_OVERLOADING)
#endif