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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.GES.Objects.Layer.Layer'-s are responsible for collecting and ordering t'GI.GES.Objects.Clip.Clip'-s.
-- 
-- A layer within a timeline will have an associated priority,
-- corresponding to their index within the timeline. A layer with the
-- index\/priority 0 will have the highest priority and the layer with the
-- largest index will have the lowest priority (the order of priorities,
-- in this sense, is the _reverse_ of the numerical ordering of the
-- indices). 'GI.GES.Objects.Timeline.timelineMoveLayer' should be used if you wish to
-- change how layers are prioritised in a timeline.
-- 
-- Layers with higher priorities will have their content priorities
-- over content from lower priority layers, similar to how layers are
-- used in image editing. For example, if two separate layers both
-- display video content, then the layer with the higher priority will
-- have its images shown first. The other layer will only have its image
-- shown if the higher priority layer has no content at the given
-- playtime, or is transparent in some way. Audio content in separate
-- layers will simply play in addition.

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

module GI.GES.Objects.Layer
    ( 

-- * Exported types
    Layer(..)                               ,
    IsLayer                                 ,
    toLayer                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addAsset]("GI.GES.Objects.Layer#g:method:addAsset"), [addAssetFull]("GI.GES.Objects.Layer#g:method:addAssetFull"), [addClip]("GI.GES.Objects.Layer#g:method:addClip"), [addClipFull]("GI.GES.Objects.Layer#g:method:addClipFull"), [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"), [isEmpty]("GI.GES.Objects.Layer#g:method:isEmpty"), [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"), [removeClip]("GI.GES.Objects.Layer#g:method:removeClip"), [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
-- [getActiveForTrack]("GI.GES.Objects.Layer#g:method:getActiveForTrack"), [getAsset]("GI.GES.Interfaces.Extractable#g:method:getAsset"), [getAutoTransition]("GI.GES.Objects.Layer#g:method:getAutoTransition"), [getBoolean]("GI.GES.Interfaces.MetaContainer#g:method:getBoolean"), [getClips]("GI.GES.Objects.Layer#g:method:getClips"), [getClipsInInterval]("GI.GES.Objects.Layer#g:method:getClipsInInterval"), [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.Layer#g:method:getDuration"), [getFloat]("GI.GES.Interfaces.MetaContainer#g:method:getFloat"), [getId]("GI.GES.Interfaces.Extractable#g:method:getId"), [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"), [getPriority]("GI.GES.Objects.Layer#g:method:getPriority"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getString]("GI.GES.Interfaces.MetaContainer#g:method:getString"), [getTimeline]("GI.GES.Objects.Layer#g:method:getTimeline"), [getUint]("GI.GES.Interfaces.MetaContainer#g:method:getUint"), [getUint64]("GI.GES.Interfaces.MetaContainer#g:method:getUint64").
-- 
-- ==== Setters
-- [setActiveForTracks]("GI.GES.Objects.Layer#g:method:setActiveForTracks"), [setAsset]("GI.GES.Interfaces.Extractable#g:method:setAsset"), [setAutoTransition]("GI.GES.Objects.Layer#g:method:setAutoTransition"), [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"), [setPriority]("GI.GES.Objects.Layer#g:method:setPriority"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setString]("GI.GES.Interfaces.MetaContainer#g:method:setString"), [setTimeline]("GI.GES.Objects.Layer#g:method:setTimeline"), [setUint]("GI.GES.Interfaces.MetaContainer#g:method:setUint"), [setUint64]("GI.GES.Interfaces.MetaContainer#g:method:setUint64").

#if defined(ENABLE_OVERLOADING)
    ResolveLayerMethod                      ,
#endif

-- ** addAsset #method:addAsset#

#if defined(ENABLE_OVERLOADING)
    LayerAddAssetMethodInfo                 ,
#endif
    layerAddAsset                           ,


-- ** addAssetFull #method:addAssetFull#

#if defined(ENABLE_OVERLOADING)
    LayerAddAssetFullMethodInfo             ,
#endif
    layerAddAssetFull                       ,


-- ** addClip #method:addClip#

#if defined(ENABLE_OVERLOADING)
    LayerAddClipMethodInfo                  ,
#endif
    layerAddClip                            ,


-- ** addClipFull #method:addClipFull#

#if defined(ENABLE_OVERLOADING)
    LayerAddClipFullMethodInfo              ,
#endif
    layerAddClipFull                        ,


-- ** getActiveForTrack #method:getActiveForTrack#

#if defined(ENABLE_OVERLOADING)
    LayerGetActiveForTrackMethodInfo        ,
#endif
    layerGetActiveForTrack                  ,


-- ** getAutoTransition #method:getAutoTransition#

#if defined(ENABLE_OVERLOADING)
    LayerGetAutoTransitionMethodInfo        ,
#endif
    layerGetAutoTransition                  ,


-- ** getClips #method:getClips#

#if defined(ENABLE_OVERLOADING)
    LayerGetClipsMethodInfo                 ,
#endif
    layerGetClips                           ,


-- ** getClipsInInterval #method:getClipsInInterval#

#if defined(ENABLE_OVERLOADING)
    LayerGetClipsInIntervalMethodInfo       ,
#endif
    layerGetClipsInInterval                 ,


-- ** getDuration #method:getDuration#

#if defined(ENABLE_OVERLOADING)
    LayerGetDurationMethodInfo              ,
#endif
    layerGetDuration                        ,


-- ** getPriority #method:getPriority#

#if defined(ENABLE_OVERLOADING)
    LayerGetPriorityMethodInfo              ,
#endif
    layerGetPriority                        ,


-- ** getTimeline #method:getTimeline#

#if defined(ENABLE_OVERLOADING)
    LayerGetTimelineMethodInfo              ,
#endif
    layerGetTimeline                        ,


-- ** isEmpty #method:isEmpty#

#if defined(ENABLE_OVERLOADING)
    LayerIsEmptyMethodInfo                  ,
#endif
    layerIsEmpty                            ,


-- ** new #method:new#

    layerNew                                ,


-- ** removeClip #method:removeClip#

#if defined(ENABLE_OVERLOADING)
    LayerRemoveClipMethodInfo               ,
#endif
    layerRemoveClip                         ,


-- ** setActiveForTracks #method:setActiveForTracks#

#if defined(ENABLE_OVERLOADING)
    LayerSetActiveForTracksMethodInfo       ,
#endif
    layerSetActiveForTracks                 ,


-- ** setAutoTransition #method:setAutoTransition#

#if defined(ENABLE_OVERLOADING)
    LayerSetAutoTransitionMethodInfo        ,
#endif
    layerSetAutoTransition                  ,


-- ** setPriority #method:setPriority#

#if defined(ENABLE_OVERLOADING)
    LayerSetPriorityMethodInfo              ,
#endif
    layerSetPriority                        ,


-- ** setTimeline #method:setTimeline#

#if defined(ENABLE_OVERLOADING)
    LayerSetTimelineMethodInfo              ,
#endif
    layerSetTimeline                        ,




 -- * Properties


-- ** autoTransition #attr:autoTransition#
-- | Whether to automatically create a t'GI.GES.Objects.TransitionClip.TransitionClip' whenever two
-- t'GI.GES.Objects.Source.Source'-s that both belong to a t'GI.GES.Objects.Clip.Clip' in the layer overlap.
-- See t'GI.GES.Objects.Timeline.Timeline' for what counts as an overlap.
-- 
-- When a layer is added to a t'GI.GES.Objects.Timeline.Timeline', if this property is left as
-- 'P.False', but the timeline\'s [Timeline:autoTransition]("GI.GES.Objects.Timeline#g:attr:autoTransition") is 'P.True', it
-- will be set to 'P.True' as well.

#if defined(ENABLE_OVERLOADING)
    LayerAutoTransitionPropertyInfo         ,
#endif
    constructLayerAutoTransition            ,
    getLayerAutoTransition                  ,
#if defined(ENABLE_OVERLOADING)
    layerAutoTransition                     ,
#endif
    setLayerAutoTransition                  ,


-- ** priority #attr:priority#
-- | The priority of the layer in the t'GI.GES.Objects.Timeline.Timeline'. 0 is the highest
-- priority. Conceptually, a timeline is a stack of layers,
-- and the priority of the layer represents its position in the stack. Two
-- layers should not have the same priority within a given GESTimeline.
-- 
-- Note that the timeline needs to be committed (with @/ges_timeline_commit/@)
-- for the change to be taken into account.

#if defined(ENABLE_OVERLOADING)
    LayerPriorityPropertyInfo               ,
#endif
    constructLayerPriority                  ,
    getLayerPriority                        ,
#if defined(ENABLE_OVERLOADING)
    layerPriority                           ,
#endif
    setLayerPriority                        ,




 -- * Signals


-- ** activeChanged #signal:activeChanged#

    LayerActiveChangedCallback              ,
#if defined(ENABLE_OVERLOADING)
    LayerActiveChangedSignalInfo            ,
#endif
    afterLayerActiveChanged                 ,
    onLayerActiveChanged                    ,


-- ** clipAdded #signal:clipAdded#

    LayerClipAddedCallback                  ,
#if defined(ENABLE_OVERLOADING)
    LayerClipAddedSignalInfo                ,
#endif
    afterLayerClipAdded                     ,
    onLayerClipAdded                        ,


-- ** clipRemoved #signal:clipRemoved#

    LayerClipRemovedCallback                ,
#if defined(ENABLE_OVERLOADING)
    LayerClipRemovedSignalInfo              ,
#endif
    afterLayerClipRemoved                   ,
    onLayerClipRemoved                      ,




    ) 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.Flags as GES.Flags
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.Asset as GES.Asset
import {-# SOURCE #-} qualified GI.GES.Objects.Clip as GES.Clip
import {-# SOURCE #-} qualified GI.GES.Objects.Timeline as GES.Timeline
import {-# SOURCE #-} qualified GI.GES.Objects.Track as GES.Track
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "ges_layer_get_type"
    c_ges_layer_get_type :: IO B.Types.GType

instance B.Types.TypedObject Layer where
    glibType :: IO GType
glibType = IO GType
c_ges_layer_get_type

instance B.Types.GObject Layer

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveLayerMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveLayerMethod "addAsset" o = LayerAddAssetMethodInfo
    ResolveLayerMethod "addAssetFull" o = LayerAddAssetFullMethodInfo
    ResolveLayerMethod "addClip" o = LayerAddClipMethodInfo
    ResolveLayerMethod "addClipFull" o = LayerAddClipFullMethodInfo
    ResolveLayerMethod "addMetasFromString" o = GES.MetaContainer.MetaContainerAddMetasFromStringMethodInfo
    ResolveLayerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveLayerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveLayerMethod "checkMetaRegistered" o = GES.MetaContainer.MetaContainerCheckMetaRegisteredMethodInfo
    ResolveLayerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveLayerMethod "foreach" o = GES.MetaContainer.MetaContainerForeachMethodInfo
    ResolveLayerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveLayerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveLayerMethod "isEmpty" o = LayerIsEmptyMethodInfo
    ResolveLayerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveLayerMethod "metasToString" o = GES.MetaContainer.MetaContainerMetasToStringMethodInfo
    ResolveLayerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveLayerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveLayerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveLayerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveLayerMethod "registerMeta" o = GES.MetaContainer.MetaContainerRegisterMetaMethodInfo
    ResolveLayerMethod "registerMetaBoolean" o = GES.MetaContainer.MetaContainerRegisterMetaBooleanMethodInfo
    ResolveLayerMethod "registerMetaDate" o = GES.MetaContainer.MetaContainerRegisterMetaDateMethodInfo
    ResolveLayerMethod "registerMetaDateTime" o = GES.MetaContainer.MetaContainerRegisterMetaDateTimeMethodInfo
    ResolveLayerMethod "registerMetaDouble" o = GES.MetaContainer.MetaContainerRegisterMetaDoubleMethodInfo
    ResolveLayerMethod "registerMetaFloat" o = GES.MetaContainer.MetaContainerRegisterMetaFloatMethodInfo
    ResolveLayerMethod "registerMetaInt" o = GES.MetaContainer.MetaContainerRegisterMetaIntMethodInfo
    ResolveLayerMethod "registerMetaInt64" o = GES.MetaContainer.MetaContainerRegisterMetaInt64MethodInfo
    ResolveLayerMethod "registerMetaString" o = GES.MetaContainer.MetaContainerRegisterMetaStringMethodInfo
    ResolveLayerMethod "registerMetaUint" o = GES.MetaContainer.MetaContainerRegisterMetaUintMethodInfo
    ResolveLayerMethod "registerMetaUint64" o = GES.MetaContainer.MetaContainerRegisterMetaUint64MethodInfo
    ResolveLayerMethod "registerStaticMeta" o = GES.MetaContainer.MetaContainerRegisterStaticMetaMethodInfo
    ResolveLayerMethod "removeClip" o = LayerRemoveClipMethodInfo
    ResolveLayerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveLayerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveLayerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveLayerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveLayerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveLayerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveLayerMethod "getActiveForTrack" o = LayerGetActiveForTrackMethodInfo
    ResolveLayerMethod "getAsset" o = GES.Extractable.ExtractableGetAssetMethodInfo
    ResolveLayerMethod "getAutoTransition" o = LayerGetAutoTransitionMethodInfo
    ResolveLayerMethod "getBoolean" o = GES.MetaContainer.MetaContainerGetBooleanMethodInfo
    ResolveLayerMethod "getClips" o = LayerGetClipsMethodInfo
    ResolveLayerMethod "getClipsInInterval" o = LayerGetClipsInIntervalMethodInfo
    ResolveLayerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveLayerMethod "getDate" o = GES.MetaContainer.MetaContainerGetDateMethodInfo
    ResolveLayerMethod "getDateTime" o = GES.MetaContainer.MetaContainerGetDateTimeMethodInfo
    ResolveLayerMethod "getDouble" o = GES.MetaContainer.MetaContainerGetDoubleMethodInfo
    ResolveLayerMethod "getDuration" o = LayerGetDurationMethodInfo
    ResolveLayerMethod "getFloat" o = GES.MetaContainer.MetaContainerGetFloatMethodInfo
    ResolveLayerMethod "getId" o = GES.Extractable.ExtractableGetIdMethodInfo
    ResolveLayerMethod "getInt" o = GES.MetaContainer.MetaContainerGetIntMethodInfo
    ResolveLayerMethod "getInt64" o = GES.MetaContainer.MetaContainerGetInt64MethodInfo
    ResolveLayerMethod "getMarkerList" o = GES.MetaContainer.MetaContainerGetMarkerListMethodInfo
    ResolveLayerMethod "getMeta" o = GES.MetaContainer.MetaContainerGetMetaMethodInfo
    ResolveLayerMethod "getPriority" o = LayerGetPriorityMethodInfo
    ResolveLayerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveLayerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveLayerMethod "getString" o = GES.MetaContainer.MetaContainerGetStringMethodInfo
    ResolveLayerMethod "getTimeline" o = LayerGetTimelineMethodInfo
    ResolveLayerMethod "getUint" o = GES.MetaContainer.MetaContainerGetUintMethodInfo
    ResolveLayerMethod "getUint64" o = GES.MetaContainer.MetaContainerGetUint64MethodInfo
    ResolveLayerMethod "setActiveForTracks" o = LayerSetActiveForTracksMethodInfo
    ResolveLayerMethod "setAsset" o = GES.Extractable.ExtractableSetAssetMethodInfo
    ResolveLayerMethod "setAutoTransition" o = LayerSetAutoTransitionMethodInfo
    ResolveLayerMethod "setBoolean" o = GES.MetaContainer.MetaContainerSetBooleanMethodInfo
    ResolveLayerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveLayerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveLayerMethod "setDate" o = GES.MetaContainer.MetaContainerSetDateMethodInfo
    ResolveLayerMethod "setDateTime" o = GES.MetaContainer.MetaContainerSetDateTimeMethodInfo
    ResolveLayerMethod "setDouble" o = GES.MetaContainer.MetaContainerSetDoubleMethodInfo
    ResolveLayerMethod "setFloat" o = GES.MetaContainer.MetaContainerSetFloatMethodInfo
    ResolveLayerMethod "setInt" o = GES.MetaContainer.MetaContainerSetIntMethodInfo
    ResolveLayerMethod "setInt64" o = GES.MetaContainer.MetaContainerSetInt64MethodInfo
    ResolveLayerMethod "setMarkerList" o = GES.MetaContainer.MetaContainerSetMarkerListMethodInfo
    ResolveLayerMethod "setMeta" o = GES.MetaContainer.MetaContainerSetMetaMethodInfo
    ResolveLayerMethod "setPriority" o = LayerSetPriorityMethodInfo
    ResolveLayerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveLayerMethod "setString" o = GES.MetaContainer.MetaContainerSetStringMethodInfo
    ResolveLayerMethod "setTimeline" o = LayerSetTimelineMethodInfo
    ResolveLayerMethod "setUint" o = GES.MetaContainer.MetaContainerSetUintMethodInfo
    ResolveLayerMethod "setUint64" o = GES.MetaContainer.MetaContainerSetUint64MethodInfo
    ResolveLayerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Layer::active-changed
-- | Will be emitted whenever the layer is activated or deactivated
-- for some t'GI.GES.Objects.Track.Track'. See 'GI.GES.Objects.Layer.layerSetActiveForTracks'.
-- 
-- /Since: 1.18/
type LayerActiveChangedCallback =
    Bool
    -- ^ /@active@/: Whether /@layer@/ has been made active or de-active in the /@tracks@/
    -> [GES.Track.Track]
    -- ^ /@tracks@/: A list of t'GI.GES.Objects.Track.Track'
    -- which have been activated or deactivated
    -> IO ()

type C_LayerActiveChangedCallback =
    Ptr Layer ->                            -- object
    CInt ->
    Ptr (GPtrArray (Ptr GES.Track.Track)) ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_LayerActiveChangedCallback :: 
    GObject a => (a -> LayerActiveChangedCallback) ->
    C_LayerActiveChangedCallback
wrap_LayerActiveChangedCallback :: forall a.
GObject a =>
(a -> LayerActiveChangedCallback) -> C_LayerActiveChangedCallback
wrap_LayerActiveChangedCallback a -> LayerActiveChangedCallback
gi'cb Ptr Layer
gi'selfPtr CInt
active Ptr (GPtrArray (Ptr Track))
tracks Ptr ()
_ = do
    let active' :: Bool
active' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
active
    [Ptr Track]
tracks' <- Ptr (GPtrArray (Ptr Track)) -> IO [Ptr Track]
forall a. Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray Ptr (GPtrArray (Ptr Track))
tracks
    [Track]
tracks'' <- (Ptr Track -> IO Track) -> [Ptr Track] -> IO [Track]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Track -> Track) -> Ptr Track -> IO Track
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Track -> Track
GES.Track.Track) [Ptr Track]
tracks'
    Ptr Layer -> (Layer -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Layer
gi'selfPtr ((Layer -> IO ()) -> IO ()) -> (Layer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Layer
gi'self -> a -> LayerActiveChangedCallback
gi'cb (Layer -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Layer
gi'self)  Bool
active' [Track]
tracks''


-- | Connect a signal handler for the [activeChanged](#signal:activeChanged) 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' layer #activeChanged callback
-- @
-- 
-- 
onLayerActiveChanged :: (IsLayer a, MonadIO m) => a -> ((?self :: a) => LayerActiveChangedCallback) -> m SignalHandlerId
onLayerActiveChanged :: forall a (m :: * -> *).
(IsLayer a, MonadIO m) =>
a
-> ((?self::a) => LayerActiveChangedCallback) -> m SignalHandlerId
onLayerActiveChanged a
obj (?self::a) => LayerActiveChangedCallback
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 -> LayerActiveChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => LayerActiveChangedCallback
LayerActiveChangedCallback
cb
    let wrapped' :: C_LayerActiveChangedCallback
wrapped' = (a -> LayerActiveChangedCallback) -> C_LayerActiveChangedCallback
forall a.
GObject a =>
(a -> LayerActiveChangedCallback) -> C_LayerActiveChangedCallback
wrap_LayerActiveChangedCallback a -> LayerActiveChangedCallback
wrapped
    FunPtr C_LayerActiveChangedCallback
wrapped'' <- C_LayerActiveChangedCallback
-> IO (FunPtr C_LayerActiveChangedCallback)
mk_LayerActiveChangedCallback C_LayerActiveChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_LayerActiveChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"active-changed" FunPtr C_LayerActiveChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [activeChanged](#signal:activeChanged) 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' layer #activeChanged callback
-- @
-- 
-- 
-- 
-- 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.
-- 
afterLayerActiveChanged :: (IsLayer a, MonadIO m) => a -> ((?self :: a) => LayerActiveChangedCallback) -> m SignalHandlerId
afterLayerActiveChanged :: forall a (m :: * -> *).
(IsLayer a, MonadIO m) =>
a
-> ((?self::a) => LayerActiveChangedCallback) -> m SignalHandlerId
afterLayerActiveChanged a
obj (?self::a) => LayerActiveChangedCallback
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 -> LayerActiveChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => LayerActiveChangedCallback
LayerActiveChangedCallback
cb
    let wrapped' :: C_LayerActiveChangedCallback
wrapped' = (a -> LayerActiveChangedCallback) -> C_LayerActiveChangedCallback
forall a.
GObject a =>
(a -> LayerActiveChangedCallback) -> C_LayerActiveChangedCallback
wrap_LayerActiveChangedCallback a -> LayerActiveChangedCallback
wrapped
    FunPtr C_LayerActiveChangedCallback
wrapped'' <- C_LayerActiveChangedCallback
-> IO (FunPtr C_LayerActiveChangedCallback)
mk_LayerActiveChangedCallback C_LayerActiveChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_LayerActiveChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"active-changed" FunPtr C_LayerActiveChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data LayerActiveChangedSignalInfo
instance SignalInfo LayerActiveChangedSignalInfo where
    type HaskellCallbackType LayerActiveChangedSignalInfo = LayerActiveChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_LayerActiveChangedCallback cb
        cb'' <- mk_LayerActiveChangedCallback cb'
        connectSignalFunPtr obj "active-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Layer::active-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Layer.html#g:signal:activeChanged"})

#endif

-- signal Layer::clip-added
-- | Will be emitted after the clip is added to the layer.
type LayerClipAddedCallback =
    GES.Clip.Clip
    -- ^ /@clip@/: The clip that was added
    -> IO ()

type C_LayerClipAddedCallback =
    Ptr Layer ->                            -- object
    Ptr GES.Clip.Clip ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_LayerClipAddedCallback :: 
    GObject a => (a -> LayerClipAddedCallback) ->
    C_LayerClipAddedCallback
wrap_LayerClipAddedCallback :: forall a.
GObject a =>
(a -> LayerClipAddedCallback) -> C_LayerClipAddedCallback
wrap_LayerClipAddedCallback a -> LayerClipAddedCallback
gi'cb Ptr Layer
gi'selfPtr Ptr Clip
clip Ptr ()
_ = do
    Clip
clip' <- ((ManagedPtr Clip -> Clip) -> Ptr Clip -> IO Clip
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Clip -> Clip
GES.Clip.Clip) Ptr Clip
clip
    Ptr Layer -> (Layer -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Layer
gi'selfPtr ((Layer -> IO ()) -> IO ()) -> (Layer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Layer
gi'self -> a -> LayerClipAddedCallback
gi'cb (Layer -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Layer
gi'self)  Clip
clip'


-- | Connect a signal handler for the [clipAdded](#signal:clipAdded) 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' layer #clipAdded callback
-- @
-- 
-- 
onLayerClipAdded :: (IsLayer a, MonadIO m) => a -> ((?self :: a) => LayerClipAddedCallback) -> m SignalHandlerId
onLayerClipAdded :: forall a (m :: * -> *).
(IsLayer a, MonadIO m) =>
a -> ((?self::a) => LayerClipAddedCallback) -> m SignalHandlerId
onLayerClipAdded a
obj (?self::a) => LayerClipAddedCallback
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 -> LayerClipAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => LayerClipAddedCallback
LayerClipAddedCallback
cb
    let wrapped' :: C_LayerClipAddedCallback
wrapped' = (a -> LayerClipAddedCallback) -> C_LayerClipAddedCallback
forall a.
GObject a =>
(a -> LayerClipAddedCallback) -> C_LayerClipAddedCallback
wrap_LayerClipAddedCallback a -> LayerClipAddedCallback
wrapped
    FunPtr C_LayerClipAddedCallback
wrapped'' <- C_LayerClipAddedCallback -> IO (FunPtr C_LayerClipAddedCallback)
mk_LayerClipAddedCallback C_LayerClipAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_LayerClipAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"clip-added" FunPtr C_LayerClipAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [clipAdded](#signal:clipAdded) 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' layer #clipAdded callback
-- @
-- 
-- 
-- 
-- 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.
-- 
afterLayerClipAdded :: (IsLayer a, MonadIO m) => a -> ((?self :: a) => LayerClipAddedCallback) -> m SignalHandlerId
afterLayerClipAdded :: forall a (m :: * -> *).
(IsLayer a, MonadIO m) =>
a -> ((?self::a) => LayerClipAddedCallback) -> m SignalHandlerId
afterLayerClipAdded a
obj (?self::a) => LayerClipAddedCallback
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 -> LayerClipAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => LayerClipAddedCallback
LayerClipAddedCallback
cb
    let wrapped' :: C_LayerClipAddedCallback
wrapped' = (a -> LayerClipAddedCallback) -> C_LayerClipAddedCallback
forall a.
GObject a =>
(a -> LayerClipAddedCallback) -> C_LayerClipAddedCallback
wrap_LayerClipAddedCallback a -> LayerClipAddedCallback
wrapped
    FunPtr C_LayerClipAddedCallback
wrapped'' <- C_LayerClipAddedCallback -> IO (FunPtr C_LayerClipAddedCallback)
mk_LayerClipAddedCallback C_LayerClipAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_LayerClipAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"clip-added" FunPtr C_LayerClipAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data LayerClipAddedSignalInfo
instance SignalInfo LayerClipAddedSignalInfo where
    type HaskellCallbackType LayerClipAddedSignalInfo = LayerClipAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_LayerClipAddedCallback cb
        cb'' <- mk_LayerClipAddedCallback cb'
        connectSignalFunPtr obj "clip-added" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Layer::clip-added"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Layer.html#g:signal:clipAdded"})

#endif

-- signal Layer::clip-removed
-- | Will be emitted after the clip is removed from the layer.
type LayerClipRemovedCallback =
    GES.Clip.Clip
    -- ^ /@clip@/: The clip that was removed
    -> IO ()

type C_LayerClipRemovedCallback =
    Ptr Layer ->                            -- object
    Ptr GES.Clip.Clip ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_LayerClipRemovedCallback :: 
    GObject a => (a -> LayerClipRemovedCallback) ->
    C_LayerClipRemovedCallback
wrap_LayerClipRemovedCallback :: forall a.
GObject a =>
(a -> LayerClipAddedCallback) -> C_LayerClipAddedCallback
wrap_LayerClipRemovedCallback a -> LayerClipAddedCallback
gi'cb Ptr Layer
gi'selfPtr Ptr Clip
clip Ptr ()
_ = do
    Clip
clip' <- ((ManagedPtr Clip -> Clip) -> Ptr Clip -> IO Clip
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Clip -> Clip
GES.Clip.Clip) Ptr Clip
clip
    Ptr Layer -> (Layer -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Layer
gi'selfPtr ((Layer -> IO ()) -> IO ()) -> (Layer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Layer
gi'self -> a -> LayerClipAddedCallback
gi'cb (Layer -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Layer
gi'self)  Clip
clip'


-- | Connect a signal handler for the [clipRemoved](#signal:clipRemoved) 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' layer #clipRemoved callback
-- @
-- 
-- 
onLayerClipRemoved :: (IsLayer a, MonadIO m) => a -> ((?self :: a) => LayerClipRemovedCallback) -> m SignalHandlerId
onLayerClipRemoved :: forall a (m :: * -> *).
(IsLayer a, MonadIO m) =>
a -> ((?self::a) => LayerClipAddedCallback) -> m SignalHandlerId
onLayerClipRemoved a
obj (?self::a) => LayerClipAddedCallback
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 -> LayerClipAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => LayerClipAddedCallback
LayerClipAddedCallback
cb
    let wrapped' :: C_LayerClipAddedCallback
wrapped' = (a -> LayerClipAddedCallback) -> C_LayerClipAddedCallback
forall a.
GObject a =>
(a -> LayerClipAddedCallback) -> C_LayerClipAddedCallback
wrap_LayerClipRemovedCallback a -> LayerClipAddedCallback
wrapped
    FunPtr C_LayerClipAddedCallback
wrapped'' <- C_LayerClipAddedCallback -> IO (FunPtr C_LayerClipAddedCallback)
mk_LayerClipRemovedCallback C_LayerClipAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_LayerClipAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"clip-removed" FunPtr C_LayerClipAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [clipRemoved](#signal:clipRemoved) 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' layer #clipRemoved callback
-- @
-- 
-- 
-- 
-- 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.
-- 
afterLayerClipRemoved :: (IsLayer a, MonadIO m) => a -> ((?self :: a) => LayerClipRemovedCallback) -> m SignalHandlerId
afterLayerClipRemoved :: forall a (m :: * -> *).
(IsLayer a, MonadIO m) =>
a -> ((?self::a) => LayerClipAddedCallback) -> m SignalHandlerId
afterLayerClipRemoved a
obj (?self::a) => LayerClipAddedCallback
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 -> LayerClipAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => LayerClipAddedCallback
LayerClipAddedCallback
cb
    let wrapped' :: C_LayerClipAddedCallback
wrapped' = (a -> LayerClipAddedCallback) -> C_LayerClipAddedCallback
forall a.
GObject a =>
(a -> LayerClipAddedCallback) -> C_LayerClipAddedCallback
wrap_LayerClipRemovedCallback a -> LayerClipAddedCallback
wrapped
    FunPtr C_LayerClipAddedCallback
wrapped'' <- C_LayerClipAddedCallback -> IO (FunPtr C_LayerClipAddedCallback)
mk_LayerClipRemovedCallback C_LayerClipAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_LayerClipAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"clip-removed" FunPtr C_LayerClipAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data LayerClipRemovedSignalInfo
instance SignalInfo LayerClipRemovedSignalInfo where
    type HaskellCallbackType LayerClipRemovedSignalInfo = LayerClipRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_LayerClipRemovedCallback cb
        cb'' <- mk_LayerClipRemovedCallback cb'
        connectSignalFunPtr obj "clip-removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Layer::clip-removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Layer.html#g:signal:clipRemoved"})

#endif

-- VVV Prop "auto-transition"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@auto-transition@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' layer [ #autoTransition 'Data.GI.Base.Attributes.:=' value ]
-- @
setLayerAutoTransition :: (MonadIO m, IsLayer o) => o -> Bool -> m ()
setLayerAutoTransition :: forall (m :: * -> *) o. (MonadIO m, IsLayer o) => o -> Bool -> m ()
setLayerAutoTransition o
obj Bool
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 -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"auto-transition" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@auto-transition@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructLayerAutoTransition :: (IsLayer o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructLayerAutoTransition :: forall o (m :: * -> *).
(IsLayer o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructLayerAutoTransition Bool
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 -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"auto-transition" Bool
val

#if defined(ENABLE_OVERLOADING)
data LayerAutoTransitionPropertyInfo
instance AttrInfo LayerAutoTransitionPropertyInfo where
    type AttrAllowedOps LayerAutoTransitionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint LayerAutoTransitionPropertyInfo = IsLayer
    type AttrSetTypeConstraint LayerAutoTransitionPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint LayerAutoTransitionPropertyInfo = (~) Bool
    type AttrTransferType LayerAutoTransitionPropertyInfo = Bool
    type AttrGetType LayerAutoTransitionPropertyInfo = Bool
    type AttrLabel LayerAutoTransitionPropertyInfo = "auto-transition"
    type AttrOrigin LayerAutoTransitionPropertyInfo = Layer
    attrGet = getLayerAutoTransition
    attrSet = setLayerAutoTransition
    attrTransfer _ v = do
        return v
    attrConstruct = constructLayerAutoTransition
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Layer.autoTransition"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Layer.html#g:attr:autoTransition"
        })
#endif

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

-- | 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' layer #priority
-- @
getLayerPriority :: (MonadIO m, IsLayer o) => o -> m Word32
getLayerPriority :: forall (m :: * -> *) o. (MonadIO m, IsLayer o) => o -> m Word32
getLayerPriority 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' layer [ #priority 'Data.GI.Base.Attributes.:=' value ]
-- @
setLayerPriority :: (MonadIO m, IsLayer o) => o -> Word32 -> m ()
setLayerPriority :: forall (m :: * -> *) o.
(MonadIO m, IsLayer o) =>
o -> Word32 -> m ()
setLayerPriority 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`.
constructLayerPriority :: (IsLayer o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructLayerPriority :: forall o (m :: * -> *).
(IsLayer o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructLayerPriority 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 LayerPriorityPropertyInfo
instance AttrInfo LayerPriorityPropertyInfo where
    type AttrAllowedOps LayerPriorityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint LayerPriorityPropertyInfo = IsLayer
    type AttrSetTypeConstraint LayerPriorityPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint LayerPriorityPropertyInfo = (~) Word32
    type AttrTransferType LayerPriorityPropertyInfo = Word32
    type AttrGetType LayerPriorityPropertyInfo = Word32
    type AttrLabel LayerPriorityPropertyInfo = "priority"
    type AttrOrigin LayerPriorityPropertyInfo = Layer
    attrGet = getLayerPriority
    attrSet = setLayerPriority
    attrTransfer _ v = do
        return v
    attrConstruct = constructLayerPriority
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Layer.priority"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Layer.html#g:attr:priority"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Layer
type instance O.AttributeList Layer = LayerAttributeList
type LayerAttributeList = ('[ '("autoTransition", LayerAutoTransitionPropertyInfo), '("priority", LayerPriorityPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
layerAutoTransition :: AttrLabelProxy "autoTransition"
layerAutoTransition = AttrLabelProxy

layerPriority :: AttrLabelProxy "priority"
layerPriority = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Layer = LayerSignalList
type LayerSignalList = ('[ '("activeChanged", LayerActiveChangedSignalInfo), '("clipAdded", LayerClipAddedSignalInfo), '("clipRemoved", LayerClipRemovedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("notifyMeta", GES.MetaContainer.MetaContainerNotifyMetaSignalInfo)] :: [(Symbol, DK.Type)])

#endif

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

foreign import ccall "ges_layer_new" ges_layer_new :: 
    IO (Ptr Layer)

-- | Creates a new layer.
layerNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Layer
    -- ^ __Returns:__ A new layer.
layerNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Layer
layerNew  = IO Layer -> m Layer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Layer -> m Layer) -> IO Layer -> m Layer
forall a b. (a -> b) -> a -> b
$ do
    Ptr Layer
result <- IO (Ptr Layer)
ges_layer_new
    Text -> Ptr Layer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"layerNew" Ptr Layer
result
    Layer
result' <- ((ManagedPtr Layer -> Layer) -> Ptr Layer -> IO Layer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Layer -> Layer
Layer) Ptr Layer
result
    Layer -> IO Layer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Layer
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Layer::add_asset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESLayer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "asset"
--           , argType = TInterface Name { namespace = "GES" , name = "Asset" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The asset to extract the new clip from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The #GESTimelineElement:start value to set on the new clip\nIf `start == #GST_CLOCK_TIME_NONE`, it will be added to the end\nof @layer, i.e. it will be set to @layer's duration"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "inpoint"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The #GESTimelineElement:in-point value to set on the new\nclip"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "duration"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The #GESTimelineElement:duration value to set on the new\nclip"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "track_types"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "TrackType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The #GESClip:supported-formats to set on the the new\nclip, or #GES_TRACK_TYPE_UNKNOWN to use the default"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GES" , name = "Clip" })
-- throws : False
-- Skip return : False

foreign import ccall "ges_layer_add_asset" ges_layer_add_asset :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    Ptr GES.Asset.Asset ->                  -- asset : TInterface (Name {namespace = "GES", name = "Asset"})
    Word64 ->                               -- start : TBasicType TUInt64
    Word64 ->                               -- inpoint : TBasicType TUInt64
    Word64 ->                               -- duration : TBasicType TUInt64
    CUInt ->                                -- track_types : TInterface (Name {namespace = "GES", name = "TrackType"})
    IO (Ptr GES.Clip.Clip)

-- | See 'GI.GES.Objects.Layer.layerAddAssetFull', which also gives an error.
layerAddAsset ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a, GES.Asset.IsAsset b) =>
    a
    -- ^ /@layer@/: The t'GI.GES.Objects.Layer.Layer'
    -> b
    -- ^ /@asset@/: The asset to extract the new clip from
    -> Word64
    -- ^ /@start@/: The [TimelineElement:start]("GI.GES.Objects.TimelineElement#g:attr:start") value to set on the new clip
    -- If @start == #GST_CLOCK_TIME_NONE@, it will be added to the end
    -- of /@layer@/, i.e. it will be set to /@layer@/\'s duration
    -> Word64
    -- ^ /@inpoint@/: The [TimelineElement:inPoint]("GI.GES.Objects.TimelineElement#g:attr:inPoint") value to set on the new
    -- clip
    -> Word64
    -- ^ /@duration@/: The [TimelineElement:duration]("GI.GES.Objects.TimelineElement#g:attr:duration") value to set on the new
    -- clip
    -> [GES.Flags.TrackType]
    -- ^ /@trackTypes@/: The [Clip:supportedFormats]("GI.GES.Objects.Clip#g:attr:supportedFormats") to set on the the new
    -- clip, or @/GES_TRACK_TYPE_UNKNOWN/@ to use the default
    -> m (Maybe GES.Clip.Clip)
    -- ^ __Returns:__ The newly created clip.
layerAddAsset :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayer a, IsAsset b) =>
a
-> b -> Word64 -> Word64 -> Word64 -> [TrackType] -> m (Maybe Clip)
layerAddAsset a
layer b
asset Word64
start Word64
inpoint Word64
duration [TrackType]
trackTypes = IO (Maybe Clip) -> m (Maybe Clip)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Clip) -> m (Maybe Clip))
-> IO (Maybe Clip) -> m (Maybe Clip)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    Ptr Asset
asset' <- b -> IO (Ptr Asset)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
asset
    let trackTypes' :: CUInt
trackTypes' = [TrackType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [TrackType]
trackTypes
    Ptr Clip
result <- Ptr Layer
-> Ptr Asset
-> Word64
-> Word64
-> Word64
-> CUInt
-> IO (Ptr Clip)
ges_layer_add_asset Ptr Layer
layer' Ptr Asset
asset' Word64
start Word64
inpoint Word64
duration CUInt
trackTypes'
    Maybe Clip
maybeResult <- Ptr Clip -> (Ptr Clip -> IO Clip) -> IO (Maybe Clip)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Clip
result ((Ptr Clip -> IO Clip) -> IO (Maybe Clip))
-> (Ptr Clip -> IO Clip) -> IO (Maybe Clip)
forall a b. (a -> b) -> a -> b
$ \Ptr Clip
result' -> do
        Clip
result'' <- ((ManagedPtr Clip -> Clip) -> Ptr Clip -> IO Clip
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Clip -> Clip
GES.Clip.Clip) Ptr Clip
result'
        Clip -> IO Clip
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Clip
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
asset
    Maybe Clip -> IO (Maybe Clip)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Clip
maybeResult

#if defined(ENABLE_OVERLOADING)
data LayerAddAssetMethodInfo
instance (signature ~ (b -> Word64 -> Word64 -> Word64 -> [GES.Flags.TrackType] -> m (Maybe GES.Clip.Clip)), MonadIO m, IsLayer a, GES.Asset.IsAsset b) => O.OverloadedMethod LayerAddAssetMethodInfo a signature where
    overloadedMethod = layerAddAsset

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


#endif

-- method Layer::add_asset_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESLayer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "asset"
--           , argType = TInterface Name { namespace = "GES" , name = "Asset" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The asset to extract the new clip from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The #GESTimelineElement:start value to set on the new clip\nIf `start == #GST_CLOCK_TIME_NONE`, it will be added to the end\nof @layer, i.e. it will be set to @layer's duration"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "inpoint"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The #GESTimelineElement:in-point value to set on the new\nclip"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "duration"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The #GESTimelineElement:duration value to set on the new\nclip"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "track_types"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "TrackType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The #GESClip:supported-formats to set on the the new\nclip, or #GES_TRACK_TYPE_UNKNOWN to use the default"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GES" , name = "Clip" })
-- throws : True
-- Skip return : False

foreign import ccall "ges_layer_add_asset_full" ges_layer_add_asset_full :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    Ptr GES.Asset.Asset ->                  -- asset : TInterface (Name {namespace = "GES", name = "Asset"})
    Word64 ->                               -- start : TBasicType TUInt64
    Word64 ->                               -- inpoint : TBasicType TUInt64
    Word64 ->                               -- duration : TBasicType TUInt64
    CUInt ->                                -- track_types : TInterface (Name {namespace = "GES", name = "TrackType"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GES.Clip.Clip)

-- | Extracts a new clip from an asset and adds it to the layer with
-- the given properties.
-- 
-- /Since: 1.18/
layerAddAssetFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a, GES.Asset.IsAsset b) =>
    a
    -- ^ /@layer@/: The t'GI.GES.Objects.Layer.Layer'
    -> b
    -- ^ /@asset@/: The asset to extract the new clip from
    -> Word64
    -- ^ /@start@/: The [TimelineElement:start]("GI.GES.Objects.TimelineElement#g:attr:start") value to set on the new clip
    -- If @start == #GST_CLOCK_TIME_NONE@, it will be added to the end
    -- of /@layer@/, i.e. it will be set to /@layer@/\'s duration
    -> Word64
    -- ^ /@inpoint@/: The [TimelineElement:inPoint]("GI.GES.Objects.TimelineElement#g:attr:inPoint") value to set on the new
    -- clip
    -> Word64
    -- ^ /@duration@/: The [TimelineElement:duration]("GI.GES.Objects.TimelineElement#g:attr:duration") value to set on the new
    -- clip
    -> [GES.Flags.TrackType]
    -- ^ /@trackTypes@/: The [Clip:supportedFormats]("GI.GES.Objects.Clip#g:attr:supportedFormats") to set on the the new
    -- clip, or @/GES_TRACK_TYPE_UNKNOWN/@ to use the default
    -> m GES.Clip.Clip
    -- ^ __Returns:__ The newly created clip. /(Can throw 'Data.GI.Base.GError.GError')/
layerAddAssetFull :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayer a, IsAsset b) =>
a -> b -> Word64 -> Word64 -> Word64 -> [TrackType] -> m Clip
layerAddAssetFull a
layer b
asset Word64
start Word64
inpoint Word64
duration [TrackType]
trackTypes = IO Clip -> m Clip
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Clip -> m Clip) -> IO Clip -> m Clip
forall a b. (a -> b) -> a -> b
$ do
    Ptr Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    Ptr Asset
asset' <- b -> IO (Ptr Asset)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
asset
    let trackTypes' :: CUInt
trackTypes' = [TrackType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [TrackType]
trackTypes
    IO Clip -> IO () -> IO Clip
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Clip
result <- (Ptr (Ptr GError) -> IO (Ptr Clip)) -> IO (Ptr Clip)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Clip)) -> IO (Ptr Clip))
-> (Ptr (Ptr GError) -> IO (Ptr Clip)) -> IO (Ptr Clip)
forall a b. (a -> b) -> a -> b
$ Ptr Layer
-> Ptr Asset
-> Word64
-> Word64
-> Word64
-> CUInt
-> Ptr (Ptr GError)
-> IO (Ptr Clip)
ges_layer_add_asset_full Ptr Layer
layer' Ptr Asset
asset' Word64
start Word64
inpoint Word64
duration CUInt
trackTypes'
        Text -> Ptr Clip -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"layerAddAssetFull" Ptr Clip
result
        Clip
result' <- ((ManagedPtr Clip -> Clip) -> Ptr Clip -> IO Clip
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Clip -> Clip
GES.Clip.Clip) Ptr Clip
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layer
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
asset
        Clip -> IO Clip
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Clip
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data LayerAddAssetFullMethodInfo
instance (signature ~ (b -> Word64 -> Word64 -> Word64 -> [GES.Flags.TrackType] -> m GES.Clip.Clip), MonadIO m, IsLayer a, GES.Asset.IsAsset b) => O.OverloadedMethod LayerAddAssetFullMethodInfo a signature where
    overloadedMethod = layerAddAssetFull

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


#endif

-- method Layer::add_clip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESLayer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clip"
--           , argType = TInterface Name { namespace = "GES" , name = "Clip" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The clip to add" , 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_layer_add_clip" ges_layer_add_clip :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    Ptr GES.Clip.Clip ->                    -- clip : TInterface (Name {namespace = "GES", name = "Clip"})
    IO CInt

-- | See 'GI.GES.Objects.Layer.layerAddClipFull', which also gives an error.
layerAddClip ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a, GES.Clip.IsClip b) =>
    a
    -- ^ /@layer@/: The t'GI.GES.Objects.Layer.Layer'
    -> b
    -- ^ /@clip@/: The clip to add
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@clip@/ was properly added to /@layer@/, or 'P.False'
    -- if /@layer@/ refused to add /@clip@/.
layerAddClip :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayer a, IsClip b) =>
a -> b -> m Bool
layerAddClip a
layer b
clip = 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 Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    Ptr Clip
clip' <- b -> IO (Ptr Clip)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
clip
    CInt
result <- Ptr Layer -> Ptr Clip -> IO CInt
ges_layer_add_clip Ptr Layer
layer' Ptr Clip
clip'
    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
layer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
clip
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LayerAddClipMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsLayer a, GES.Clip.IsClip b) => O.OverloadedMethod LayerAddClipMethodInfo a signature where
    overloadedMethod = layerAddClip

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


#endif

-- method Layer::add_clip_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESLayer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clip"
--           , argType = TInterface Name { namespace = "GES" , name = "Clip" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The clip to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ges_layer_add_clip_full" ges_layer_add_clip_full :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    Ptr GES.Clip.Clip ->                    -- clip : TInterface (Name {namespace = "GES", name = "Clip"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Adds the given clip to the layer. If the method succeeds, the layer
-- will take ownership of the clip.
-- 
-- This method will fail and return 'P.False' if /@clip@/ already resides in
-- some layer. It can also fail if the additional clip breaks some
-- compositional rules (see t'GI.GES.Objects.TimelineElement.TimelineElement').
-- 
-- /Since: 1.18/
layerAddClipFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a, GES.Clip.IsClip b) =>
    a
    -- ^ /@layer@/: The t'GI.GES.Objects.Layer.Layer'
    -> b
    -- ^ /@clip@/: The clip to add
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
layerAddClipFull :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayer a, IsClip b) =>
a -> b -> m ()
layerAddClipFull a
layer b
clip = 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 Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    Ptr Clip
clip' <- b -> IO (Ptr Clip)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
clip
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Layer -> Ptr Clip -> Ptr (Ptr GError) -> IO CInt
ges_layer_add_clip_full Ptr Layer
layer' Ptr Clip
clip'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layer
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
clip
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data LayerAddClipFullMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsLayer a, GES.Clip.IsClip b) => O.OverloadedMethod LayerAddClipFullMethodInfo a signature where
    overloadedMethod = layerAddClipFull

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


#endif

-- method Layer::get_active_for_track
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESLayer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "track"
--           , argType = TInterface Name { namespace = "GES" , name = "Track" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #GESTrack to check if @layer is currently active for"
--                 , 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_layer_get_active_for_track" ges_layer_get_active_for_track :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    Ptr GES.Track.Track ->                  -- track : TInterface (Name {namespace = "GES", name = "Track"})
    IO CInt

-- | Gets whether the layer is active for the given track. See
-- 'GI.GES.Objects.Layer.layerSetActiveForTracks'.
-- 
-- /Since: 1.18/
layerGetActiveForTrack ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a, GES.Track.IsTrack b) =>
    a
    -- ^ /@layer@/: The t'GI.GES.Objects.Layer.Layer'
    -> b
    -- ^ /@track@/: The t'GI.GES.Objects.Track.Track' to check if /@layer@/ is currently active for
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@layer@/ is active for /@track@/, or 'P.False' otherwise.
layerGetActiveForTrack :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayer a, IsTrack b) =>
a -> b -> m Bool
layerGetActiveForTrack a
layer b
track = 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 Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    Ptr Track
track' <- b -> IO (Ptr Track)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
track
    CInt
result <- Ptr Layer -> Ptr Track -> IO CInt
ges_layer_get_active_for_track Ptr Layer
layer' Ptr Track
track'
    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
layer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
track
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LayerGetActiveForTrackMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsLayer a, GES.Track.IsTrack b) => O.OverloadedMethod LayerGetActiveForTrackMethodInfo a signature where
    overloadedMethod = layerGetActiveForTrack

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


#endif

-- method Layer::get_auto_transition
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESLayer" , 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_layer_get_auto_transition" ges_layer_get_auto_transition :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    IO CInt

-- | Gets the [Layer:autoTransition]("GI.GES.Objects.Layer#g:attr:autoTransition") of the layer.
layerGetAutoTransition ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a) =>
    a
    -- ^ /@layer@/: The t'GI.GES.Objects.Layer.Layer'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if transitions are automatically added to /@layer@/.
layerGetAutoTransition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayer a) =>
a -> m Bool
layerGetAutoTransition a
layer = 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 Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    CInt
result <- Ptr Layer -> IO CInt
ges_layer_get_auto_transition Ptr Layer
layer'
    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
layer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LayerGetAutoTransitionMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsLayer a) => O.OverloadedMethod LayerGetAutoTransitionMethodInfo a signature where
    overloadedMethod = layerGetAutoTransition

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


#endif

-- method Layer::get_clips
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESLayer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "GES" , name = "Clip" }))
-- throws : False
-- Skip return : False

foreign import ccall "ges_layer_get_clips" ges_layer_get_clips :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    IO (Ptr (GList (Ptr GES.Clip.Clip)))

-- | Get the t'GI.GES.Objects.Clip.Clip'-s contained in this layer.
layerGetClips ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a) =>
    a
    -- ^ /@layer@/: The t'GI.GES.Objects.Layer.Layer'
    -> m [GES.Clip.Clip]
    -- ^ __Returns:__ A list of clips in
    -- /@layer@/.
layerGetClips :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayer a) =>
a -> m [Clip]
layerGetClips a
layer = IO [Clip] -> m [Clip]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Clip] -> m [Clip]) -> IO [Clip] -> m [Clip]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    Ptr (GList (Ptr Clip))
result <- Ptr Layer -> IO (Ptr (GList (Ptr Clip)))
ges_layer_get_clips Ptr Layer
layer'
    [Ptr Clip]
result' <- Ptr (GList (Ptr Clip)) -> IO [Ptr Clip]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Clip))
result
    [Clip]
result'' <- (Ptr Clip -> IO Clip) -> [Ptr Clip] -> IO [Clip]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Clip -> Clip) -> Ptr Clip -> IO Clip
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Clip -> Clip
GES.Clip.Clip) [Ptr Clip]
result'
    Ptr (GList (Ptr Clip)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Clip))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layer
    [Clip] -> IO [Clip]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Clip]
result''

#if defined(ENABLE_OVERLOADING)
data LayerGetClipsMethodInfo
instance (signature ~ (m [GES.Clip.Clip]), MonadIO m, IsLayer a) => O.OverloadedMethod LayerGetClipsMethodInfo a signature where
    overloadedMethod = layerGetClips

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


#endif

-- method Layer::get_clips_in_interval
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESLayer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Start of the interval"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "End of the interval"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "GES" , name = "Clip" }))
-- throws : False
-- Skip return : False

foreign import ccall "ges_layer_get_clips_in_interval" ges_layer_get_clips_in_interval :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    Word64 ->                               -- start : TBasicType TUInt64
    Word64 ->                               -- end : TBasicType TUInt64
    IO (Ptr (GList (Ptr GES.Clip.Clip)))

-- | Gets the clips within the layer that appear between /@start@/ and /@end@/.
layerGetClipsInInterval ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a) =>
    a
    -- ^ /@layer@/: The t'GI.GES.Objects.Layer.Layer'
    -> Word64
    -- ^ /@start@/: Start of the interval
    -> Word64
    -- ^ /@end@/: End of the interval
    -> m [GES.Clip.Clip]
    -- ^ __Returns:__ A list of t'GI.GES.Objects.Clip.Clip'-s
    -- that intersect the interval @[start, end)@ in /@layer@/.
layerGetClipsInInterval :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayer a) =>
a -> Word64 -> Word64 -> m [Clip]
layerGetClipsInInterval a
layer Word64
start Word64
end = IO [Clip] -> m [Clip]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Clip] -> m [Clip]) -> IO [Clip] -> m [Clip]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    Ptr (GList (Ptr Clip))
result <- Ptr Layer -> Word64 -> Word64 -> IO (Ptr (GList (Ptr Clip)))
ges_layer_get_clips_in_interval Ptr Layer
layer' Word64
start Word64
end
    [Ptr Clip]
result' <- Ptr (GList (Ptr Clip)) -> IO [Ptr Clip]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Clip))
result
    [Clip]
result'' <- (Ptr Clip -> IO Clip) -> [Ptr Clip] -> IO [Clip]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Clip -> Clip) -> Ptr Clip -> IO Clip
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Clip -> Clip
GES.Clip.Clip) [Ptr Clip]
result'
    Ptr (GList (Ptr Clip)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Clip))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layer
    [Clip] -> IO [Clip]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Clip]
result''

#if defined(ENABLE_OVERLOADING)
data LayerGetClipsInIntervalMethodInfo
instance (signature ~ (Word64 -> Word64 -> m [GES.Clip.Clip]), MonadIO m, IsLayer a) => O.OverloadedMethod LayerGetClipsInIntervalMethodInfo a signature where
    overloadedMethod = layerGetClipsInInterval

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


#endif

-- method Layer::get_duration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The layer to get the duration from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "ges_layer_get_duration" ges_layer_get_duration :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    IO Word64

-- | Retrieves the duration of the layer, which is the difference
-- between the start of the layer (always time 0) and the end (which will
-- be the end time of the final clip).
layerGetDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a) =>
    a
    -- ^ /@layer@/: The layer to get the duration from
    -> m Word64
    -- ^ __Returns:__ The duration of /@layer@/.
layerGetDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayer a) =>
a -> m Word64
layerGetDuration a
layer = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    Word64
result <- Ptr Layer -> IO Word64
ges_layer_get_duration Ptr Layer
layer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layer
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data LayerGetDurationMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsLayer a) => O.OverloadedMethod LayerGetDurationMethodInfo a signature where
    overloadedMethod = layerGetDuration

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


#endif

-- method Layer::get_priority
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESLayer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "ges_layer_get_priority" ges_layer_get_priority :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    IO Word32

-- | Get the priority of the layer. When inside a timeline, this is its
-- index in the timeline. See 'GI.GES.Objects.Timeline.timelineMoveLayer'.
layerGetPriority ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a) =>
    a
    -- ^ /@layer@/: The t'GI.GES.Objects.Layer.Layer'
    -> m Word32
    -- ^ __Returns:__ The priority of /@layer@/ within its timeline.
layerGetPriority :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayer a) =>
a -> m Word32
layerGetPriority a
layer = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    Word32
result <- Ptr Layer -> IO Word32
ges_layer_get_priority Ptr Layer
layer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layer
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data LayerGetPriorityMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsLayer a) => O.OverloadedMethod LayerGetPriorityMethodInfo a signature where
    overloadedMethod = layerGetPriority

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


#endif

-- method Layer::get_timeline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESLayer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GES" , name = "Timeline" })
-- throws : False
-- Skip return : False

foreign import ccall "ges_layer_get_timeline" ges_layer_get_timeline :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    IO (Ptr GES.Timeline.Timeline)

-- | Gets the timeline that the layer is a part of.
layerGetTimeline ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a) =>
    a
    -- ^ /@layer@/: The t'GI.GES.Objects.Layer.Layer'
    -> m (Maybe GES.Timeline.Timeline)
    -- ^ __Returns:__ The timeline that /@layer@/
    -- is currently part of, or 'P.Nothing' if it is not associated with any
    -- timeline.
layerGetTimeline :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayer a) =>
a -> m (Maybe Timeline)
layerGetTimeline a
layer = IO (Maybe Timeline) -> m (Maybe Timeline)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Timeline) -> m (Maybe Timeline))
-> IO (Maybe Timeline) -> m (Maybe Timeline)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    Ptr Timeline
result <- Ptr Layer -> IO (Ptr Timeline)
ges_layer_get_timeline Ptr Layer
layer'
    Maybe Timeline
maybeResult <- Ptr Timeline
-> (Ptr Timeline -> IO Timeline) -> IO (Maybe Timeline)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Timeline
result ((Ptr Timeline -> IO Timeline) -> IO (Maybe Timeline))
-> (Ptr Timeline -> IO Timeline) -> IO (Maybe Timeline)
forall a b. (a -> b) -> a -> b
$ \Ptr Timeline
result' -> do
        Timeline
result'' <- ((ManagedPtr Timeline -> Timeline) -> Ptr Timeline -> IO Timeline
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Timeline -> Timeline
GES.Timeline.Timeline) Ptr Timeline
result'
        Timeline -> IO Timeline
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Timeline
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layer
    Maybe Timeline -> IO (Maybe Timeline)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Timeline
maybeResult

#if defined(ENABLE_OVERLOADING)
data LayerGetTimelineMethodInfo
instance (signature ~ (m (Maybe GES.Timeline.Timeline)), MonadIO m, IsLayer a) => O.OverloadedMethod LayerGetTimelineMethodInfo a signature where
    overloadedMethod = layerGetTimeline

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


#endif

-- method Layer::is_empty
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESLayer to check"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ges_layer_is_empty" ges_layer_is_empty :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    IO CInt

-- | Convenience method to check if the layer is empty (doesn\'t contain
-- any t'GI.GES.Objects.Clip.Clip'), or not.
layerIsEmpty ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a) =>
    a
    -- ^ /@layer@/: The t'GI.GES.Objects.Layer.Layer' to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@layer@/ is empty, 'P.False' if it contains at least
    -- one clip.
layerIsEmpty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayer a) =>
a -> m Bool
layerIsEmpty a
layer = 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 Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    CInt
result <- Ptr Layer -> IO CInt
ges_layer_is_empty Ptr Layer
layer'
    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
layer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LayerIsEmptyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsLayer a) => O.OverloadedMethod LayerIsEmptyMethodInfo a signature where
    overloadedMethod = layerIsEmpty

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


#endif

-- method Layer::remove_clip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESLayer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clip"
--           , argType = TInterface Name { namespace = "GES" , name = "Clip" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The clip to remove" , 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_layer_remove_clip" ges_layer_remove_clip :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    Ptr GES.Clip.Clip ->                    -- clip : TInterface (Name {namespace = "GES", name = "Clip"})
    IO CInt

-- | Removes the given clip from the layer.
layerRemoveClip ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a, GES.Clip.IsClip b) =>
    a
    -- ^ /@layer@/: The t'GI.GES.Objects.Layer.Layer'
    -> b
    -- ^ /@clip@/: The clip to remove
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@clip@/ was removed from /@layer@/, or 'P.False' if the
    -- operation failed.
layerRemoveClip :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayer a, IsClip b) =>
a -> b -> m Bool
layerRemoveClip a
layer b
clip = 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 Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    Ptr Clip
clip' <- b -> IO (Ptr Clip)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
clip
    CInt
result <- Ptr Layer -> Ptr Clip -> IO CInt
ges_layer_remove_clip Ptr Layer
layer' Ptr Clip
clip'
    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
layer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
clip
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LayerRemoveClipMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsLayer a, GES.Clip.IsClip b) => O.OverloadedMethod LayerRemoveClipMethodInfo a signature where
    overloadedMethod = layerRemoveClip

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


#endif

-- method Layer::set_active_for_tracks
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESLayer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "active"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Whether elements in @tracks should be active or not"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tracks"
--           , argType =
--               TGList (TInterface Name { namespace = "GES" , name = "Track" })
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The list of\ntracks @layer should be (de-)active in, or %NULL to include all the tracks\nin the @layer's timeline"
--                 , 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_layer_set_active_for_tracks" ges_layer_set_active_for_tracks :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    CInt ->                                 -- active : TBasicType TBoolean
    Ptr (GList (Ptr GES.Track.Track)) ->    -- tracks : TGList (TInterface (Name {namespace = "GES", name = "Track"}))
    IO CInt

-- | Activate or deactivate track elements in /@tracks@/ (or in all tracks if /@tracks@/
-- is 'P.Nothing').
-- 
-- When a layer is deactivated for a track, all the t'GI.GES.Objects.TrackElement.TrackElement'-s in
-- the track that belong to a t'GI.GES.Objects.Clip.Clip' in the layer will no longer be
-- active in the track, regardless of their individual
-- [TrackElement:active]("GI.GES.Objects.TrackElement#g:attr:active") value.
-- 
-- Note that by default a layer will be active for all of its
-- timeline\'s tracks.
-- 
-- /Since: 1.18/
layerSetActiveForTracks ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a, GES.Track.IsTrack b) =>
    a
    -- ^ /@layer@/: The t'GI.GES.Objects.Layer.Layer'
    -> Bool
    -- ^ /@active@/: Whether elements in /@tracks@/ should be active or not
    -> [b]
    -- ^ /@tracks@/: The list of
    -- tracks /@layer@/ should be (de-)active in, or 'P.Nothing' to include all the tracks
    -- in the /@layer@/\'s timeline
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the operation worked 'P.False' otherwise.
layerSetActiveForTracks :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayer a, IsTrack b) =>
a -> Bool -> [b] -> m Bool
layerSetActiveForTracks a
layer Bool
active [b]
tracks = 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 Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    let active' :: CInt
active' = (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
active
    [Ptr Track]
tracks' <- (b -> IO (Ptr Track)) -> [b] -> IO [Ptr Track]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM b -> IO (Ptr Track)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [b]
tracks
    Ptr (GList (Ptr Track))
tracks'' <- [Ptr Track] -> IO (Ptr (GList (Ptr Track)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr Track]
tracks'
    CInt
result <- Ptr Layer -> CInt -> Ptr (GList (Ptr Track)) -> IO CInt
ges_layer_set_active_for_tracks Ptr Layer
layer' CInt
active' Ptr (GList (Ptr Track))
tracks''
    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
layer
    (b -> IO ()) -> [b] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [b]
tracks
    Ptr (GList (Ptr Track)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Track))
tracks''
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LayerSetActiveForTracksMethodInfo
instance (signature ~ (Bool -> [b] -> m Bool), MonadIO m, IsLayer a, GES.Track.IsTrack b) => O.OverloadedMethod LayerSetActiveForTracksMethodInfo a signature where
    overloadedMethod = layerSetActiveForTracks

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


#endif

-- method Layer::set_auto_transition
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESLayer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "auto_transition"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Whether transitions should be automatically added to\nthe layer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ges_layer_set_auto_transition" ges_layer_set_auto_transition :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    CInt ->                                 -- auto_transition : TBasicType TBoolean
    IO ()

-- | Sets [Layer:autoTransition]("GI.GES.Objects.Layer#g:attr:autoTransition") for the layer. Use
-- 'GI.GES.Objects.Timeline.timelineSetAutoTransition' if you want all layers within a
-- t'GI.GES.Objects.Timeline.Timeline' to have [Layer:autoTransition]("GI.GES.Objects.Layer#g:attr:autoTransition") set to 'P.True'. Use this
-- method if you want different values for different layers (and make sure
-- to keep [Timeline:autoTransition]("GI.GES.Objects.Timeline#g:attr:autoTransition") as 'P.False' for the corresponding
-- timeline).
layerSetAutoTransition ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a) =>
    a
    -- ^ /@layer@/: The t'GI.GES.Objects.Layer.Layer'
    -> Bool
    -- ^ /@autoTransition@/: Whether transitions should be automatically added to
    -- the layer
    -> m ()
layerSetAutoTransition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayer a) =>
a -> Bool -> m ()
layerSetAutoTransition a
layer Bool
autoTransition = 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 Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    let autoTransition' :: CInt
autoTransition' = (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
autoTransition
    Ptr Layer -> CInt -> IO ()
ges_layer_set_auto_transition Ptr Layer
layer' CInt
autoTransition'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layer
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LayerSetAutoTransitionMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsLayer a) => O.OverloadedMethod LayerSetAutoTransitionMethodInfo a signature where
    overloadedMethod = layerSetAutoTransition

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


#endif

-- method Layer::set_priority
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESLayer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priority"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The priority to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ges_layer_set_priority" ges_layer_set_priority :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    Word32 ->                               -- priority : TBasicType TUInt
    IO ()

{-# DEPRECATED layerSetPriority ["(Since version 1.16.0)","use @/ges_timeline_move_layer/@ instead. This deprecation means","that you will not need to handle layer priorities at all yourself, GES","will make sure there is never \\'gaps\\' between layer priorities."] #-}
-- | Sets the layer to the given priority. See [Layer:priority]("GI.GES.Objects.Layer#g:attr:priority").
layerSetPriority ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a) =>
    a
    -- ^ /@layer@/: The t'GI.GES.Objects.Layer.Layer'
    -> Word32
    -- ^ /@priority@/: The priority to set
    -> m ()
layerSetPriority :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayer a) =>
a -> Word32 -> m ()
layerSetPriority a
layer Word32
priority = 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 Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    Ptr Layer -> Word32 -> IO ()
ges_layer_set_priority Ptr Layer
layer' Word32
priority
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layer
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LayerSetPriorityMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsLayer a) => O.OverloadedMethod LayerSetPriorityMethodInfo a signature where
    overloadedMethod = layerSetPriority

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


#endif

-- method Layer::set_timeline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType = TInterface Name { namespace = "GES" , name = "Layer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeline"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Timeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ges_layer_set_timeline" ges_layer_set_timeline :: 
    Ptr Layer ->                            -- layer : TInterface (Name {namespace = "GES", name = "Layer"})
    Ptr GES.Timeline.Timeline ->            -- timeline : TInterface (Name {namespace = "GES", name = "Timeline"})
    IO ()

-- | /No description available in the introspection data./
layerSetTimeline ::
    (B.CallStack.HasCallStack, MonadIO m, IsLayer a, GES.Timeline.IsTimeline b) =>
    a
    -> b
    -> m ()
layerSetTimeline :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayer a, IsTimeline b) =>
a -> b -> m ()
layerSetTimeline a
layer b
timeline = 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 Layer
layer' <- a -> IO (Ptr Layer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layer
    Ptr Timeline
timeline' <- b -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
timeline
    Ptr Layer -> Ptr Timeline -> IO ()
ges_layer_set_timeline Ptr Layer
layer' Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LayerSetTimelineMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsLayer a, GES.Timeline.IsTimeline b) => O.OverloadedMethod LayerSetTimelineMethodInfo a signature where
    overloadedMethod = layerSetTimeline

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


#endif