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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.GES.Objects.Project.Project' is used to control a set of t'GI.GES.Objects.Asset.Asset' and is a
-- t'GI.GES.Objects.Asset.Asset' with @GES_TYPE_TIMELINE@ as /@extractableType@/ itself. That
-- means that you can extract t'GI.GES.Objects.Timeline.Timeline' from a project as followed:
-- 
-- >
-- > GESProject *project;
-- > GESTimeline *timeline;
-- >
-- > project = ges_project_new ("file:///path/to/a/valid/project/uri");
-- >
-- > // Here you can connect to the various signal to get more infos about
-- > // what is happening and recover from errors if possible
-- > ...
-- >
-- > timeline = ges_asset_extract (GES_ASSET (project));
-- 
-- 
-- The t'GI.GES.Objects.Project.Project' class offers a higher level API to handle t'GI.GES.Objects.Asset.Asset'-s.
-- It lets you request new asset, and it informs you about new assets through
-- a set of signals. Also it handles problem such as missing files\/missing
-- t'GI.Gst.Objects.Element.Element' and lets you try to recover from those.
-- 
-- == Subprojects
-- 
-- In order to add a subproject, the only thing to do is to add the subproject
-- to the main project:
-- 
-- 
-- === /c code/
-- >ges_project_add_asset (project, GES_ASSET (subproject));
-- 
-- then the subproject will be serialized in the project files. To use
-- the subproject in a timeline, you should use a t'GI.GES.Objects.UriClip.UriClip' with the
-- same subproject URI.
-- 
-- When loading a project with subproject, subprojects URIs will be temporary
-- writable local files. If you want to edit the subproject timeline,
-- you should retrieve the subproject from the parent project asset list and
-- extract the timeline with 'GI.GES.Objects.Asset.assetExtract' and save it at
-- the same temporary location.

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

module GI.GES.Objects.Project
    ( 

-- * Exported types
    Project(..)                             ,
    IsProject                               ,
    toProject                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addAsset]("GI.GES.Objects.Project#g:method:addAsset"), [addEncodingProfile]("GI.GES.Objects.Project#g:method:addEncodingProfile"), [addFormatter]("GI.GES.Objects.Project#g:method:addFormatter"), [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"), [createAsset]("GI.GES.Objects.Project#g:method:createAsset"), [createAssetSync]("GI.GES.Objects.Project#g:method:createAssetSync"), [extract]("GI.GES.Objects.Asset#g:method:extract"), [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"), [init]("GI.Gio.Interfaces.Initable#g:method:init"), [initAsync]("GI.Gio.Interfaces.AsyncInitable#g:method:initAsync"), [initFinish]("GI.Gio.Interfaces.AsyncInitable#g:method:initFinish"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [listAssets]("GI.GES.Objects.Project#g:method:listAssets"), [listEncodingProfiles]("GI.GES.Objects.Project#g:method:listEncodingProfiles"), [listProxies]("GI.GES.Objects.Asset#g:method:listProxies"), [load]("GI.GES.Objects.Project#g:method:load"), [metasToString]("GI.GES.Interfaces.MetaContainer#g:method:metasToString"), [newFinish]("GI.Gio.Interfaces.AsyncInitable#g:method:newFinish"), [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"), [removeAsset]("GI.GES.Objects.Project#g:method:removeAsset"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [save]("GI.GES.Objects.Project#g:method:save"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unproxy]("GI.GES.Objects.Asset#g:method:unproxy"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAsset]("GI.GES.Objects.Project#g:method:getAsset"), [getBoolean]("GI.GES.Interfaces.MetaContainer#g:method:getBoolean"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDate]("GI.GES.Interfaces.MetaContainer#g:method:getDate"), [getDateTime]("GI.GES.Interfaces.MetaContainer#g:method:getDateTime"), [getDouble]("GI.GES.Interfaces.MetaContainer#g:method:getDouble"), [getError]("GI.GES.Objects.Asset#g:method:getError"), [getExtractableType]("GI.GES.Objects.Asset#g:method:getExtractableType"), [getFloat]("GI.GES.Interfaces.MetaContainer#g:method:getFloat"), [getId]("GI.GES.Objects.Asset#g:method:getId"), [getInt]("GI.GES.Interfaces.MetaContainer#g:method:getInt"), [getInt64]("GI.GES.Interfaces.MetaContainer#g:method:getInt64"), [getLoadingAssets]("GI.GES.Objects.Project#g:method:getLoadingAssets"), [getMarkerList]("GI.GES.Interfaces.MetaContainer#g:method:getMarkerList"), [getMeta]("GI.GES.Interfaces.MetaContainer#g:method:getMeta"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getProxy]("GI.GES.Objects.Asset#g:method:getProxy"), [getProxyTarget]("GI.GES.Objects.Asset#g:method:getProxyTarget"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getString]("GI.GES.Interfaces.MetaContainer#g:method:getString"), [getUint]("GI.GES.Interfaces.MetaContainer#g:method:getUint"), [getUint64]("GI.GES.Interfaces.MetaContainer#g:method:getUint64"), [getUri]("GI.GES.Objects.Project#g:method:getUri").
-- 
-- ==== Setters
-- [setBoolean]("GI.GES.Interfaces.MetaContainer#g:method:setBoolean"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDate]("GI.GES.Interfaces.MetaContainer#g:method:setDate"), [setDateTime]("GI.GES.Interfaces.MetaContainer#g:method:setDateTime"), [setDouble]("GI.GES.Interfaces.MetaContainer#g:method:setDouble"), [setFloat]("GI.GES.Interfaces.MetaContainer#g:method:setFloat"), [setInt]("GI.GES.Interfaces.MetaContainer#g:method:setInt"), [setInt64]("GI.GES.Interfaces.MetaContainer#g:method:setInt64"), [setMarkerList]("GI.GES.Interfaces.MetaContainer#g:method:setMarkerList"), [setMeta]("GI.GES.Interfaces.MetaContainer#g:method:setMeta"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setProxy]("GI.GES.Objects.Asset#g:method:setProxy"), [setString]("GI.GES.Interfaces.MetaContainer#g:method:setString"), [setUint]("GI.GES.Interfaces.MetaContainer#g:method:setUint"), [setUint64]("GI.GES.Interfaces.MetaContainer#g:method:setUint64").

#if defined(ENABLE_OVERLOADING)
    ResolveProjectMethod                    ,
#endif

-- ** addAsset #method:addAsset#

#if defined(ENABLE_OVERLOADING)
    ProjectAddAssetMethodInfo               ,
#endif
    projectAddAsset                         ,


-- ** addEncodingProfile #method:addEncodingProfile#

#if defined(ENABLE_OVERLOADING)
    ProjectAddEncodingProfileMethodInfo     ,
#endif
    projectAddEncodingProfile               ,


-- ** addFormatter #method:addFormatter#

#if defined(ENABLE_OVERLOADING)
    ProjectAddFormatterMethodInfo           ,
#endif
    projectAddFormatter                     ,


-- ** createAsset #method:createAsset#

#if defined(ENABLE_OVERLOADING)
    ProjectCreateAssetMethodInfo            ,
#endif
    projectCreateAsset                      ,


-- ** createAssetSync #method:createAssetSync#

#if defined(ENABLE_OVERLOADING)
    ProjectCreateAssetSyncMethodInfo        ,
#endif
    projectCreateAssetSync                  ,


-- ** getAsset #method:getAsset#

#if defined(ENABLE_OVERLOADING)
    ProjectGetAssetMethodInfo               ,
#endif
    projectGetAsset                         ,


-- ** getLoadingAssets #method:getLoadingAssets#

#if defined(ENABLE_OVERLOADING)
    ProjectGetLoadingAssetsMethodInfo       ,
#endif
    projectGetLoadingAssets                 ,


-- ** getUri #method:getUri#

#if defined(ENABLE_OVERLOADING)
    ProjectGetUriMethodInfo                 ,
#endif
    projectGetUri                           ,


-- ** listAssets #method:listAssets#

#if defined(ENABLE_OVERLOADING)
    ProjectListAssetsMethodInfo             ,
#endif
    projectListAssets                       ,


-- ** listEncodingProfiles #method:listEncodingProfiles#

#if defined(ENABLE_OVERLOADING)
    ProjectListEncodingProfilesMethodInfo   ,
#endif
    projectListEncodingProfiles             ,


-- ** load #method:load#

#if defined(ENABLE_OVERLOADING)
    ProjectLoadMethodInfo                   ,
#endif
    projectLoad                             ,


-- ** new #method:new#

    projectNew                              ,


-- ** removeAsset #method:removeAsset#

#if defined(ENABLE_OVERLOADING)
    ProjectRemoveAssetMethodInfo            ,
#endif
    projectRemoveAsset                      ,


-- ** save #method:save#

#if defined(ENABLE_OVERLOADING)
    ProjectSaveMethodInfo                   ,
#endif
    projectSave                             ,




 -- * Properties


-- ** uri #attr:uri#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ProjectUriPropertyInfo                  ,
#endif
    constructProjectUri                     ,
    getProjectUri                           ,
#if defined(ENABLE_OVERLOADING)
    projectUri                              ,
#endif




 -- * Signals


-- ** assetAdded #signal:assetAdded#

    ProjectAssetAddedCallback               ,
#if defined(ENABLE_OVERLOADING)
    ProjectAssetAddedSignalInfo             ,
#endif
    afterProjectAssetAdded                  ,
    onProjectAssetAdded                     ,


-- ** assetLoading #signal:assetLoading#

    ProjectAssetLoadingCallback             ,
#if defined(ENABLE_OVERLOADING)
    ProjectAssetLoadingSignalInfo           ,
#endif
    afterProjectAssetLoading                ,
    onProjectAssetLoading                   ,


-- ** assetRemoved #signal:assetRemoved#

    ProjectAssetRemovedCallback             ,
#if defined(ENABLE_OVERLOADING)
    ProjectAssetRemovedSignalInfo           ,
#endif
    afterProjectAssetRemoved                ,
    onProjectAssetRemoved                   ,


-- ** errorLoading #signal:errorLoading#

    ProjectErrorLoadingCallback             ,
#if defined(ENABLE_OVERLOADING)
    ProjectErrorLoadingSignalInfo           ,
#endif
    afterProjectErrorLoading                ,
    onProjectErrorLoading                   ,


-- ** errorLoadingAsset #signal:errorLoadingAsset#

    ProjectErrorLoadingAssetCallback        ,
#if defined(ENABLE_OVERLOADING)
    ProjectErrorLoadingAssetSignalInfo      ,
#endif
    afterProjectErrorLoadingAsset           ,
    onProjectErrorLoadingAsset              ,


-- ** loaded #signal:loaded#

    ProjectLoadedCallback                   ,
#if defined(ENABLE_OVERLOADING)
    ProjectLoadedSignalInfo                 ,
#endif
    afterProjectLoaded                      ,
    onProjectLoaded                         ,


-- ** loading #signal:loading#

    ProjectLoadingCallback                  ,
#if defined(ENABLE_OVERLOADING)
    ProjectLoadingSignalInfo                ,
#endif
    afterProjectLoading                     ,
    onProjectLoading                        ,


-- ** missingUri #signal:missingUri#

    ProjectMissingUriCallback               ,
#if defined(ENABLE_OVERLOADING)
    ProjectMissingUriSignalInfo             ,
#endif
    afterProjectMissingUri                  ,
    onProjectMissingUri                     ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.GES.Interfaces.MetaContainer as GES.MetaContainer
import {-# SOURCE #-} qualified GI.GES.Objects.Asset as GES.Asset
import {-# SOURCE #-} qualified GI.GES.Objects.Formatter as GES.Formatter
import {-# SOURCE #-} qualified GI.GES.Objects.Timeline as GES.Timeline
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.AsyncInitable as Gio.AsyncInitable
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.GstPbutils.Objects.EncodingProfile as GstPbutils.EncodingProfile

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

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

foreign import ccall "ges_project_get_type"
    c_ges_project_get_type :: IO B.Types.GType

instance B.Types.TypedObject Project where
    glibType :: IO GType
glibType = IO GType
c_ges_project_get_type

instance B.Types.GObject Project

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

instance O.HasParentTypes Project
type instance O.ParentTypes Project = '[GES.Asset.Asset, GObject.Object.Object, GES.MetaContainer.MetaContainer, Gio.AsyncInitable.AsyncInitable, Gio.Initable.Initable]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveProjectMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveProjectMethod "addAsset" o = ProjectAddAssetMethodInfo
    ResolveProjectMethod "addEncodingProfile" o = ProjectAddEncodingProfileMethodInfo
    ResolveProjectMethod "addFormatter" o = ProjectAddFormatterMethodInfo
    ResolveProjectMethod "addMetasFromString" o = GES.MetaContainer.MetaContainerAddMetasFromStringMethodInfo
    ResolveProjectMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveProjectMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveProjectMethod "checkMetaRegistered" o = GES.MetaContainer.MetaContainerCheckMetaRegisteredMethodInfo
    ResolveProjectMethod "createAsset" o = ProjectCreateAssetMethodInfo
    ResolveProjectMethod "createAssetSync" o = ProjectCreateAssetSyncMethodInfo
    ResolveProjectMethod "extract" o = GES.Asset.AssetExtractMethodInfo
    ResolveProjectMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveProjectMethod "foreach" o = GES.MetaContainer.MetaContainerForeachMethodInfo
    ResolveProjectMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveProjectMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveProjectMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolveProjectMethod "initAsync" o = Gio.AsyncInitable.AsyncInitableInitAsyncMethodInfo
    ResolveProjectMethod "initFinish" o = Gio.AsyncInitable.AsyncInitableInitFinishMethodInfo
    ResolveProjectMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveProjectMethod "listAssets" o = ProjectListAssetsMethodInfo
    ResolveProjectMethod "listEncodingProfiles" o = ProjectListEncodingProfilesMethodInfo
    ResolveProjectMethod "listProxies" o = GES.Asset.AssetListProxiesMethodInfo
    ResolveProjectMethod "load" o = ProjectLoadMethodInfo
    ResolveProjectMethod "metasToString" o = GES.MetaContainer.MetaContainerMetasToStringMethodInfo
    ResolveProjectMethod "newFinish" o = Gio.AsyncInitable.AsyncInitableNewFinishMethodInfo
    ResolveProjectMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveProjectMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveProjectMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveProjectMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveProjectMethod "registerMeta" o = GES.MetaContainer.MetaContainerRegisterMetaMethodInfo
    ResolveProjectMethod "registerMetaBoolean" o = GES.MetaContainer.MetaContainerRegisterMetaBooleanMethodInfo
    ResolveProjectMethod "registerMetaDate" o = GES.MetaContainer.MetaContainerRegisterMetaDateMethodInfo
    ResolveProjectMethod "registerMetaDateTime" o = GES.MetaContainer.MetaContainerRegisterMetaDateTimeMethodInfo
    ResolveProjectMethod "registerMetaDouble" o = GES.MetaContainer.MetaContainerRegisterMetaDoubleMethodInfo
    ResolveProjectMethod "registerMetaFloat" o = GES.MetaContainer.MetaContainerRegisterMetaFloatMethodInfo
    ResolveProjectMethod "registerMetaInt" o = GES.MetaContainer.MetaContainerRegisterMetaIntMethodInfo
    ResolveProjectMethod "registerMetaInt64" o = GES.MetaContainer.MetaContainerRegisterMetaInt64MethodInfo
    ResolveProjectMethod "registerMetaString" o = GES.MetaContainer.MetaContainerRegisterMetaStringMethodInfo
    ResolveProjectMethod "registerMetaUint" o = GES.MetaContainer.MetaContainerRegisterMetaUintMethodInfo
    ResolveProjectMethod "registerMetaUint64" o = GES.MetaContainer.MetaContainerRegisterMetaUint64MethodInfo
    ResolveProjectMethod "registerStaticMeta" o = GES.MetaContainer.MetaContainerRegisterStaticMetaMethodInfo
    ResolveProjectMethod "removeAsset" o = ProjectRemoveAssetMethodInfo
    ResolveProjectMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveProjectMethod "save" o = ProjectSaveMethodInfo
    ResolveProjectMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveProjectMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveProjectMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveProjectMethod "unproxy" o = GES.Asset.AssetUnproxyMethodInfo
    ResolveProjectMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveProjectMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveProjectMethod "getAsset" o = ProjectGetAssetMethodInfo
    ResolveProjectMethod "getBoolean" o = GES.MetaContainer.MetaContainerGetBooleanMethodInfo
    ResolveProjectMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveProjectMethod "getDate" o = GES.MetaContainer.MetaContainerGetDateMethodInfo
    ResolveProjectMethod "getDateTime" o = GES.MetaContainer.MetaContainerGetDateTimeMethodInfo
    ResolveProjectMethod "getDouble" o = GES.MetaContainer.MetaContainerGetDoubleMethodInfo
    ResolveProjectMethod "getError" o = GES.Asset.AssetGetErrorMethodInfo
    ResolveProjectMethod "getExtractableType" o = GES.Asset.AssetGetExtractableTypeMethodInfo
    ResolveProjectMethod "getFloat" o = GES.MetaContainer.MetaContainerGetFloatMethodInfo
    ResolveProjectMethod "getId" o = GES.Asset.AssetGetIdMethodInfo
    ResolveProjectMethod "getInt" o = GES.MetaContainer.MetaContainerGetIntMethodInfo
    ResolveProjectMethod "getInt64" o = GES.MetaContainer.MetaContainerGetInt64MethodInfo
    ResolveProjectMethod "getLoadingAssets" o = ProjectGetLoadingAssetsMethodInfo
    ResolveProjectMethod "getMarkerList" o = GES.MetaContainer.MetaContainerGetMarkerListMethodInfo
    ResolveProjectMethod "getMeta" o = GES.MetaContainer.MetaContainerGetMetaMethodInfo
    ResolveProjectMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveProjectMethod "getProxy" o = GES.Asset.AssetGetProxyMethodInfo
    ResolveProjectMethod "getProxyTarget" o = GES.Asset.AssetGetProxyTargetMethodInfo
    ResolveProjectMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveProjectMethod "getString" o = GES.MetaContainer.MetaContainerGetStringMethodInfo
    ResolveProjectMethod "getUint" o = GES.MetaContainer.MetaContainerGetUintMethodInfo
    ResolveProjectMethod "getUint64" o = GES.MetaContainer.MetaContainerGetUint64MethodInfo
    ResolveProjectMethod "getUri" o = ProjectGetUriMethodInfo
    ResolveProjectMethod "setBoolean" o = GES.MetaContainer.MetaContainerSetBooleanMethodInfo
    ResolveProjectMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveProjectMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveProjectMethod "setDate" o = GES.MetaContainer.MetaContainerSetDateMethodInfo
    ResolveProjectMethod "setDateTime" o = GES.MetaContainer.MetaContainerSetDateTimeMethodInfo
    ResolveProjectMethod "setDouble" o = GES.MetaContainer.MetaContainerSetDoubleMethodInfo
    ResolveProjectMethod "setFloat" o = GES.MetaContainer.MetaContainerSetFloatMethodInfo
    ResolveProjectMethod "setInt" o = GES.MetaContainer.MetaContainerSetIntMethodInfo
    ResolveProjectMethod "setInt64" o = GES.MetaContainer.MetaContainerSetInt64MethodInfo
    ResolveProjectMethod "setMarkerList" o = GES.MetaContainer.MetaContainerSetMarkerListMethodInfo
    ResolveProjectMethod "setMeta" o = GES.MetaContainer.MetaContainerSetMetaMethodInfo
    ResolveProjectMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveProjectMethod "setProxy" o = GES.Asset.AssetSetProxyMethodInfo
    ResolveProjectMethod "setString" o = GES.MetaContainer.MetaContainerSetStringMethodInfo
    ResolveProjectMethod "setUint" o = GES.MetaContainer.MetaContainerSetUintMethodInfo
    ResolveProjectMethod "setUint64" o = GES.MetaContainer.MetaContainerSetUint64MethodInfo
    ResolveProjectMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Project::asset-added
-- | /No description available in the introspection data./
type ProjectAssetAddedCallback =
    GES.Asset.Asset
    -- ^ /@asset@/: The t'GI.GES.Objects.Asset.Asset' that has been added to /@project@/
    -> IO ()

type C_ProjectAssetAddedCallback =
    Ptr Project ->                          -- object
    Ptr GES.Asset.Asset ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ProjectAssetAddedCallback :: 
    GObject a => (a -> ProjectAssetAddedCallback) ->
    C_ProjectAssetAddedCallback
wrap_ProjectAssetAddedCallback :: forall a.
GObject a =>
(a -> ProjectAssetAddedCallback) -> C_ProjectAssetAddedCallback
wrap_ProjectAssetAddedCallback a -> ProjectAssetAddedCallback
gi'cb Ptr Project
gi'selfPtr Ptr Asset
asset Ptr ()
_ = do
    Asset
asset' <- ((ManagedPtr Asset -> Asset) -> Ptr Asset -> IO Asset
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Asset -> Asset
GES.Asset.Asset) Ptr Asset
asset
    Ptr Project -> (Project -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Project
gi'selfPtr ((Project -> IO ()) -> IO ()) -> (Project -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Project
gi'self -> a -> ProjectAssetAddedCallback
gi'cb (Project -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Project
gi'self)  Asset
asset'


-- | Connect a signal handler for the [assetAdded](#signal:assetAdded) 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' project #assetAdded callback
-- @
-- 
-- 
onProjectAssetAdded :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectAssetAddedCallback) -> m SignalHandlerId
onProjectAssetAdded :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a -> ((?self::a) => ProjectAssetAddedCallback) -> m SignalHandlerId
onProjectAssetAdded a
obj (?self::a) => ProjectAssetAddedCallback
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 -> ProjectAssetAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectAssetAddedCallback
ProjectAssetAddedCallback
cb
    let wrapped' :: C_ProjectAssetAddedCallback
wrapped' = (a -> ProjectAssetAddedCallback) -> C_ProjectAssetAddedCallback
forall a.
GObject a =>
(a -> ProjectAssetAddedCallback) -> C_ProjectAssetAddedCallback
wrap_ProjectAssetAddedCallback a -> ProjectAssetAddedCallback
wrapped
    FunPtr C_ProjectAssetAddedCallback
wrapped'' <- C_ProjectAssetAddedCallback
-> IO (FunPtr C_ProjectAssetAddedCallback)
mk_ProjectAssetAddedCallback C_ProjectAssetAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectAssetAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"asset-added" FunPtr C_ProjectAssetAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [assetAdded](#signal:assetAdded) 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' project #assetAdded 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.
-- 
afterProjectAssetAdded :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectAssetAddedCallback) -> m SignalHandlerId
afterProjectAssetAdded :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a -> ((?self::a) => ProjectAssetAddedCallback) -> m SignalHandlerId
afterProjectAssetAdded a
obj (?self::a) => ProjectAssetAddedCallback
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 -> ProjectAssetAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectAssetAddedCallback
ProjectAssetAddedCallback
cb
    let wrapped' :: C_ProjectAssetAddedCallback
wrapped' = (a -> ProjectAssetAddedCallback) -> C_ProjectAssetAddedCallback
forall a.
GObject a =>
(a -> ProjectAssetAddedCallback) -> C_ProjectAssetAddedCallback
wrap_ProjectAssetAddedCallback a -> ProjectAssetAddedCallback
wrapped
    FunPtr C_ProjectAssetAddedCallback
wrapped'' <- C_ProjectAssetAddedCallback
-> IO (FunPtr C_ProjectAssetAddedCallback)
mk_ProjectAssetAddedCallback C_ProjectAssetAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectAssetAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"asset-added" FunPtr C_ProjectAssetAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ProjectAssetAddedSignalInfo
instance SignalInfo ProjectAssetAddedSignalInfo where
    type HaskellCallbackType ProjectAssetAddedSignalInfo = ProjectAssetAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ProjectAssetAddedCallback cb
        cb'' <- mk_ProjectAssetAddedCallback cb'
        connectSignalFunPtr obj "asset-added" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Project::asset-added"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Project.html#g:signal:assetAdded"})

#endif

-- signal Project::asset-loading
-- | /No description available in the introspection data./
-- 
-- /Since: 1.8/
type ProjectAssetLoadingCallback =
    GES.Asset.Asset
    -- ^ /@asset@/: The t'GI.GES.Objects.Asset.Asset' that started loading
    -> IO ()

type C_ProjectAssetLoadingCallback =
    Ptr Project ->                          -- object
    Ptr GES.Asset.Asset ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ProjectAssetLoadingCallback :: 
    GObject a => (a -> ProjectAssetLoadingCallback) ->
    C_ProjectAssetLoadingCallback
wrap_ProjectAssetLoadingCallback :: forall a.
GObject a =>
(a -> ProjectAssetAddedCallback) -> C_ProjectAssetAddedCallback
wrap_ProjectAssetLoadingCallback a -> ProjectAssetAddedCallback
gi'cb Ptr Project
gi'selfPtr Ptr Asset
asset Ptr ()
_ = do
    Asset
asset' <- ((ManagedPtr Asset -> Asset) -> Ptr Asset -> IO Asset
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Asset -> Asset
GES.Asset.Asset) Ptr Asset
asset
    Ptr Project -> (Project -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Project
gi'selfPtr ((Project -> IO ()) -> IO ()) -> (Project -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Project
gi'self -> a -> ProjectAssetAddedCallback
gi'cb (Project -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Project
gi'self)  Asset
asset'


-- | Connect a signal handler for the [assetLoading](#signal:assetLoading) 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' project #assetLoading callback
-- @
-- 
-- 
onProjectAssetLoading :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectAssetLoadingCallback) -> m SignalHandlerId
onProjectAssetLoading :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a -> ((?self::a) => ProjectAssetAddedCallback) -> m SignalHandlerId
onProjectAssetLoading a
obj (?self::a) => ProjectAssetAddedCallback
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 -> ProjectAssetAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectAssetAddedCallback
ProjectAssetAddedCallback
cb
    let wrapped' :: C_ProjectAssetAddedCallback
wrapped' = (a -> ProjectAssetAddedCallback) -> C_ProjectAssetAddedCallback
forall a.
GObject a =>
(a -> ProjectAssetAddedCallback) -> C_ProjectAssetAddedCallback
wrap_ProjectAssetLoadingCallback a -> ProjectAssetAddedCallback
wrapped
    FunPtr C_ProjectAssetAddedCallback
wrapped'' <- C_ProjectAssetAddedCallback
-> IO (FunPtr C_ProjectAssetAddedCallback)
mk_ProjectAssetLoadingCallback C_ProjectAssetAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectAssetAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"asset-loading" FunPtr C_ProjectAssetAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [assetLoading](#signal:assetLoading) 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' project #assetLoading 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.
-- 
afterProjectAssetLoading :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectAssetLoadingCallback) -> m SignalHandlerId
afterProjectAssetLoading :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a -> ((?self::a) => ProjectAssetAddedCallback) -> m SignalHandlerId
afterProjectAssetLoading a
obj (?self::a) => ProjectAssetAddedCallback
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 -> ProjectAssetAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectAssetAddedCallback
ProjectAssetAddedCallback
cb
    let wrapped' :: C_ProjectAssetAddedCallback
wrapped' = (a -> ProjectAssetAddedCallback) -> C_ProjectAssetAddedCallback
forall a.
GObject a =>
(a -> ProjectAssetAddedCallback) -> C_ProjectAssetAddedCallback
wrap_ProjectAssetLoadingCallback a -> ProjectAssetAddedCallback
wrapped
    FunPtr C_ProjectAssetAddedCallback
wrapped'' <- C_ProjectAssetAddedCallback
-> IO (FunPtr C_ProjectAssetAddedCallback)
mk_ProjectAssetLoadingCallback C_ProjectAssetAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectAssetAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"asset-loading" FunPtr C_ProjectAssetAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ProjectAssetLoadingSignalInfo
instance SignalInfo ProjectAssetLoadingSignalInfo where
    type HaskellCallbackType ProjectAssetLoadingSignalInfo = ProjectAssetLoadingCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ProjectAssetLoadingCallback cb
        cb'' <- mk_ProjectAssetLoadingCallback cb'
        connectSignalFunPtr obj "asset-loading" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Project::asset-loading"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Project.html#g:signal:assetLoading"})

#endif

-- signal Project::asset-removed
-- | /No description available in the introspection data./
type ProjectAssetRemovedCallback =
    GES.Asset.Asset
    -- ^ /@asset@/: The t'GI.GES.Objects.Asset.Asset' that has been removed from /@project@/
    -> IO ()

type C_ProjectAssetRemovedCallback =
    Ptr Project ->                          -- object
    Ptr GES.Asset.Asset ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ProjectAssetRemovedCallback :: 
    GObject a => (a -> ProjectAssetRemovedCallback) ->
    C_ProjectAssetRemovedCallback
wrap_ProjectAssetRemovedCallback :: forall a.
GObject a =>
(a -> ProjectAssetAddedCallback) -> C_ProjectAssetAddedCallback
wrap_ProjectAssetRemovedCallback a -> ProjectAssetAddedCallback
gi'cb Ptr Project
gi'selfPtr Ptr Asset
asset Ptr ()
_ = do
    Asset
asset' <- ((ManagedPtr Asset -> Asset) -> Ptr Asset -> IO Asset
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Asset -> Asset
GES.Asset.Asset) Ptr Asset
asset
    Ptr Project -> (Project -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Project
gi'selfPtr ((Project -> IO ()) -> IO ()) -> (Project -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Project
gi'self -> a -> ProjectAssetAddedCallback
gi'cb (Project -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Project
gi'self)  Asset
asset'


-- | Connect a signal handler for the [assetRemoved](#signal:assetRemoved) 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' project #assetRemoved callback
-- @
-- 
-- 
onProjectAssetRemoved :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectAssetRemovedCallback) -> m SignalHandlerId
onProjectAssetRemoved :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a -> ((?self::a) => ProjectAssetAddedCallback) -> m SignalHandlerId
onProjectAssetRemoved a
obj (?self::a) => ProjectAssetAddedCallback
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 -> ProjectAssetAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectAssetAddedCallback
ProjectAssetAddedCallback
cb
    let wrapped' :: C_ProjectAssetAddedCallback
wrapped' = (a -> ProjectAssetAddedCallback) -> C_ProjectAssetAddedCallback
forall a.
GObject a =>
(a -> ProjectAssetAddedCallback) -> C_ProjectAssetAddedCallback
wrap_ProjectAssetRemovedCallback a -> ProjectAssetAddedCallback
wrapped
    FunPtr C_ProjectAssetAddedCallback
wrapped'' <- C_ProjectAssetAddedCallback
-> IO (FunPtr C_ProjectAssetAddedCallback)
mk_ProjectAssetRemovedCallback C_ProjectAssetAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectAssetAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"asset-removed" FunPtr C_ProjectAssetAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [assetRemoved](#signal:assetRemoved) 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' project #assetRemoved 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.
-- 
afterProjectAssetRemoved :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectAssetRemovedCallback) -> m SignalHandlerId
afterProjectAssetRemoved :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a -> ((?self::a) => ProjectAssetAddedCallback) -> m SignalHandlerId
afterProjectAssetRemoved a
obj (?self::a) => ProjectAssetAddedCallback
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 -> ProjectAssetAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectAssetAddedCallback
ProjectAssetAddedCallback
cb
    let wrapped' :: C_ProjectAssetAddedCallback
wrapped' = (a -> ProjectAssetAddedCallback) -> C_ProjectAssetAddedCallback
forall a.
GObject a =>
(a -> ProjectAssetAddedCallback) -> C_ProjectAssetAddedCallback
wrap_ProjectAssetRemovedCallback a -> ProjectAssetAddedCallback
wrapped
    FunPtr C_ProjectAssetAddedCallback
wrapped'' <- C_ProjectAssetAddedCallback
-> IO (FunPtr C_ProjectAssetAddedCallback)
mk_ProjectAssetRemovedCallback C_ProjectAssetAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectAssetAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"asset-removed" FunPtr C_ProjectAssetAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ProjectAssetRemovedSignalInfo
instance SignalInfo ProjectAssetRemovedSignalInfo where
    type HaskellCallbackType ProjectAssetRemovedSignalInfo = ProjectAssetRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ProjectAssetRemovedCallback cb
        cb'' <- mk_ProjectAssetRemovedCallback cb'
        connectSignalFunPtr obj "asset-removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Project::asset-removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Project.html#g:signal:assetRemoved"})

#endif

-- signal Project::error-loading
-- | /No description available in the introspection data./
-- 
-- /Since: 1.18/
type ProjectErrorLoadingCallback =
    GES.Timeline.Timeline
    -- ^ /@timeline@/: The timeline that failed loading
    -> GError
    -- ^ /@error@/: The t'GError' defining the error that occured
    -> IO ()

type C_ProjectErrorLoadingCallback =
    Ptr Project ->                          -- object
    Ptr GES.Timeline.Timeline ->
    Ptr GError ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ProjectErrorLoadingCallback :: 
    GObject a => (a -> ProjectErrorLoadingCallback) ->
    C_ProjectErrorLoadingCallback
wrap_ProjectErrorLoadingCallback :: forall a.
GObject a =>
(a -> ProjectErrorLoadingCallback) -> C_ProjectErrorLoadingCallback
wrap_ProjectErrorLoadingCallback a -> ProjectErrorLoadingCallback
gi'cb Ptr Project
gi'selfPtr Ptr Timeline
timeline Ptr GError
error_ Ptr ()
_ = do
    Timeline
timeline' <- ((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
timeline
    GError
error_' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GError -> GError
GError) Ptr GError
error_
    Ptr Project -> (Project -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Project
gi'selfPtr ((Project -> IO ()) -> IO ()) -> (Project -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Project
gi'self -> a -> ProjectErrorLoadingCallback
gi'cb (Project -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Project
gi'self)  Timeline
timeline' GError
error_'


-- | Connect a signal handler for the [errorLoading](#signal:errorLoading) 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' project #errorLoading callback
-- @
-- 
-- 
onProjectErrorLoading :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectErrorLoadingCallback) -> m SignalHandlerId
onProjectErrorLoading :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a
-> ((?self::a) => ProjectErrorLoadingCallback) -> m SignalHandlerId
onProjectErrorLoading a
obj (?self::a) => ProjectErrorLoadingCallback
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 -> ProjectErrorLoadingCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectErrorLoadingCallback
ProjectErrorLoadingCallback
cb
    let wrapped' :: C_ProjectErrorLoadingCallback
wrapped' = (a -> ProjectErrorLoadingCallback) -> C_ProjectErrorLoadingCallback
forall a.
GObject a =>
(a -> ProjectErrorLoadingCallback) -> C_ProjectErrorLoadingCallback
wrap_ProjectErrorLoadingCallback a -> ProjectErrorLoadingCallback
wrapped
    FunPtr C_ProjectErrorLoadingCallback
wrapped'' <- C_ProjectErrorLoadingCallback
-> IO (FunPtr C_ProjectErrorLoadingCallback)
mk_ProjectErrorLoadingCallback C_ProjectErrorLoadingCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectErrorLoadingCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"error-loading" FunPtr C_ProjectErrorLoadingCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [errorLoading](#signal:errorLoading) 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' project #errorLoading 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.
-- 
afterProjectErrorLoading :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectErrorLoadingCallback) -> m SignalHandlerId
afterProjectErrorLoading :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a
-> ((?self::a) => ProjectErrorLoadingCallback) -> m SignalHandlerId
afterProjectErrorLoading a
obj (?self::a) => ProjectErrorLoadingCallback
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 -> ProjectErrorLoadingCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectErrorLoadingCallback
ProjectErrorLoadingCallback
cb
    let wrapped' :: C_ProjectErrorLoadingCallback
wrapped' = (a -> ProjectErrorLoadingCallback) -> C_ProjectErrorLoadingCallback
forall a.
GObject a =>
(a -> ProjectErrorLoadingCallback) -> C_ProjectErrorLoadingCallback
wrap_ProjectErrorLoadingCallback a -> ProjectErrorLoadingCallback
wrapped
    FunPtr C_ProjectErrorLoadingCallback
wrapped'' <- C_ProjectErrorLoadingCallback
-> IO (FunPtr C_ProjectErrorLoadingCallback)
mk_ProjectErrorLoadingCallback C_ProjectErrorLoadingCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectErrorLoadingCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"error-loading" FunPtr C_ProjectErrorLoadingCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ProjectErrorLoadingSignalInfo
instance SignalInfo ProjectErrorLoadingSignalInfo where
    type HaskellCallbackType ProjectErrorLoadingSignalInfo = ProjectErrorLoadingCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ProjectErrorLoadingCallback cb
        cb'' <- mk_ProjectErrorLoadingCallback cb'
        connectSignalFunPtr obj "error-loading" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Project::error-loading"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Project.html#g:signal:errorLoading"})

#endif

-- signal Project::error-loading-asset
-- | Informs you that a t'GI.GES.Objects.Asset.Asset' could not be created. In case of
-- missing GStreamer plugins, the error will be set to @/GST_CORE_ERROR/@
-- @/GST_CORE_ERROR_MISSING_PLUGIN/@
type ProjectErrorLoadingAssetCallback =
    GError
    -- ^ /@error@/: The t'GError' defining the error that occured, might be 'P.Nothing'
    -> T.Text
    -- ^ /@id@/: The /@id@/ of the asset that failed loading
    -> GType
    -- ^ /@extractableType@/: The /@extractableType@/ of the asset that
    -- failed loading
    -> IO ()

type C_ProjectErrorLoadingAssetCallback =
    Ptr Project ->                          -- object
    Ptr GError ->
    CString ->
    CGType ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ProjectErrorLoadingAssetCallback :: 
    GObject a => (a -> ProjectErrorLoadingAssetCallback) ->
    C_ProjectErrorLoadingAssetCallback
wrap_ProjectErrorLoadingAssetCallback :: forall a.
GObject a =>
(a -> ProjectErrorLoadingAssetCallback)
-> C_ProjectErrorLoadingAssetCallback
wrap_ProjectErrorLoadingAssetCallback a -> ProjectErrorLoadingAssetCallback
gi'cb Ptr Project
gi'selfPtr Ptr GError
error_ CString
id CGType
extractableType Ptr ()
_ = do
    GError
error_' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GError -> GError
GError) Ptr GError
error_
    Text
id' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
id
    let extractableType' :: GType
extractableType' = CGType -> GType
GType CGType
extractableType
    Ptr Project -> (Project -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Project
gi'selfPtr ((Project -> IO ()) -> IO ()) -> (Project -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Project
gi'self -> a -> ProjectErrorLoadingAssetCallback
gi'cb (Project -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Project
gi'self)  GError
error_' Text
id' GType
extractableType'


-- | Connect a signal handler for the [errorLoadingAsset](#signal:errorLoadingAsset) 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' project #errorLoadingAsset callback
-- @
-- 
-- 
onProjectErrorLoadingAsset :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectErrorLoadingAssetCallback) -> m SignalHandlerId
onProjectErrorLoadingAsset :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a
-> ((?self::a) => ProjectErrorLoadingAssetCallback)
-> m SignalHandlerId
onProjectErrorLoadingAsset a
obj (?self::a) => ProjectErrorLoadingAssetCallback
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 -> ProjectErrorLoadingAssetCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectErrorLoadingAssetCallback
ProjectErrorLoadingAssetCallback
cb
    let wrapped' :: C_ProjectErrorLoadingAssetCallback
wrapped' = (a -> ProjectErrorLoadingAssetCallback)
-> C_ProjectErrorLoadingAssetCallback
forall a.
GObject a =>
(a -> ProjectErrorLoadingAssetCallback)
-> C_ProjectErrorLoadingAssetCallback
wrap_ProjectErrorLoadingAssetCallback a -> ProjectErrorLoadingAssetCallback
wrapped
    FunPtr C_ProjectErrorLoadingAssetCallback
wrapped'' <- C_ProjectErrorLoadingAssetCallback
-> IO (FunPtr C_ProjectErrorLoadingAssetCallback)
mk_ProjectErrorLoadingAssetCallback C_ProjectErrorLoadingAssetCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectErrorLoadingAssetCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"error-loading-asset" FunPtr C_ProjectErrorLoadingAssetCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [errorLoadingAsset](#signal:errorLoadingAsset) 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' project #errorLoadingAsset 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.
-- 
afterProjectErrorLoadingAsset :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectErrorLoadingAssetCallback) -> m SignalHandlerId
afterProjectErrorLoadingAsset :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a
-> ((?self::a) => ProjectErrorLoadingAssetCallback)
-> m SignalHandlerId
afterProjectErrorLoadingAsset a
obj (?self::a) => ProjectErrorLoadingAssetCallback
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 -> ProjectErrorLoadingAssetCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectErrorLoadingAssetCallback
ProjectErrorLoadingAssetCallback
cb
    let wrapped' :: C_ProjectErrorLoadingAssetCallback
wrapped' = (a -> ProjectErrorLoadingAssetCallback)
-> C_ProjectErrorLoadingAssetCallback
forall a.
GObject a =>
(a -> ProjectErrorLoadingAssetCallback)
-> C_ProjectErrorLoadingAssetCallback
wrap_ProjectErrorLoadingAssetCallback a -> ProjectErrorLoadingAssetCallback
wrapped
    FunPtr C_ProjectErrorLoadingAssetCallback
wrapped'' <- C_ProjectErrorLoadingAssetCallback
-> IO (FunPtr C_ProjectErrorLoadingAssetCallback)
mk_ProjectErrorLoadingAssetCallback C_ProjectErrorLoadingAssetCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectErrorLoadingAssetCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"error-loading-asset" FunPtr C_ProjectErrorLoadingAssetCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ProjectErrorLoadingAssetSignalInfo
instance SignalInfo ProjectErrorLoadingAssetSignalInfo where
    type HaskellCallbackType ProjectErrorLoadingAssetSignalInfo = ProjectErrorLoadingAssetCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ProjectErrorLoadingAssetCallback cb
        cb'' <- mk_ProjectErrorLoadingAssetCallback cb'
        connectSignalFunPtr obj "error-loading-asset" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Project::error-loading-asset"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Project.html#g:signal:errorLoadingAsset"})

#endif

-- signal Project::loaded
-- | /No description available in the introspection data./
type ProjectLoadedCallback =
    GES.Timeline.Timeline
    -- ^ /@timeline@/: The t'GI.GES.Objects.Timeline.Timeline' that completed loading
    -> IO ()

type C_ProjectLoadedCallback =
    Ptr Project ->                          -- object
    Ptr GES.Timeline.Timeline ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ProjectLoadedCallback :: 
    GObject a => (a -> ProjectLoadedCallback) ->
    C_ProjectLoadedCallback
wrap_ProjectLoadedCallback :: forall a.
GObject a =>
(a -> ProjectLoadedCallback) -> C_ProjectLoadedCallback
wrap_ProjectLoadedCallback a -> ProjectLoadedCallback
gi'cb Ptr Project
gi'selfPtr Ptr Timeline
timeline Ptr ()
_ = do
    Timeline
timeline' <- ((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
timeline
    Ptr Project -> (Project -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Project
gi'selfPtr ((Project -> IO ()) -> IO ()) -> (Project -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Project
gi'self -> a -> ProjectLoadedCallback
gi'cb (Project -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Project
gi'self)  Timeline
timeline'


-- | Connect a signal handler for the [loaded](#signal:loaded) 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' project #loaded callback
-- @
-- 
-- 
onProjectLoaded :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectLoadedCallback) -> m SignalHandlerId
onProjectLoaded :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a -> ((?self::a) => ProjectLoadedCallback) -> m SignalHandlerId
onProjectLoaded a
obj (?self::a) => ProjectLoadedCallback
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 -> ProjectLoadedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectLoadedCallback
ProjectLoadedCallback
cb
    let wrapped' :: C_ProjectLoadedCallback
wrapped' = (a -> ProjectLoadedCallback) -> C_ProjectLoadedCallback
forall a.
GObject a =>
(a -> ProjectLoadedCallback) -> C_ProjectLoadedCallback
wrap_ProjectLoadedCallback a -> ProjectLoadedCallback
wrapped
    FunPtr C_ProjectLoadedCallback
wrapped'' <- C_ProjectLoadedCallback -> IO (FunPtr C_ProjectLoadedCallback)
mk_ProjectLoadedCallback C_ProjectLoadedCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectLoadedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"loaded" FunPtr C_ProjectLoadedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [loaded](#signal:loaded) 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' project #loaded 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.
-- 
afterProjectLoaded :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectLoadedCallback) -> m SignalHandlerId
afterProjectLoaded :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a -> ((?self::a) => ProjectLoadedCallback) -> m SignalHandlerId
afterProjectLoaded a
obj (?self::a) => ProjectLoadedCallback
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 -> ProjectLoadedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectLoadedCallback
ProjectLoadedCallback
cb
    let wrapped' :: C_ProjectLoadedCallback
wrapped' = (a -> ProjectLoadedCallback) -> C_ProjectLoadedCallback
forall a.
GObject a =>
(a -> ProjectLoadedCallback) -> C_ProjectLoadedCallback
wrap_ProjectLoadedCallback a -> ProjectLoadedCallback
wrapped
    FunPtr C_ProjectLoadedCallback
wrapped'' <- C_ProjectLoadedCallback -> IO (FunPtr C_ProjectLoadedCallback)
mk_ProjectLoadedCallback C_ProjectLoadedCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectLoadedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"loaded" FunPtr C_ProjectLoadedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ProjectLoadedSignalInfo
instance SignalInfo ProjectLoadedSignalInfo where
    type HaskellCallbackType ProjectLoadedSignalInfo = ProjectLoadedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ProjectLoadedCallback cb
        cb'' <- mk_ProjectLoadedCallback cb'
        connectSignalFunPtr obj "loaded" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Project::loaded"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Project.html#g:signal:loaded"})

#endif

-- signal Project::loading
-- | /No description available in the introspection data./
-- 
-- /Since: 1.18/
type ProjectLoadingCallback =
    GES.Timeline.Timeline
    -- ^ /@timeline@/: The t'GI.GES.Objects.Timeline.Timeline' that started loading
    -> IO ()

type C_ProjectLoadingCallback =
    Ptr Project ->                          -- object
    Ptr GES.Timeline.Timeline ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ProjectLoadingCallback :: 
    GObject a => (a -> ProjectLoadingCallback) ->
    C_ProjectLoadingCallback
wrap_ProjectLoadingCallback :: forall a.
GObject a =>
(a -> ProjectLoadedCallback) -> C_ProjectLoadedCallback
wrap_ProjectLoadingCallback a -> ProjectLoadedCallback
gi'cb Ptr Project
gi'selfPtr Ptr Timeline
timeline Ptr ()
_ = do
    Timeline
timeline' <- ((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
timeline
    Ptr Project -> (Project -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Project
gi'selfPtr ((Project -> IO ()) -> IO ()) -> (Project -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Project
gi'self -> a -> ProjectLoadedCallback
gi'cb (Project -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Project
gi'self)  Timeline
timeline'


-- | Connect a signal handler for the [loading](#signal:loading) 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' project #loading callback
-- @
-- 
-- 
onProjectLoading :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectLoadingCallback) -> m SignalHandlerId
onProjectLoading :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a -> ((?self::a) => ProjectLoadedCallback) -> m SignalHandlerId
onProjectLoading a
obj (?self::a) => ProjectLoadedCallback
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 -> ProjectLoadedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectLoadedCallback
ProjectLoadedCallback
cb
    let wrapped' :: C_ProjectLoadedCallback
wrapped' = (a -> ProjectLoadedCallback) -> C_ProjectLoadedCallback
forall a.
GObject a =>
(a -> ProjectLoadedCallback) -> C_ProjectLoadedCallback
wrap_ProjectLoadingCallback a -> ProjectLoadedCallback
wrapped
    FunPtr C_ProjectLoadedCallback
wrapped'' <- C_ProjectLoadedCallback -> IO (FunPtr C_ProjectLoadedCallback)
mk_ProjectLoadingCallback C_ProjectLoadedCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectLoadedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"loading" FunPtr C_ProjectLoadedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [loading](#signal:loading) 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' project #loading 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.
-- 
afterProjectLoading :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectLoadingCallback) -> m SignalHandlerId
afterProjectLoading :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a -> ((?self::a) => ProjectLoadedCallback) -> m SignalHandlerId
afterProjectLoading a
obj (?self::a) => ProjectLoadedCallback
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 -> ProjectLoadedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectLoadedCallback
ProjectLoadedCallback
cb
    let wrapped' :: C_ProjectLoadedCallback
wrapped' = (a -> ProjectLoadedCallback) -> C_ProjectLoadedCallback
forall a.
GObject a =>
(a -> ProjectLoadedCallback) -> C_ProjectLoadedCallback
wrap_ProjectLoadingCallback a -> ProjectLoadedCallback
wrapped
    FunPtr C_ProjectLoadedCallback
wrapped'' <- C_ProjectLoadedCallback -> IO (FunPtr C_ProjectLoadedCallback)
mk_ProjectLoadingCallback C_ProjectLoadedCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectLoadedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"loading" FunPtr C_ProjectLoadedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ProjectLoadingSignalInfo
instance SignalInfo ProjectLoadingSignalInfo where
    type HaskellCallbackType ProjectLoadingSignalInfo = ProjectLoadingCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ProjectLoadingCallback cb
        cb'' <- mk_ProjectLoadingCallback cb'
        connectSignalFunPtr obj "loading" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Project::loading"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Project.html#g:signal:loading"})

#endif

-- signal Project::missing-uri
-- | >
-- >static gchar
-- >source_moved_cb (GESProject *project, GError *error, GESAsset *asset_with_error)
-- >{
-- >  return g_strdup ("file:///the/new/uri.ogg");
-- >}
-- >
-- >static int
-- >main (int argc, gchar ** argv)
-- >{
-- >  GESTimeline *timeline;
-- >  GESProject *project = ges_project_new ("file:///some/uri.xges");
-- >
-- >  g_signal_connect (project, "missing-uri", source_moved_cb, NULL);
-- >  timeline = ges_asset_extract (GES_ASSET (project));
-- >}
type ProjectMissingUriCallback =
    GError
    -- ^ /@error@/: The error that happened
    -> GES.Asset.Asset
    -- ^ /@wrongAsset@/: The asset with the wrong ID, you should us it and its content
    -- only to find out what the new location is.
    -> IO (Maybe T.Text)
    -- ^ __Returns:__ The new URI of /@wrongAsset@/

type C_ProjectMissingUriCallback =
    Ptr Project ->                          -- object
    Ptr GError ->
    Ptr GES.Asset.Asset ->
    Ptr () ->                               -- user_data
    IO CString

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

wrap_ProjectMissingUriCallback :: 
    GObject a => (a -> ProjectMissingUriCallback) ->
    C_ProjectMissingUriCallback
wrap_ProjectMissingUriCallback :: forall a.
GObject a =>
(a -> ProjectMissingUriCallback) -> C_ProjectMissingUriCallback
wrap_ProjectMissingUriCallback a -> ProjectMissingUriCallback
gi'cb Ptr Project
gi'selfPtr Ptr GError
error_ Ptr Asset
wrongAsset Ptr ()
_ = do
    GError
error_' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GError -> GError
GError) Ptr GError
error_
    Asset
wrongAsset' <- ((ManagedPtr Asset -> Asset) -> Ptr Asset -> IO Asset
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Asset -> Asset
GES.Asset.Asset) Ptr Asset
wrongAsset
    Maybe Text
result <- Ptr Project -> (Project -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Project
gi'selfPtr ((Project -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Project -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Project
gi'self -> a -> ProjectMissingUriCallback
gi'cb (Project -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Project
gi'self)  GError
error_' Asset
wrongAsset'
    CString -> Maybe Text -> (Text -> IO CString) -> IO CString
forall (m :: * -> *) b a.
Monad m =>
b -> Maybe a -> (a -> m b) -> m b
maybeM CString
forall a. Ptr a
FP.nullPtr Maybe Text
result ((Text -> IO CString) -> IO CString)
-> (Text -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Text
result' -> do
        CString
result'' <- Text -> IO CString
textToCString Text
result'
        CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
result''


-- | Connect a signal handler for the [missingUri](#signal:missingUri) 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' project #missingUri callback
-- @
-- 
-- 
onProjectMissingUri :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectMissingUriCallback) -> m SignalHandlerId
onProjectMissingUri :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a -> ((?self::a) => ProjectMissingUriCallback) -> m SignalHandlerId
onProjectMissingUri a
obj (?self::a) => ProjectMissingUriCallback
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 -> ProjectMissingUriCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectMissingUriCallback
ProjectMissingUriCallback
cb
    let wrapped' :: C_ProjectMissingUriCallback
wrapped' = (a -> ProjectMissingUriCallback) -> C_ProjectMissingUriCallback
forall a.
GObject a =>
(a -> ProjectMissingUriCallback) -> C_ProjectMissingUriCallback
wrap_ProjectMissingUriCallback a -> ProjectMissingUriCallback
wrapped
    FunPtr C_ProjectMissingUriCallback
wrapped'' <- C_ProjectMissingUriCallback
-> IO (FunPtr C_ProjectMissingUriCallback)
mk_ProjectMissingUriCallback C_ProjectMissingUriCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectMissingUriCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"missing-uri" FunPtr C_ProjectMissingUriCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [missingUri](#signal:missingUri) 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' project #missingUri 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.
-- 
afterProjectMissingUri :: (IsProject a, MonadIO m) => a -> ((?self :: a) => ProjectMissingUriCallback) -> m SignalHandlerId
afterProjectMissingUri :: forall a (m :: * -> *).
(IsProject a, MonadIO m) =>
a -> ((?self::a) => ProjectMissingUriCallback) -> m SignalHandlerId
afterProjectMissingUri a
obj (?self::a) => ProjectMissingUriCallback
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 -> ProjectMissingUriCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ProjectMissingUriCallback
ProjectMissingUriCallback
cb
    let wrapped' :: C_ProjectMissingUriCallback
wrapped' = (a -> ProjectMissingUriCallback) -> C_ProjectMissingUriCallback
forall a.
GObject a =>
(a -> ProjectMissingUriCallback) -> C_ProjectMissingUriCallback
wrap_ProjectMissingUriCallback a -> ProjectMissingUriCallback
wrapped
    FunPtr C_ProjectMissingUriCallback
wrapped'' <- C_ProjectMissingUriCallback
-> IO (FunPtr C_ProjectMissingUriCallback)
mk_ProjectMissingUriCallback C_ProjectMissingUriCallback
wrapped'
    a
-> Text
-> FunPtr C_ProjectMissingUriCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"missing-uri" FunPtr C_ProjectMissingUriCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ProjectMissingUriSignalInfo
instance SignalInfo ProjectMissingUriSignalInfo where
    type HaskellCallbackType ProjectMissingUriSignalInfo = ProjectMissingUriCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ProjectMissingUriCallback cb
        cb'' <- mk_ProjectMissingUriCallback cb'
        connectSignalFunPtr obj "missing-uri" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Project::missing-uri"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Project.html#g:signal:missingUri"})

#endif

-- VVV Prop "uri"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@uri@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructProjectUri :: (IsProject o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructProjectUri :: forall o (m :: * -> *).
(IsProject o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructProjectUri Text
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 -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"uri" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data ProjectUriPropertyInfo
instance AttrInfo ProjectUriPropertyInfo where
    type AttrAllowedOps ProjectUriPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ProjectUriPropertyInfo = IsProject
    type AttrSetTypeConstraint ProjectUriPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ProjectUriPropertyInfo = (~) T.Text
    type AttrTransferType ProjectUriPropertyInfo = T.Text
    type AttrGetType ProjectUriPropertyInfo = (Maybe T.Text)
    type AttrLabel ProjectUriPropertyInfo = "uri"
    type AttrOrigin ProjectUriPropertyInfo = Project
    attrGet = getProjectUri
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructProjectUri
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Project.uri"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Project.html#g:attr:uri"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Project
type instance O.AttributeList Project = ProjectAttributeList
type ProjectAttributeList = ('[ '("extractableType", GES.Asset.AssetExtractableTypePropertyInfo), '("id", GES.Asset.AssetIdPropertyInfo), '("proxy", GES.Asset.AssetProxyPropertyInfo), '("proxyTarget", GES.Asset.AssetProxyTargetPropertyInfo), '("uri", ProjectUriPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
projectUri :: AttrLabelProxy "uri"
projectUri = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Project = ProjectSignalList
type ProjectSignalList = ('[ '("assetAdded", ProjectAssetAddedSignalInfo), '("assetLoading", ProjectAssetLoadingSignalInfo), '("assetRemoved", ProjectAssetRemovedSignalInfo), '("errorLoading", ProjectErrorLoadingSignalInfo), '("errorLoadingAsset", ProjectErrorLoadingAssetSignalInfo), '("loaded", ProjectLoadedSignalInfo), '("loading", ProjectLoadingSignalInfo), '("missingUri", ProjectMissingUriSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("notifyMeta", GES.MetaContainer.MetaContainerNotifyMetaSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Project::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The uri to be set after creating the project."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GES" , name = "Project" })
-- throws : False
-- Skip return : False

foreign import ccall "ges_project_new" ges_project_new :: 
    CString ->                              -- uri : TBasicType TUTF8
    IO (Ptr Project)

-- | Creates a new t'GI.GES.Objects.Project.Project' and sets its uri to /@uri@/ if provided. Note that
-- if /@uri@/ is not valid or 'P.Nothing', the uri of the project will then be set
-- the first time you save the project. If you then save the project to
-- other locations, it will never be updated again and the first valid URI is
-- the URI it will keep refering to.
projectNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@uri@/: The uri to be set after creating the project.
    -> m Project
    -- ^ __Returns:__ A newly created t'GI.GES.Objects.Project.Project'
projectNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> m Project
projectNew Maybe Text
uri = IO Project -> m Project
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Project -> m Project) -> IO Project -> m Project
forall a b. (a -> b) -> a -> b
$ do
    CString
maybeUri <- case Maybe Text
uri of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jUri -> do
            CString
jUri' <- Text -> IO CString
textToCString Text
jUri
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jUri'
    Ptr Project
result <- CString -> IO (Ptr Project)
ges_project_new CString
maybeUri
    Text -> Ptr Project -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"projectNew" Ptr Project
result
    Project
result' <- ((ManagedPtr Project -> Project) -> Ptr Project -> IO Project
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Project -> Project
Project) Ptr Project
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeUri
    Project -> IO Project
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Project
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Project::add_asset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "project"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Project" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESProject" , 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 "A #GESAsset to add to @project"
--                 , 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_project_add_asset" ges_project_add_asset :: 
    Ptr Project ->                          -- project : TInterface (Name {namespace = "GES", name = "Project"})
    Ptr GES.Asset.Asset ->                  -- asset : TInterface (Name {namespace = "GES", name = "Asset"})
    IO CInt

-- | Adds a t'GI.GES.Objects.Asset.Asset' to /@project@/, the project will keep a reference on
-- /@asset@/.
projectAddAsset ::
    (B.CallStack.HasCallStack, MonadIO m, IsProject a, GES.Asset.IsAsset b) =>
    a
    -- ^ /@project@/: A t'GI.GES.Objects.Project.Project'
    -> b
    -- ^ /@asset@/: A t'GI.GES.Objects.Asset.Asset' to add to /@project@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the asset could be added 'P.False' it was already
    -- in the project
projectAddAsset :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsProject a, IsAsset b) =>
a -> b -> m Bool
projectAddAsset a
project b
asset = 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 Project
project' <- a -> IO (Ptr Project)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
project
    Ptr Asset
asset' <- b -> IO (Ptr Asset)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
asset
    CInt
result <- Ptr Project -> Ptr Asset -> IO CInt
ges_project_add_asset Ptr Project
project' Ptr Asset
asset'
    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
project
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
asset
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ProjectAddAssetMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsProject a, GES.Asset.IsAsset b) => O.OverloadedMethod ProjectAddAssetMethodInfo a signature where
    overloadedMethod = projectAddAsset

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


#endif

-- method Project::add_encoding_profile
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "project"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Project" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESProject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "profile"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "EncodingProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GstEncodingProfile to add to the project. If a profile with\nthe same name already exists, it will be replaced"
--                 , 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_project_add_encoding_profile" ges_project_add_encoding_profile :: 
    Ptr Project ->                          -- project : TInterface (Name {namespace = "GES", name = "Project"})
    Ptr GstPbutils.EncodingProfile.EncodingProfile -> -- profile : TInterface (Name {namespace = "GstPbutils", name = "EncodingProfile"})
    IO CInt

-- | Adds /@profile@/ to the project. It lets you save in what format
-- the project has been renders and keep a reference to those formats.
-- Also, those formats will be saves to the project file when possible.
projectAddEncodingProfile ::
    (B.CallStack.HasCallStack, MonadIO m, IsProject a, GstPbutils.EncodingProfile.IsEncodingProfile b) =>
    a
    -- ^ /@project@/: A t'GI.GES.Objects.Project.Project'
    -> b
    -- ^ /@profile@/: A t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile' to add to the project. If a profile with
    -- the same name already exists, it will be replaced
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@profile@/ could be added, 'P.False' otherwize
projectAddEncodingProfile :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsProject a, IsEncodingProfile b) =>
a -> b -> m Bool
projectAddEncodingProfile a
project b
profile = 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 Project
project' <- a -> IO (Ptr Project)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
project
    Ptr EncodingProfile
profile' <- b -> IO (Ptr EncodingProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
profile
    CInt
result <- Ptr Project -> Ptr EncodingProfile -> IO CInt
ges_project_add_encoding_profile Ptr Project
project' Ptr EncodingProfile
profile'
    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
project
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
profile
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ProjectAddEncodingProfileMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsProject a, GstPbutils.EncodingProfile.IsEncodingProfile b) => O.OverloadedMethod ProjectAddEncodingProfileMethodInfo a signature where
    overloadedMethod = projectAddEncodingProfile

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


#endif

-- method Project::add_formatter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "project"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Project" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The project to add a formatter to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "formatter"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Formatter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A formatter used by @project"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ges_project_add_formatter" ges_project_add_formatter :: 
    Ptr Project ->                          -- project : TInterface (Name {namespace = "GES", name = "Project"})
    Ptr GES.Formatter.Formatter ->          -- formatter : TInterface (Name {namespace = "GES", name = "Formatter"})
    IO ()

-- | Adds a formatter as used to load /@project@/
-- 
-- /Since: 1.18/
projectAddFormatter ::
    (B.CallStack.HasCallStack, MonadIO m, IsProject a, GES.Formatter.IsFormatter b) =>
    a
    -- ^ /@project@/: The project to add a formatter to
    -> b
    -- ^ /@formatter@/: A formatter used by /@project@/
    -> m ()
projectAddFormatter :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsProject a, IsFormatter b) =>
a -> b -> m ()
projectAddFormatter a
project b
formatter = 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 Project
project' <- a -> IO (Ptr Project)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
project
    Ptr Formatter
formatter' <- b -> IO (Ptr Formatter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
formatter
    Ptr Project -> Ptr Formatter -> IO ()
ges_project_add_formatter Ptr Project
project' Ptr Formatter
formatter'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
project
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
formatter
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ProjectAddFormatterMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsProject a, GES.Formatter.IsFormatter b) => O.OverloadedMethod ProjectAddFormatterMethodInfo a signature where
    overloadedMethod = projectAddFormatter

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


#endif

-- method Project::create_asset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "project"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Project" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESProject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The id of the asset to create and add to @project"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "extractable_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GType of the asset to create"
--                 , 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_project_create_asset" ges_project_create_asset :: 
    Ptr Project ->                          -- project : TInterface (Name {namespace = "GES", name = "Project"})
    CString ->                              -- id : TBasicType TUTF8
    CGType ->                               -- extractable_type : TBasicType TGType
    IO CInt

-- | Create and add a t'GI.GES.Objects.Asset.Asset' to /@project@/. You should connect to the
-- \"asset-added\" signal to get the asset when it finally gets added to
-- /@project@/
projectCreateAsset ::
    (B.CallStack.HasCallStack, MonadIO m, IsProject a) =>
    a
    -- ^ /@project@/: A t'GI.GES.Objects.Project.Project'
    -> Maybe (T.Text)
    -- ^ /@id@/: The id of the asset to create and add to /@project@/
    -> GType
    -- ^ /@extractableType@/: The t'GType' of the asset to create
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the asset started to be added 'P.False' it was already
    -- in the project
projectCreateAsset :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProject a) =>
a -> Maybe Text -> GType -> m Bool
projectCreateAsset a
project Maybe Text
id GType
extractableType = 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 Project
project' <- a -> IO (Ptr Project)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
project
    CString
maybeId <- case Maybe Text
id of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jId -> do
            CString
jId' <- Text -> IO CString
textToCString Text
jId
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jId'
    let extractableType' :: CGType
extractableType' = GType -> CGType
gtypeToCGType GType
extractableType
    CInt
result <- Ptr Project -> CString -> CGType -> IO CInt
ges_project_create_asset Ptr Project
project' CString
maybeId CGType
extractableType'
    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
project
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ProjectCreateAssetMethodInfo
instance (signature ~ (Maybe (T.Text) -> GType -> m Bool), MonadIO m, IsProject a) => O.OverloadedMethod ProjectCreateAssetMethodInfo a signature where
    overloadedMethod = projectCreateAsset

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


#endif

-- method Project::create_asset_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "project"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Project" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESProject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The id of the asset to create and add to @project"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "extractable_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GType of the asset to create"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GES" , name = "Asset" })
-- throws : True
-- Skip return : False

foreign import ccall "ges_project_create_asset_sync" ges_project_create_asset_sync :: 
    Ptr Project ->                          -- project : TInterface (Name {namespace = "GES", name = "Project"})
    CString ->                              -- id : TBasicType TUTF8
    CGType ->                               -- extractable_type : TBasicType TGType
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GES.Asset.Asset)

-- | Create and add a t'GI.GES.Objects.Asset.Asset' to /@project@/. You should connect to the
-- \"asset-added\" signal to get the asset when it finally gets added to
-- /@project@/
projectCreateAssetSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsProject a) =>
    a
    -- ^ /@project@/: A t'GI.GES.Objects.Project.Project'
    -> Maybe (T.Text)
    -- ^ /@id@/: The id of the asset to create and add to /@project@/
    -> GType
    -- ^ /@extractableType@/: The t'GType' of the asset to create
    -> m (Maybe GES.Asset.Asset)
    -- ^ __Returns:__ The newly created t'GI.GES.Objects.Asset.Asset' or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
projectCreateAssetSync :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProject a) =>
a -> Maybe Text -> GType -> m (Maybe Asset)
projectCreateAssetSync a
project Maybe Text
id GType
extractableType = IO (Maybe Asset) -> m (Maybe Asset)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Asset) -> m (Maybe Asset))
-> IO (Maybe Asset) -> m (Maybe Asset)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Project
project' <- a -> IO (Ptr Project)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
project
    CString
maybeId <- case Maybe Text
id of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jId -> do
            CString
jId' <- Text -> IO CString
textToCString Text
jId
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jId'
    let extractableType' :: CGType
extractableType' = GType -> CGType
gtypeToCGType GType
extractableType
    IO (Maybe Asset) -> IO () -> IO (Maybe Asset)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Asset
result <- (Ptr (Ptr GError) -> IO (Ptr Asset)) -> IO (Ptr Asset)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Asset)) -> IO (Ptr Asset))
-> (Ptr (Ptr GError) -> IO (Ptr Asset)) -> IO (Ptr Asset)
forall a b. (a -> b) -> a -> b
$ Ptr Project
-> CString -> CGType -> Ptr (Ptr GError) -> IO (Ptr Asset)
ges_project_create_asset_sync Ptr Project
project' CString
maybeId CGType
extractableType'
        Maybe Asset
maybeResult <- Ptr Asset -> (Ptr Asset -> IO Asset) -> IO (Maybe Asset)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Asset
result ((Ptr Asset -> IO Asset) -> IO (Maybe Asset))
-> (Ptr Asset -> IO Asset) -> IO (Maybe Asset)
forall a b. (a -> b) -> a -> b
$ \Ptr Asset
result' -> do
            Asset
result'' <- ((ManagedPtr Asset -> Asset) -> Ptr Asset -> IO Asset
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Asset -> Asset
GES.Asset.Asset) Ptr Asset
result'
            Asset -> IO Asset
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Asset
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
project
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
        Maybe Asset -> IO (Maybe Asset)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Asset
maybeResult
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
     )

#if defined(ENABLE_OVERLOADING)
data ProjectCreateAssetSyncMethodInfo
instance (signature ~ (Maybe (T.Text) -> GType -> m (Maybe GES.Asset.Asset)), MonadIO m, IsProject a) => O.OverloadedMethod ProjectCreateAssetSyncMethodInfo a signature where
    overloadedMethod = projectCreateAssetSync

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


#endif

-- method Project::get_asset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "project"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Project" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESProject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The id of the asset to retrieve"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "extractable_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The extractable_type of the asset\nto retrieve from @object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GES" , name = "Asset" })
-- throws : False
-- Skip return : False

foreign import ccall "ges_project_get_asset" ges_project_get_asset :: 
    Ptr Project ->                          -- project : TInterface (Name {namespace = "GES", name = "Project"})
    CString ->                              -- id : TBasicType TUTF8
    CGType ->                               -- extractable_type : TBasicType TGType
    IO (Ptr GES.Asset.Asset)

-- | /No description available in the introspection data./
projectGetAsset ::
    (B.CallStack.HasCallStack, MonadIO m, IsProject a) =>
    a
    -- ^ /@project@/: A t'GI.GES.Objects.Project.Project'
    -> T.Text
    -- ^ /@id@/: The id of the asset to retrieve
    -> GType
    -- ^ /@extractableType@/: The extractable_type of the asset
    -- to retrieve from /@object@/
    -> m (Maybe GES.Asset.Asset)
    -- ^ __Returns:__ The t'GI.GES.Objects.Asset.Asset' with
    -- /@id@/ or 'P.Nothing' if no asset with /@id@/ as an ID
projectGetAsset :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProject a) =>
a -> Text -> GType -> m (Maybe Asset)
projectGetAsset a
project Text
id GType
extractableType = IO (Maybe Asset) -> m (Maybe Asset)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Asset) -> m (Maybe Asset))
-> IO (Maybe Asset) -> m (Maybe Asset)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Project
project' <- a -> IO (Ptr Project)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
project
    CString
id' <- Text -> IO CString
textToCString Text
id
    let extractableType' :: CGType
extractableType' = GType -> CGType
gtypeToCGType GType
extractableType
    Ptr Asset
result <- Ptr Project -> CString -> CGType -> IO (Ptr Asset)
ges_project_get_asset Ptr Project
project' CString
id' CGType
extractableType'
    Maybe Asset
maybeResult <- Ptr Asset -> (Ptr Asset -> IO Asset) -> IO (Maybe Asset)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Asset
result ((Ptr Asset -> IO Asset) -> IO (Maybe Asset))
-> (Ptr Asset -> IO Asset) -> IO (Maybe Asset)
forall a b. (a -> b) -> a -> b
$ \Ptr Asset
result' -> do
        Asset
result'' <- ((ManagedPtr Asset -> Asset) -> Ptr Asset -> IO Asset
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Asset -> Asset
GES.Asset.Asset) Ptr Asset
result'
        Asset -> IO Asset
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Asset
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
project
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
id'
    Maybe Asset -> IO (Maybe Asset)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Asset
maybeResult

#if defined(ENABLE_OVERLOADING)
data ProjectGetAssetMethodInfo
instance (signature ~ (T.Text -> GType -> m (Maybe GES.Asset.Asset)), MonadIO m, IsProject a) => O.OverloadedMethod ProjectGetAssetMethodInfo a signature where
    overloadedMethod = projectGetAsset

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


#endif

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

foreign import ccall "ges_project_get_loading_assets" ges_project_get_loading_assets :: 
    Ptr Project ->                          -- project : TInterface (Name {namespace = "GES", name = "Project"})
    IO (Ptr (GList (Ptr GES.Asset.Asset)))

-- | Get the assets that are being loaded
projectGetLoadingAssets ::
    (B.CallStack.HasCallStack, MonadIO m, IsProject a) =>
    a
    -- ^ /@project@/: A t'GI.GES.Objects.Project.Project'
    -> m [GES.Asset.Asset]
    -- ^ __Returns:__ A set of loading asset
    -- that will be added to /@project@/. Note that those Asset are *not* loaded yet,
    -- and thus can not be used
projectGetLoadingAssets :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProject a) =>
a -> m [Asset]
projectGetLoadingAssets a
project = IO [Asset] -> m [Asset]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Asset] -> m [Asset]) -> IO [Asset] -> m [Asset]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Project
project' <- a -> IO (Ptr Project)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
project
    Ptr (GList (Ptr Asset))
result <- Ptr Project -> IO (Ptr (GList (Ptr Asset)))
ges_project_get_loading_assets Ptr Project
project'
    [Ptr Asset]
result' <- Ptr (GList (Ptr Asset)) -> IO [Ptr Asset]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Asset))
result
    [Asset]
result'' <- (Ptr Asset -> IO Asset) -> [Ptr Asset] -> IO [Asset]
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 Asset -> Asset) -> Ptr Asset -> IO Asset
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Asset -> Asset
GES.Asset.Asset) [Ptr Asset]
result'
    Ptr (GList (Ptr Asset)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Asset))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
project
    [Asset] -> IO [Asset]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Asset]
result''

#if defined(ENABLE_OVERLOADING)
data ProjectGetLoadingAssetsMethodInfo
instance (signature ~ (m [GES.Asset.Asset]), MonadIO m, IsProject a) => O.OverloadedMethod ProjectGetLoadingAssetsMethodInfo a signature where
    overloadedMethod = projectGetLoadingAssets

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


#endif

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

foreign import ccall "ges_project_get_uri" ges_project_get_uri :: 
    Ptr Project ->                          -- project : TInterface (Name {namespace = "GES", name = "Project"})
    IO CString

-- | Retrieve the uri that is currently set on /@project@/
projectGetUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsProject a) =>
    a
    -- ^ /@project@/: A t'GI.GES.Objects.Project.Project'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a newly allocated string representing uri.
projectGetUri :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProject a) =>
a -> m (Maybe Text)
projectGetUri a
project = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Project
project' <- a -> IO (Ptr Project)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
project
    CString
result <- Ptr Project -> IO CString
ges_project_get_uri Ptr Project
project'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
project
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ProjectGetUriMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsProject a) => O.OverloadedMethod ProjectGetUriMethodInfo a signature where
    overloadedMethod = projectGetUri

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


#endif

-- method Project::list_assets
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "project"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Project" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESProject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Type of assets to list, `GES_TYPE_EXTRACTABLE` will list\nall assets"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "GES" , name = "Asset" }))
-- throws : False
-- Skip return : False

foreign import ccall "ges_project_list_assets" ges_project_list_assets :: 
    Ptr Project ->                          -- project : TInterface (Name {namespace = "GES", name = "Project"})
    CGType ->                               -- filter : TBasicType TGType
    IO (Ptr (GList (Ptr GES.Asset.Asset)))

-- | List all /@asset@/ contained in /@project@/ filtering per extractable_type
-- as defined by /@filter@/. It copies the asset and thus will not be updated
-- in time.
projectListAssets ::
    (B.CallStack.HasCallStack, MonadIO m, IsProject a) =>
    a
    -- ^ /@project@/: A t'GI.GES.Objects.Project.Project'
    -> GType
    -- ^ /@filter@/: Type of assets to list, @GES_TYPE_EXTRACTABLE@ will list
    -- all assets
    -> m [GES.Asset.Asset]
    -- ^ __Returns:__ The list of
    -- t'GI.GES.Objects.Asset.Asset' the object contains
projectListAssets :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProject a) =>
a -> GType -> m [Asset]
projectListAssets a
project GType
filter = IO [Asset] -> m [Asset]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Asset] -> m [Asset]) -> IO [Asset] -> m [Asset]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Project
project' <- a -> IO (Ptr Project)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
project
    let filter' :: CGType
filter' = GType -> CGType
gtypeToCGType GType
filter
    Ptr (GList (Ptr Asset))
result <- Ptr Project -> CGType -> IO (Ptr (GList (Ptr Asset)))
ges_project_list_assets Ptr Project
project' CGType
filter'
    [Ptr Asset]
result' <- Ptr (GList (Ptr Asset)) -> IO [Ptr Asset]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Asset))
result
    [Asset]
result'' <- (Ptr Asset -> IO Asset) -> [Ptr Asset] -> IO [Asset]
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 Asset -> Asset) -> Ptr Asset -> IO Asset
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Asset -> Asset
GES.Asset.Asset) [Ptr Asset]
result'
    Ptr (GList (Ptr Asset)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Asset))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
project
    [Asset] -> IO [Asset]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Asset]
result''

#if defined(ENABLE_OVERLOADING)
data ProjectListAssetsMethodInfo
instance (signature ~ (GType -> m [GES.Asset.Asset]), MonadIO m, IsProject a) => O.OverloadedMethod ProjectListAssetsMethodInfo a signature where
    overloadedMethod = projectListAssets

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


#endif

-- method Project::list_encoding_profiles
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "project"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Project" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESProject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface
--                     Name { namespace = "GstPbutils" , name = "EncodingProfile" }))
-- throws : False
-- Skip return : False

foreign import ccall "ges_project_list_encoding_profiles" ges_project_list_encoding_profiles :: 
    Ptr Project ->                          -- project : TInterface (Name {namespace = "GES", name = "Project"})
    IO (Ptr (GList (Ptr GstPbutils.EncodingProfile.EncodingProfile)))

-- | Lists the encoding profile that have been set to /@project@/. The first one
-- is the latest added.
projectListEncodingProfiles ::
    (B.CallStack.HasCallStack, MonadIO m, IsProject a) =>
    a
    -- ^ /@project@/: A t'GI.GES.Objects.Project.Project'
    -> m [GstPbutils.EncodingProfile.EncodingProfile]
    -- ^ __Returns:__ The
    -- list of t'GI.GstPbutils.Objects.EncodingProfile.EncodingProfile' used in /@project@/
projectListEncodingProfiles :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProject a) =>
a -> m [EncodingProfile]
projectListEncodingProfiles a
project = IO [EncodingProfile] -> m [EncodingProfile]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [EncodingProfile] -> m [EncodingProfile])
-> IO [EncodingProfile] -> m [EncodingProfile]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Project
project' <- a -> IO (Ptr Project)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
project
    Ptr (GList (Ptr EncodingProfile))
result <- Ptr Project -> IO (Ptr (GList (Ptr EncodingProfile)))
ges_project_list_encoding_profiles Ptr Project
project'
    [Ptr EncodingProfile]
result' <- Ptr (GList (Ptr EncodingProfile)) -> IO [Ptr EncodingProfile]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr EncodingProfile))
result
    [EncodingProfile]
result'' <- (Ptr EncodingProfile -> IO EncodingProfile)
-> [Ptr EncodingProfile] -> IO [EncodingProfile]
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 EncodingProfile -> EncodingProfile)
-> Ptr EncodingProfile -> IO EncodingProfile
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr EncodingProfile -> EncodingProfile
GstPbutils.EncodingProfile.EncodingProfile) [Ptr EncodingProfile]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
project
    [EncodingProfile] -> IO [EncodingProfile]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [EncodingProfile]
result''

#if defined(ENABLE_OVERLOADING)
data ProjectListEncodingProfilesMethodInfo
instance (signature ~ (m [GstPbutils.EncodingProfile.EncodingProfile]), MonadIO m, IsProject a) => O.OverloadedMethod ProjectListEncodingProfilesMethodInfo a signature where
    overloadedMethod = projectListEncodingProfiles

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


#endif

-- method Project::load
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "project"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Project" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESProject that has an @uri set already"
--                 , 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 = Just "A blank timeline to load @project into"
--                 , 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_project_load" ges_project_load :: 
    Ptr Project ->                          -- project : TInterface (Name {namespace = "GES", name = "Project"})
    Ptr GES.Timeline.Timeline ->            -- timeline : TInterface (Name {namespace = "GES", name = "Timeline"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Loads /@project@/ into /@timeline@/
projectLoad ::
    (B.CallStack.HasCallStack, MonadIO m, IsProject a, GES.Timeline.IsTimeline b) =>
    a
    -- ^ /@project@/: A t'GI.GES.Objects.Project.Project' that has an /@uri@/ set already
    -> b
    -- ^ /@timeline@/: A blank timeline to load /@project@/ into
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
projectLoad :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsProject a, IsTimeline b) =>
a -> b -> m ()
projectLoad a
project 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 Project
project' <- a -> IO (Ptr Project)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
project
    Ptr Timeline
timeline' <- b -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
timeline
    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 Project -> Ptr Timeline -> Ptr (Ptr GError) -> IO CInt
ges_project_load Ptr Project
project' Ptr Timeline
timeline'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
project
        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 ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

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

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


#endif

-- method Project::remove_asset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "project"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Project" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESProject" , 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 "A #GESAsset to remove from @project"
--                 , 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_project_remove_asset" ges_project_remove_asset :: 
    Ptr Project ->                          -- project : TInterface (Name {namespace = "GES", name = "Project"})
    Ptr GES.Asset.Asset ->                  -- asset : TInterface (Name {namespace = "GES", name = "Asset"})
    IO CInt

-- | remove a /@asset@/ to from /@project@/.
projectRemoveAsset ::
    (B.CallStack.HasCallStack, MonadIO m, IsProject a, GES.Asset.IsAsset b) =>
    a
    -- ^ /@project@/: A t'GI.GES.Objects.Project.Project'
    -> b
    -- ^ /@asset@/: A t'GI.GES.Objects.Asset.Asset' to remove from /@project@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the asset could be removed 'P.False' otherwise
projectRemoveAsset :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsProject a, IsAsset b) =>
a -> b -> m Bool
projectRemoveAsset a
project b
asset = 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 Project
project' <- a -> IO (Ptr Project)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
project
    Ptr Asset
asset' <- b -> IO (Ptr Asset)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
asset
    CInt
result <- Ptr Project -> Ptr Asset -> IO CInt
ges_project_remove_asset Ptr Project
project' Ptr Asset
asset'
    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
project
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
asset
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ProjectRemoveAssetMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsProject a, GES.Asset.IsAsset b) => O.OverloadedMethod ProjectRemoveAssetMethodInfo a signature where
    overloadedMethod = projectRemoveAsset

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


#endif

-- method Project::save
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "project"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Project" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESProject to save"
--                 , 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 =
--                     Just
--                       "The #GESTimeline to save, it must have been extracted from @project"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The uri where to save @project and @timeline"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "formatter_asset"
--           , argType = TInterface Name { namespace = "GES" , name = "Asset" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The formatter asset to\nuse or %NULL. If %NULL, will try to save in the same format as the one\nfrom which the timeline as been loaded or default to the best formatter\nas defined in #ges_find_formatter_for_uri"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "overwrite"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to overwrite file if it exists"
--                 , 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_project_save" ges_project_save :: 
    Ptr Project ->                          -- project : TInterface (Name {namespace = "GES", name = "Project"})
    Ptr GES.Timeline.Timeline ->            -- timeline : TInterface (Name {namespace = "GES", name = "Timeline"})
    CString ->                              -- uri : TBasicType TUTF8
    Ptr GES.Asset.Asset ->                  -- formatter_asset : TInterface (Name {namespace = "GES", name = "Asset"})
    CInt ->                                 -- overwrite : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Save the timeline of /@project@/ to /@uri@/. You should make sure that /@timeline@/
-- is one of the timelines that have been extracted from /@project@/
-- (using ges_asset_extract (/@project@/);)
projectSave ::
    (B.CallStack.HasCallStack, MonadIO m, IsProject a, GES.Timeline.IsTimeline b, GES.Asset.IsAsset c) =>
    a
    -- ^ /@project@/: A t'GI.GES.Objects.Project.Project' to save
    -> b
    -- ^ /@timeline@/: The t'GI.GES.Objects.Timeline.Timeline' to save, it must have been extracted from /@project@/
    -> T.Text
    -- ^ /@uri@/: The uri where to save /@project@/ and /@timeline@/
    -> Maybe (c)
    -- ^ /@formatterAsset@/: The formatter asset to
    -- use or 'P.Nothing'. If 'P.Nothing', will try to save in the same format as the one
    -- from which the timeline as been loaded or default to the best formatter
    -- as defined in @/ges_find_formatter_for_uri/@
    -> Bool
    -- ^ /@overwrite@/: 'P.True' to overwrite file if it exists
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
projectSave :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsProject a, IsTimeline b, IsAsset c) =>
a -> b -> Text -> Maybe c -> Bool -> m ()
projectSave a
project b
timeline Text
uri Maybe c
formatterAsset Bool
overwrite = 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 Project
project' <- a -> IO (Ptr Project)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
project
    Ptr Timeline
timeline' <- b -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
timeline
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    Ptr Asset
maybeFormatterAsset <- case Maybe c
formatterAsset of
        Maybe c
Nothing -> Ptr Asset -> IO (Ptr Asset)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Asset
forall a. Ptr a
nullPtr
        Just c
jFormatterAsset -> do
            Ptr Asset
jFormatterAsset' <- c -> IO (Ptr Asset)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject c
jFormatterAsset
            Ptr Asset -> IO (Ptr Asset)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Asset
jFormatterAsset'
    let overwrite' :: CInt
overwrite' = (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
overwrite
    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 Project
-> Ptr Timeline
-> CString
-> Ptr Asset
-> CInt
-> Ptr (Ptr GError)
-> IO CInt
ges_project_save Ptr Project
project' Ptr Timeline
timeline' CString
uri' Ptr Asset
maybeFormatterAsset CInt
overwrite'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
project
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
timeline
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
formatterAsset c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
     )

#if defined(ENABLE_OVERLOADING)
data ProjectSaveMethodInfo
instance (signature ~ (b -> T.Text -> Maybe (c) -> Bool -> m ()), MonadIO m, IsProject a, GES.Timeline.IsTimeline b, GES.Asset.IsAsset c) => O.OverloadedMethod ProjectSaveMethodInfo a signature where
    overloadedMethod = projectSave

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


#endif