{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.GES.Objects.Asset.Asset' in the GStreamer Editing Services represents a resources
-- that can be used. In particular, any class that implements the
-- t'GI.GES.Interfaces.Extractable.Extractable' interface may have some associated assets with a
-- corresponding [Asset:extractableType]("GI.GES.Objects.Asset#g:attr:extractableType"), from which its objects can be
-- extracted using 'GI.GES.Objects.Asset.assetExtract'. Some examples would be
-- t'GI.GES.Objects.Clip.Clip', t'GI.GES.Objects.Formatter.Formatter' and t'GI.GES.Objects.TrackElement.TrackElement'.
-- 
-- All assets that are created within GES are stored in a cache; one per
-- each [Asset:id]("GI.GES.Objects.Asset#g:attr:id") and [Asset:extractableType]("GI.GES.Objects.Asset#g:attr:extractableType") pair. These assets can
-- be fetched, and initialized if they do not yet exist in the cache,
-- using 'GI.GES.Objects.Asset.assetRequest'.
-- 
-- 
-- === /c code/
-- >GESAsset *effect_asset;
-- >GESEffect *effect;
-- >
-- >// You create an asset for an effect
-- >effect_asset = ges_asset_request (GES_TYPE_EFFECT, "agingtv", NULL);
-- >
-- >// And now you can extract an instance of GESEffect from that asset
-- >effect = GES_EFFECT (ges_asset_extract (effect_asset));
-- 
-- 
-- The advantage of using assets, rather than simply creating the object
-- directly, is that the currently loaded resources can be listed with
-- 'GI.GES.Functions.listAssets' and displayed to an end user. For example, to show
-- which media files have been loaded, and a standard list of effects. In
-- fact, the GES library already creates assets for t'GI.GES.Objects.TransitionClip.TransitionClip' and
-- t'GI.GES.Objects.Formatter.Formatter', which you can use to list all the available transition
-- types and supported formats.
-- 
-- The other advantage is that t'GI.GES.Objects.Asset.Asset' implements t'GI.GES.Interfaces.MetaContainer.MetaContainer', so
-- metadata can be set on the asset, with some subclasses automatically
-- creating this metadata on initiation.
-- 
-- For example, to display information about the supported formats, you
-- could do the following:
-- >
-- >   GList *formatter_assets, *tmp;
-- >
-- >   //  List all  the transitions
-- >   formatter_assets = ges_list_assets (GES_TYPE_FORMATTER);
-- >
-- >   // Print some infos about the formatter GESAsset
-- >   for (tmp = formatter_assets; tmp; tmp = tmp->next) {
-- >     gst_print ("Name of the formatter: %s, file extension it produces: %s",
-- >       ges_meta_container_get_string (
-- >         GES_META_CONTAINER (tmp->data), GES_META_FORMATTER_NAME),
-- >       ges_meta_container_get_string (
-- >         GES_META_CONTAINER (tmp->data), GES_META_FORMATTER_EXTENSION));
-- >   }
-- >
-- >   g_list_free (transition_assets);
-- >
-- 
-- 
-- == ID
-- 
-- Each asset is uniquely defined in the cache by its
-- [Asset:extractableType]("GI.GES.Objects.Asset#g:attr:extractableType") and [Asset:id]("GI.GES.Objects.Asset#g:attr:id"). Depending on the
-- [Asset:extractableType]("GI.GES.Objects.Asset#g:attr:extractableType"), the [Asset:id]("GI.GES.Objects.Asset#g:attr:id") can be used to parametrise
-- the creation of the object upon extraction. By default, a class that
-- implements t'GI.GES.Interfaces.Extractable.Extractable' will only have a single associated asset,
-- with an [Asset:id]("GI.GES.Objects.Asset#g:attr:id") set to the type name of its objects. However, this
-- is overwritten by some implementations, which allow a class to have
-- multiple associated assets. For example, for t'GI.GES.Objects.TransitionClip.TransitionClip' the
-- [Asset:id]("GI.GES.Objects.Asset#g:attr:id") will be a nickname of the [TransitionClip:vtype]("GI.GES.Objects.TransitionClip#g:attr:vtype"). You
-- should check the documentation for each extractable type to see if they
-- differ from the default.
-- 
-- Moreover, each [Asset:extractableType]("GI.GES.Objects.Asset#g:attr:extractableType") may also associate itself
-- with a specific asset subclass. In such cases, when their asset is
-- requested, an asset of this subclass will be returned instead.
-- 
-- == Managing
-- 
-- You can use a t'GI.GES.Objects.Project.Project' to easily manage the assets of a
-- t'GI.GES.Objects.Timeline.Timeline'.
-- 
-- == Proxies
-- 
-- Some assets can (temporarily) act as the [Asset:proxy]("GI.GES.Objects.Asset#g:attr:proxy") of another
-- asset. When the original asset is requested from the cache, the proxy
-- will be returned in its place. This can be useful if, say, you want
-- to substitute a t'GI.GES.Objects.UriClipAsset.UriClipAsset' corresponding to a high resolution
-- media file with the asset of a lower resolution stand in.
-- 
-- An asset may even have several proxies, the first of which will act as
-- its default and be returned on requests, but the others will be ordered
-- to take its place once it is removed. You can add a proxy to an asset,
-- or set its default, using 'GI.GES.Objects.Asset.assetSetProxy', and you can remove
-- them with 'GI.GES.Objects.Asset.assetUnproxy'.

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

module GI.GES.Objects.Asset
    ( 

-- * Exported types
    Asset(..)                               ,
    IsAsset                                 ,
    toAsset                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addMetasFromString]("GI.GES.Interfaces.MetaContainer#g:method:addMetasFromString"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [checkMetaRegistered]("GI.GES.Interfaces.MetaContainer#g:method:checkMetaRegistered"), [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"), [listProxies]("GI.GES.Objects.Asset#g:method:listProxies"), [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"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [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
-- [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"), [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").
-- 
-- ==== 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)
    ResolveAssetMethod                      ,
#endif

-- ** extract #method:extract#

#if defined(ENABLE_OVERLOADING)
    AssetExtractMethodInfo                  ,
#endif
    assetExtract                            ,


-- ** getError #method:getError#

#if defined(ENABLE_OVERLOADING)
    AssetGetErrorMethodInfo                 ,
#endif
    assetGetError                           ,


-- ** getExtractableType #method:getExtractableType#

#if defined(ENABLE_OVERLOADING)
    AssetGetExtractableTypeMethodInfo       ,
#endif
    assetGetExtractableType                 ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    AssetGetIdMethodInfo                    ,
#endif
    assetGetId                              ,


-- ** getProxy #method:getProxy#

#if defined(ENABLE_OVERLOADING)
    AssetGetProxyMethodInfo                 ,
#endif
    assetGetProxy                           ,


-- ** getProxyTarget #method:getProxyTarget#

#if defined(ENABLE_OVERLOADING)
    AssetGetProxyTargetMethodInfo           ,
#endif
    assetGetProxyTarget                     ,


-- ** listProxies #method:listProxies#

#if defined(ENABLE_OVERLOADING)
    AssetListProxiesMethodInfo              ,
#endif
    assetListProxies                        ,


-- ** needsReload #method:needsReload#

    assetNeedsReload                        ,


-- ** request #method:request#

    assetRequest                            ,


-- ** requestAsync #method:requestAsync#

    assetRequestAsync                       ,


-- ** requestFinish #method:requestFinish#

    assetRequestFinish                      ,


-- ** setProxy #method:setProxy#

#if defined(ENABLE_OVERLOADING)
    AssetSetProxyMethodInfo                 ,
#endif
    assetSetProxy                           ,


-- ** unproxy #method:unproxy#

#if defined(ENABLE_OVERLOADING)
    AssetUnproxyMethodInfo                  ,
#endif
    assetUnproxy                            ,




 -- * Properties


-- ** extractableType #attr:extractableType#
-- | The t'GI.GES.Interfaces.Extractable.Extractable' object type that can be extracted from the asset.

#if defined(ENABLE_OVERLOADING)
    AssetExtractableTypePropertyInfo        ,
#endif
#if defined(ENABLE_OVERLOADING)
    assetExtractableType                    ,
#endif
    constructAssetExtractableType           ,
    getAssetExtractableType                 ,


-- ** id #attr:id#
-- | The ID of the asset. This should be unique amongst all assets with
-- the same [Asset:extractableType]("GI.GES.Objects.Asset#g:attr:extractableType"). Depending on the associated
-- t'GI.GES.Interfaces.Extractable.Extractable' implementation, this id may convey some information
-- about the t'GI.GObject.Objects.Object.Object' that should be extracted. Note that, as such, the
-- ID will have an expected format, and you can not choose this value
-- arbitrarily. By default, this will be set to the type name of the
-- [Asset:extractableType]("GI.GES.Objects.Asset#g:attr:extractableType"), but you should check the documentation
-- of the extractable type to see whether they differ from the
-- default behaviour.

#if defined(ENABLE_OVERLOADING)
    AssetIdPropertyInfo                     ,
#endif
#if defined(ENABLE_OVERLOADING)
    assetId                                 ,
#endif
    constructAssetId                        ,
    getAssetId                              ,


-- ** proxy #attr:proxy#
-- | The default proxy for this asset, or 'P.Nothing' if it has no proxy. A
-- proxy will act as a substitute for the original asset when the
-- original is requested (see 'GI.GES.Objects.Asset.assetRequest').
-- 
-- Setting this property will not usually remove the existing proxy, but
-- will replace it as the default (see 'GI.GES.Objects.Asset.assetSetProxy').

#if defined(ENABLE_OVERLOADING)
    AssetProxyPropertyInfo                  ,
#endif
#if defined(ENABLE_OVERLOADING)
    assetProxy                              ,
#endif
    clearAssetProxy                         ,
    constructAssetProxy                     ,
    getAssetProxy                           ,
    setAssetProxy                           ,


-- ** proxyTarget #attr:proxyTarget#
-- | The asset that this asset is a proxy for, or 'P.Nothing' if it is not a
-- proxy for another asset.
-- 
-- Note that even if this asset is acting as a proxy for another asset,
-- but this asset is not the default [Asset:proxy]("GI.GES.Objects.Asset#g:attr:proxy"), then /@proxy@/-target
-- will *still* point to this other asset. So you should check the
-- [Asset:proxy]("GI.GES.Objects.Asset#g:attr:proxy") property of /@target@/-proxy before assuming it is the
-- current default proxy for the target.
-- 
-- Note that the [Object::notify]("GI.GObject.Objects.Object#g:signal:notify") for this property is emitted after
-- the [Asset:proxy]("GI.GES.Objects.Asset#g:attr:proxy") [Object::notify]("GI.GObject.Objects.Object#g:signal:notify") for the corresponding (if any)
-- asset it is now the proxy of\/no longer the proxy of.

#if defined(ENABLE_OVERLOADING)
    AssetProxyTargetPropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    assetProxyTarget                        ,
#endif
    getAssetProxyTarget                     ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.GES.Interfaces.Extractable as GES.Extractable
import {-# SOURCE #-} qualified GI.GES.Interfaces.MetaContainer as GES.MetaContainer
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncInitable as Gio.AsyncInitable
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable

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

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

foreign import ccall "ges_asset_get_type"
    c_ges_asset_get_type :: IO B.Types.GType

instance B.Types.TypedObject Asset where
    glibType :: IO GType
glibType = IO GType
c_ges_asset_get_type

instance B.Types.GObject Asset

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

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

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

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

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

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

#endif

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

#endif

-- VVV Prop "extractable-type"
   -- Type: TBasicType TGType
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

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

#if defined(ENABLE_OVERLOADING)
data AssetExtractableTypePropertyInfo
instance AttrInfo AssetExtractableTypePropertyInfo where
    type AttrAllowedOps AssetExtractableTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AssetExtractableTypePropertyInfo = IsAsset
    type AttrSetTypeConstraint AssetExtractableTypePropertyInfo = (~) GType
    type AttrTransferTypeConstraint AssetExtractableTypePropertyInfo = (~) GType
    type AttrTransferType AssetExtractableTypePropertyInfo = GType
    type AttrGetType AssetExtractableTypePropertyInfo = GType
    type AttrLabel AssetExtractableTypePropertyInfo = "extractable-type"
    type AttrOrigin AssetExtractableTypePropertyInfo = Asset
    attrGet = getAssetExtractableType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructAssetExtractableType
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Asset.extractableType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Asset.html#g:attr:extractableType"
        })
#endif

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

-- | Get the value of the “@id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' asset #id
-- @
getAssetId :: (MonadIO m, IsAsset o) => o -> m T.Text
getAssetId :: forall (m :: * -> *) o. (MonadIO m, IsAsset o) => o -> m Text
getAssetId o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getAssetId" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO 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
"id"

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

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

-- VVV Prop "proxy"
   -- Type: TInterface (Name {namespace = "GES", name = "Asset"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Nothing)

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

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

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

-- | Set the value of the “@proxy@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #proxy
-- @
clearAssetProxy :: (MonadIO m, IsAsset o) => o -> m ()
clearAssetProxy :: forall (m :: * -> *) o. (MonadIO m, IsAsset o) => o -> m ()
clearAssetProxy o
obj = 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
$ o -> String -> Maybe Asset -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"proxy" (Maybe Asset
forall a. Maybe a
Nothing :: Maybe Asset)

#if defined(ENABLE_OVERLOADING)
data AssetProxyPropertyInfo
instance AttrInfo AssetProxyPropertyInfo where
    type AttrAllowedOps AssetProxyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint AssetProxyPropertyInfo = IsAsset
    type AttrSetTypeConstraint AssetProxyPropertyInfo = IsAsset
    type AttrTransferTypeConstraint AssetProxyPropertyInfo = IsAsset
    type AttrTransferType AssetProxyPropertyInfo = Asset
    type AttrGetType AssetProxyPropertyInfo = (Maybe Asset)
    type AttrLabel AssetProxyPropertyInfo = "proxy"
    type AttrOrigin AssetProxyPropertyInfo = Asset
    attrGet = getAssetProxy
    attrSet = setAssetProxy
    attrTransfer _ v = do
        unsafeCastTo Asset v
    attrConstruct = constructAssetProxy
    attrClear = clearAssetProxy
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Asset.proxy"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Asset.html#g:attr:proxy"
        })
#endif

-- VVV Prop "proxy-target"
   -- Type: TInterface (Name {namespace = "GES", name = "Asset"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@proxy-target@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' asset #proxyTarget
-- @
getAssetProxyTarget :: (MonadIO m, IsAsset o) => o -> m (Maybe Asset)
getAssetProxyTarget :: forall (m :: * -> *) o.
(MonadIO m, IsAsset o) =>
o -> m (Maybe Asset)
getAssetProxyTarget o
obj = IO (Maybe Asset) -> m (Maybe Asset)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Asset) -> m (Maybe Asset))
-> IO (Maybe Asset) -> m (Maybe Asset)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Asset -> Asset) -> IO (Maybe Asset)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"proxy-target" ManagedPtr Asset -> Asset
Asset

#if defined(ENABLE_OVERLOADING)
data AssetProxyTargetPropertyInfo
instance AttrInfo AssetProxyTargetPropertyInfo where
    type AttrAllowedOps AssetProxyTargetPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint AssetProxyTargetPropertyInfo = IsAsset
    type AttrSetTypeConstraint AssetProxyTargetPropertyInfo = (~) ()
    type AttrTransferTypeConstraint AssetProxyTargetPropertyInfo = (~) ()
    type AttrTransferType AssetProxyTargetPropertyInfo = ()
    type AttrGetType AssetProxyTargetPropertyInfo = (Maybe Asset)
    type AttrLabel AssetProxyTargetPropertyInfo = "proxy-target"
    type AttrOrigin AssetProxyTargetPropertyInfo = Asset
    attrGet = getAssetProxyTarget
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.Asset.proxyTarget"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-Asset.html#g:attr:proxyTarget"
        })
#endif

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

#if defined(ENABLE_OVERLOADING)
assetExtractableType :: AttrLabelProxy "extractableType"
assetExtractableType = AttrLabelProxy

assetId :: AttrLabelProxy "id"
assetId = AttrLabelProxy

assetProxy :: AttrLabelProxy "proxy"
assetProxy = AttrLabelProxy

assetProxyTarget :: AttrLabelProxy "proxyTarget"
assetProxyTarget = AttrLabelProxy

#endif

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

#endif

-- method Asset::extract
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "GES" , name = "Asset" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESAsset to extract an object from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GES" , name = "Extractable" })
-- throws : True
-- Skip return : False

foreign import ccall "ges_asset_extract" ges_asset_extract :: 
    Ptr Asset ->                            -- self : TInterface (Name {namespace = "GES", name = "Asset"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GES.Extractable.Extractable)

-- | Extracts a new [Asset:extractableType]("GI.GES.Objects.Asset#g:attr:extractableType") object from the asset. The
-- [Asset:id]("GI.GES.Objects.Asset#g:attr:id") of the asset may determine the properties and state of the
-- newly created object.
assetExtract ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsset a) =>
    a
    -- ^ /@self@/: The t'GI.GES.Objects.Asset.Asset' to extract an object from
    -> m GES.Extractable.Extractable
    -- ^ __Returns:__ A newly created object, or 'P.Nothing' if an
    -- error occurred. /(Can throw 'Data.GI.Base.GError.GError')/
assetExtract :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsset a) =>
a -> m Extractable
assetExtract a
self = IO Extractable -> m Extractable
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Extractable -> m Extractable)
-> IO Extractable -> m Extractable
forall a b. (a -> b) -> a -> b
$ do
    Ptr Asset
self' <- a -> IO (Ptr Asset)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    IO Extractable -> IO () -> IO Extractable
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Extractable
result <- (Ptr (Ptr GError) -> IO (Ptr Extractable)) -> IO (Ptr Extractable)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Extractable))
 -> IO (Ptr Extractable))
-> (Ptr (Ptr GError) -> IO (Ptr Extractable))
-> IO (Ptr Extractable)
forall a b. (a -> b) -> a -> b
$ Ptr Asset -> Ptr (Ptr GError) -> IO (Ptr Extractable)
ges_asset_extract Ptr Asset
self'
        Text -> Ptr Extractable -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"assetExtract" Ptr Extractable
result
        Extractable
result' <- ((ManagedPtr Extractable -> Extractable)
-> Ptr Extractable -> IO Extractable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Extractable -> Extractable
GES.Extractable.Extractable) Ptr Extractable
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Extractable -> IO Extractable
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Extractable
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data AssetExtractMethodInfo
instance (signature ~ (m GES.Extractable.Extractable), MonadIO m, IsAsset a) => O.OverloadedMethod AssetExtractMethodInfo a signature where
    overloadedMethod = assetExtract

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


#endif

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

foreign import ccall "ges_asset_get_error" ges_asset_get_error :: 
    Ptr Asset ->                            -- self : TInterface (Name {namespace = "GES", name = "Asset"})
    IO (Ptr GError)

-- | Retrieve the error that was set on the asset when it was loaded.
-- 
-- /Since: 1.8/
assetGetError ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsset a) =>
    a
    -- ^ /@self@/: A t'GI.GES.Objects.Asset.Asset'
    -> m (Maybe GError)
    -- ^ __Returns:__ The error set on /@asset@/, or
    -- 'P.Nothing' if no error occurred when /@asset@/ was loaded.
assetGetError :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsset a) =>
a -> m (Maybe GError)
assetGetError a
self = IO (Maybe GError) -> m (Maybe GError)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GError) -> m (Maybe GError))
-> IO (Maybe GError) -> m (Maybe GError)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Asset
self' <- a -> IO (Ptr Asset)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr GError
result <- Ptr Asset -> IO (Ptr GError)
ges_asset_get_error Ptr Asset
self'
    Maybe GError
maybeResult <- Ptr GError -> (Ptr GError -> IO GError) -> IO (Maybe GError)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GError
result ((Ptr GError -> IO GError) -> IO (Maybe GError))
-> (Ptr GError -> IO GError) -> IO (Maybe GError)
forall a b. (a -> b) -> a -> b
$ \Ptr GError
result' -> do
        GError
result'' <- ((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
result'
        GError -> IO GError
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GError
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe GError -> IO (Maybe GError)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GError
maybeResult

#if defined(ENABLE_OVERLOADING)
data AssetGetErrorMethodInfo
instance (signature ~ (m (Maybe GError)), MonadIO m, IsAsset a) => O.OverloadedMethod AssetGetErrorMethodInfo a signature where
    overloadedMethod = assetGetError

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


#endif

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

foreign import ccall "ges_asset_get_extractable_type" ges_asset_get_extractable_type :: 
    Ptr Asset ->                            -- self : TInterface (Name {namespace = "GES", name = "Asset"})
    IO CGType

-- | Gets the [Asset:extractableType]("GI.GES.Objects.Asset#g:attr:extractableType") of the asset.
assetGetExtractableType ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsset a) =>
    a
    -- ^ /@self@/: The t'GI.GES.Objects.Asset.Asset'
    -> m GType
    -- ^ __Returns:__ The extractable type of /@self@/.
assetGetExtractableType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsset a) =>
a -> m GType
assetGetExtractableType a
self = IO GType -> m GType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Asset
self' <- a -> IO (Ptr Asset)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CGType
result <- Ptr Asset -> IO CGType
ges_asset_get_extractable_type Ptr Asset
self'
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    GType -> IO GType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
data AssetGetExtractableTypeMethodInfo
instance (signature ~ (m GType), MonadIO m, IsAsset a) => O.OverloadedMethod AssetGetExtractableTypeMethodInfo a signature where
    overloadedMethod = assetGetExtractableType

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


#endif

-- method Asset::get_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "GES" , name = "Asset" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESAsset" , 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_asset_get_id" ges_asset_get_id :: 
    Ptr Asset ->                            -- self : TInterface (Name {namespace = "GES", name = "Asset"})
    IO CString

-- | Gets the [Asset:id]("GI.GES.Objects.Asset#g:attr:id") of the asset.
assetGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsset a) =>
    a
    -- ^ /@self@/: A t'GI.GES.Objects.Asset.Asset'
    -> m T.Text
    -- ^ __Returns:__ The ID of /@self@/.
assetGetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsset a) =>
a -> m Text
assetGetId a
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Asset
self' <- a -> IO (Ptr Asset)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Asset -> IO CString
ges_asset_get_id Ptr Asset
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"assetGetId" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AssetGetIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAsset a) => O.OverloadedMethod AssetGetIdMethodInfo a signature where
    overloadedMethod = assetGetId

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


#endif

-- method Asset::get_proxy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "asset"
--           , argType = TInterface Name { namespace = "GES" , name = "Asset" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESAsset" , 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_asset_get_proxy" ges_asset_get_proxy :: 
    Ptr Asset ->                            -- asset : TInterface (Name {namespace = "GES", name = "Asset"})
    IO (Ptr Asset)

-- | Gets the default [Asset:proxy]("GI.GES.Objects.Asset#g:attr:proxy") of the asset.
assetGetProxy ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsset a) =>
    a
    -- ^ /@asset@/: A t'GI.GES.Objects.Asset.Asset'
    -> m (Maybe Asset)
    -- ^ __Returns:__ The default proxy of /@asset@/.
assetGetProxy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsset a) =>
a -> m (Maybe Asset)
assetGetProxy a
asset = 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 Asset
asset' <- a -> IO (Ptr Asset)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
asset
    Ptr Asset
result <- Ptr Asset -> IO (Ptr Asset)
ges_asset_get_proxy Ptr Asset
asset'
    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
newObject ManagedPtr Asset -> 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
asset
    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 AssetGetProxyMethodInfo
instance (signature ~ (m (Maybe Asset)), MonadIO m, IsAsset a) => O.OverloadedMethod AssetGetProxyMethodInfo a signature where
    overloadedMethod = assetGetProxy

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


#endif

-- method Asset::get_proxy_target
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "proxy"
--           , argType = TInterface Name { namespace = "GES" , name = "Asset" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESAsset" , 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_asset_get_proxy_target" ges_asset_get_proxy_target :: 
    Ptr Asset ->                            -- proxy : TInterface (Name {namespace = "GES", name = "Asset"})
    IO (Ptr Asset)

-- | Gets the [Asset:proxyTarget]("GI.GES.Objects.Asset#g:attr:proxyTarget") of the asset.
-- 
-- Note that the proxy target may have loaded with an error, so you should
-- call 'GI.GES.Objects.Asset.assetGetError' on the returned target.
assetGetProxyTarget ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsset a) =>
    a
    -- ^ /@proxy@/: A t'GI.GES.Objects.Asset.Asset'
    -> m (Maybe Asset)
    -- ^ __Returns:__ The asset that /@proxy@/ is a proxy
    -- of.
assetGetProxyTarget :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsset a) =>
a -> m (Maybe Asset)
assetGetProxyTarget a
proxy = 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 Asset
proxy' <- a -> IO (Ptr Asset)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
proxy
    Ptr Asset
result <- Ptr Asset -> IO (Ptr Asset)
ges_asset_get_proxy_target Ptr Asset
proxy'
    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
newObject ManagedPtr Asset -> 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
proxy
    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 AssetGetProxyTargetMethodInfo
instance (signature ~ (m (Maybe Asset)), MonadIO m, IsAsset a) => O.OverloadedMethod AssetGetProxyTargetMethodInfo a signature where
    overloadedMethod = assetGetProxyTarget

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


#endif

-- method Asset::list_proxies
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "asset"
--           , argType = TInterface Name { namespace = "GES" , name = "Asset" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESAsset" , 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_asset_list_proxies" ges_asset_list_proxies :: 
    Ptr Asset ->                            -- asset : TInterface (Name {namespace = "GES", name = "Asset"})
    IO (Ptr (GList (Ptr Asset)))

-- | Get all the proxies that the asset has. The first item of the list will
-- be the default [Asset:proxy]("GI.GES.Objects.Asset#g:attr:proxy"). The second will be the proxy that is
-- \'next in line\' to be default, and so on.
assetListProxies ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsset a) =>
    a
    -- ^ /@asset@/: A t'GI.GES.Objects.Asset.Asset'
    -> m [Asset]
    -- ^ __Returns:__ The list of proxies
    -- that /@asset@/ has.
assetListProxies :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsset a) =>
a -> m [Asset]
assetListProxies a
asset = 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 Asset
asset' <- a -> IO (Ptr Asset)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
asset
    Ptr (GList (Ptr Asset))
result <- Ptr Asset -> IO (Ptr (GList (Ptr Asset)))
ges_asset_list_proxies Ptr Asset
asset'
    [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
newObject ManagedPtr Asset -> Asset
Asset) [Ptr Asset]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
asset
    [Asset] -> IO [Asset]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Asset]
result''

#if defined(ENABLE_OVERLOADING)
data AssetListProxiesMethodInfo
instance (signature ~ (m [Asset]), MonadIO m, IsAsset a) => O.OverloadedMethod AssetListProxiesMethodInfo a signature where
    overloadedMethod = assetListProxies

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


#endif

-- method Asset::set_proxy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "asset"
--           , argType = TInterface Name { namespace = "GES" , name = "Asset" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESAsset to proxy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "proxy"
--           , argType = TInterface Name { namespace = "GES" , name = "Asset" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A new default proxy for @asset"
--                 , 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_asset_set_proxy" ges_asset_set_proxy :: 
    Ptr Asset ->                            -- asset : TInterface (Name {namespace = "GES", name = "Asset"})
    Ptr Asset ->                            -- proxy : TInterface (Name {namespace = "GES", name = "Asset"})
    IO CInt

-- | Sets the [Asset:proxy]("GI.GES.Objects.Asset#g:attr:proxy") for the asset.
-- 
-- If /@proxy@/ is among the existing proxies of the asset (see
-- 'GI.GES.Objects.Asset.assetListProxies') it will be moved to become the default
-- proxy. Otherwise, if /@proxy@/ is not 'P.Nothing', it will be added to the list
-- of proxies, as the new default. The previous default proxy will become
-- \'next in line\' for if the new one is removed, and so on. As such, this
-- will **not** actually remove the previous default proxy (use
-- 'GI.GES.Objects.Asset.assetUnproxy' for that).
-- 
-- Note that an asset can only act as a proxy for one other asset.
-- 
-- As a special case, if /@proxy@/ is 'P.Nothing', then this method will actually
-- remove **all** proxies from the asset.
assetSetProxy ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsset a, IsAsset b) =>
    a
    -- ^ /@asset@/: The t'GI.GES.Objects.Asset.Asset' to proxy
    -> Maybe (b)
    -- ^ /@proxy@/: A new default proxy for /@asset@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@proxy@/ was successfully set as the default for
    -- /@asset@/.
assetSetProxy :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAsset a, IsAsset b) =>
a -> Maybe b -> m Bool
assetSetProxy a
asset Maybe b
proxy = 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 Asset
asset' <- a -> IO (Ptr Asset)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
asset
    Ptr Asset
maybeProxy <- case Maybe b
proxy of
        Maybe b
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 b
jProxy -> do
            Ptr Asset
jProxy' <- b -> IO (Ptr Asset)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jProxy
            Ptr Asset -> IO (Ptr Asset)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Asset
jProxy'
    CInt
result <- Ptr Asset -> Ptr Asset -> IO CInt
ges_asset_set_proxy Ptr Asset
asset' Ptr Asset
maybeProxy
    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
asset
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
proxy b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AssetSetProxyMethodInfo
instance (signature ~ (Maybe (b) -> m Bool), MonadIO m, IsAsset a, IsAsset b) => O.OverloadedMethod AssetSetProxyMethodInfo a signature where
    overloadedMethod = assetSetProxy

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


#endif

-- method Asset::unproxy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "asset"
--           , argType = TInterface Name { namespace = "GES" , name = "Asset" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESAsset to no longer proxy with @proxy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "proxy"
--           , argType = TInterface Name { namespace = "GES" , name = "Asset" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An existing proxy of @asset"
--                 , 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_asset_unproxy" ges_asset_unproxy :: 
    Ptr Asset ->                            -- asset : TInterface (Name {namespace = "GES", name = "Asset"})
    Ptr Asset ->                            -- proxy : TInterface (Name {namespace = "GES", name = "Asset"})
    IO CInt

-- | Removes the proxy from the available list of proxies for the asset. If
-- the given proxy is the default proxy of the list, then the next proxy
-- in the available list (see 'GI.GES.Objects.Asset.assetListProxies') will become the
-- default. If there are no other proxies, then the asset will no longer
-- have a default [Asset:proxy]("GI.GES.Objects.Asset#g:attr:proxy").
assetUnproxy ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsset a, IsAsset b) =>
    a
    -- ^ /@asset@/: The t'GI.GES.Objects.Asset.Asset' to no longer proxy with /@proxy@/
    -> b
    -- ^ /@proxy@/: An existing proxy of /@asset@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@proxy@/ was successfully removed from /@asset@/\'s proxy
    -- list.
assetUnproxy :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAsset a, IsAsset b) =>
a -> b -> m Bool
assetUnproxy a
asset b
proxy = 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 Asset
asset' <- a -> IO (Ptr Asset)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
asset
    Ptr Asset
proxy' <- b -> IO (Ptr Asset)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
proxy
    CInt
result <- Ptr Asset -> Ptr Asset -> IO CInt
ges_asset_unproxy Ptr Asset
asset' Ptr Asset
proxy'
    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
asset
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
proxy
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AssetUnproxyMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsAsset a, IsAsset b) => O.OverloadedMethod AssetUnproxyMethodInfo a signature where
    overloadedMethod = assetUnproxy

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


#endif

-- method Asset::needs_reload
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "extractable_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The #GESAsset:extractable-type of the asset that\nneeds reloading"
--                 , 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 #GESAsset:id of the asset asset that needs\nreloading"
--                 , 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_asset_needs_reload" ges_asset_needs_reload :: 
    CGType ->                               -- extractable_type : TBasicType TGType
    CString ->                              -- id : TBasicType TUTF8
    IO CInt

-- | Indicate that an existing t'GI.GES.Objects.Asset.Asset' in the cache should be reloaded
-- upon the next request. This can be used when some condition has
-- changed, which may require that an existing asset should be updated.
-- For example, if an external resource has changed or now become
-- available.
-- 
-- Note, the asset is not immediately changed, but will only actually
-- reload on the next call to 'GI.GES.Objects.Asset.assetRequest' or
-- 'GI.GES.Objects.Asset.assetRequestAsync'.
assetNeedsReload ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@extractableType@/: The [Asset:extractableType]("GI.GES.Objects.Asset#g:attr:extractableType") of the asset that
    -- needs reloading
    -> Maybe (T.Text)
    -- ^ /@id@/: The [Asset:id]("GI.GES.Objects.Asset#g:attr:id") of the asset asset that needs
    -- reloading
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the specified asset exists in the cache and could be
    -- marked for reloading.
assetNeedsReload :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GType -> Maybe Text -> m Bool
assetNeedsReload GType
extractableType Maybe Text
id = 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
    let extractableType' :: CGType
extractableType' = GType -> CGType
gtypeToCGType GType
extractableType
    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'
    CInt
result <- CGType -> CString -> IO CInt
ges_asset_needs_reload CGType
extractableType' CString
maybeId
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    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)
#endif

-- method Asset::request
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "extractable_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESAsset:extractable-type of the asset"
--                 , 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 #GESAsset:id of the asset"
--                 , 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_asset_request" ges_asset_request :: 
    CGType ->                               -- extractable_type : TBasicType TGType
    CString ->                              -- id : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Asset)

-- | Returns an asset with the given properties. If such an asset already
-- exists in the cache (it has been previously created in GES), then a
-- reference to the existing asset is returned. Otherwise, a newly created
-- asset is returned, and also added to the cache.
-- 
-- If the requested asset has been loaded with an error, then /@error@/ is
-- set, if given, and 'P.Nothing' will be returned instead.
-- 
-- Note that the given /@id@/ may not be exactly the [Asset:id]("GI.GES.Objects.Asset#g:attr:id") that is
-- set on the returned asset. For instance, it may be adjusted into a
-- standard format. Or, if a t'GI.GES.Interfaces.Extractable.Extractable' type does not have its
-- extraction parametrised, as is the case by default, then the given /@id@/
-- may be ignored entirely and the [Asset:id]("GI.GES.Objects.Asset#g:attr:id") set to some standard, in
-- which case a 'P.Nothing' /@id@/ can be given.
-- 
-- Similarly, the given /@extractableType@/ may not be exactly the
-- [Asset:extractableType]("GI.GES.Objects.Asset#g:attr:extractableType") that is set on the returned asset. Instead,
-- the actual extractable type may correspond to a subclass of the given
-- /@extractableType@/, depending on the given /@id@/.
-- 
-- Moreover, depending on the given /@extractableType@/, the returned asset
-- may belong to a subclass of t'GI.GES.Objects.Asset.Asset'.
-- 
-- Finally, if the requested asset has a [Asset:proxy]("GI.GES.Objects.Asset#g:attr:proxy"), then the proxy
-- that is found at the end of the chain of proxies is returned (a proxy\'s
-- proxy will take its place, and so on, unless it has no proxy).
-- 
-- Some asset subclasses only support asynchronous construction of its
-- assets, such as t'GI.GES.Objects.UriClip.UriClip'. For such assets this method will fail, and
-- you should use 'GI.GES.Objects.Asset.assetRequestAsync' instead. In the case of
-- t'GI.GES.Objects.UriClip.UriClip', you can use 'GI.GES.Objects.UriClipAsset.uriClipAssetRequestSync' if you only
-- want to wait for the request to finish.
assetRequest ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@extractableType@/: The [Asset:extractableType]("GI.GES.Objects.Asset#g:attr:extractableType") of the asset
    -> Maybe (T.Text)
    -- ^ /@id@/: The [Asset:id]("GI.GES.Objects.Asset#g:attr:id") of the asset
    -> m (Maybe Asset)
    -- ^ __Returns:__ A reference to the requested
    -- asset, or 'P.Nothing' if an error occurred. /(Can throw 'Data.GI.Base.GError.GError')/
assetRequest :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GType -> Maybe Text -> m (Maybe Asset)
assetRequest GType
extractableType Maybe Text
id = 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
    let extractableType' :: CGType
extractableType' = GType -> CGType
gtypeToCGType GType
extractableType
    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'
    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
$ CGType -> CString -> Ptr (Ptr GError) -> IO (Ptr Asset)
ges_asset_request CGType
extractableType' CString
maybeId
        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
Asset) Ptr Asset
result'
            Asset -> IO Asset
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Asset
result''
        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)
#endif

-- method Asset::request_async
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "extractable_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GESAsset:extractable-type of the asset"
--                 , 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 #GESAsset:id of the asset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "An object to allow cancellation of the\nasset request, or %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A function to call when the initialization is finished"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Data to be passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ges_asset_request_async" ges_asset_request_async :: 
    CGType ->                               -- extractable_type : TBasicType TGType
    CString ->                              -- id : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Requests an asset with the given properties asynchronously (see
-- 'GI.GES.Objects.Asset.assetRequest'). When the asset has been initialized or fetched
-- from the cache, the given callback function will be called. The
-- asset can then be retrieved in the callback using the
-- 'GI.GES.Objects.Asset.assetRequestFinish' method on the given t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
-- 
-- Note that the source object passed to the callback will be the
-- t'GI.GES.Objects.Asset.Asset' corresponding to the request, but it may not have loaded
-- correctly and therefore can not be used as is. Instead,
-- 'GI.GES.Objects.Asset.assetRequestFinish' should be used to fetch a usable asset, or
-- indicate that an error occurred in the asset\'s creation.
-- 
-- Note that the callback will be called in the t'GI.GLib.Structs.MainLoop.MainLoop' running under
-- the same t'GI.GLib.Structs.MainContext.MainContext' that 'GI.GES.Functions.init' was called in. So, if you wish
-- the callback to be invoked outside the default t'GI.GLib.Structs.MainContext.MainContext', you can
-- call 'GI.GLib.Structs.MainContext.mainContextPushThreadDefault' in a new thread before
-- calling 'GI.GES.Functions.init'.
-- 
-- Example of an asynchronous asset request:
-- 
-- === /c code/
-- >// The request callback
-- >static void
-- >asset_loaded_cb (GESAsset * source, GAsyncResult * res, gpointer user_data)
-- >{
-- >  GESAsset *asset;
-- >  GError *error = NULL;
-- >
-- >  asset = ges_asset_request_finish (res, &error);
-- >  if (asset) {
-- >   gst_print ("The file: %s is usable as a GESUriClip",
-- >       ges_asset_get_id (asset));
-- >  } else {
-- >   gst_print ("The file: %s is *not* usable as a GESUriClip because: %s",
-- >       ges_asset_get_id (source), error->message);
-- >  }
-- >
-- >  gst_object_unref (asset);
-- >}
-- >
-- >// The request:
-- >ges_asset_request_async (GES_TYPE_URI_CLIP, some_uri, NULL,
-- >   (GAsyncReadyCallback) asset_loaded_cb, user_data);
assetRequestAsync ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Cancellable.IsCancellable a) =>
    GType
    -- ^ /@extractableType@/: The [Asset:extractableType]("GI.GES.Objects.Asset#g:attr:extractableType") of the asset
    -> Maybe (T.Text)
    -- ^ /@id@/: The [Asset:id]("GI.GES.Objects.Asset#g:attr:id") of the asset
    -> Maybe (a)
    -- ^ /@cancellable@/: An object to allow cancellation of the
    -- asset request, or 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A function to call when the initialization is finished
    -> m ()
assetRequestAsync :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCancellable a) =>
GType -> Maybe Text -> Maybe a -> Maybe AsyncReadyCallback -> m ()
assetRequestAsync GType
extractableType Maybe Text
id Maybe a
cancellable Maybe AsyncReadyCallback
callback = 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
    let extractableType' :: CGType
extractableType' = GType -> CGType
gtypeToCGType GType
extractableType
    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'
    Ptr Cancellable
maybeCancellable <- case Maybe a
cancellable of
        Maybe a
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just a
jCancellable -> do
            Ptr Cancellable
jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CGType
-> CString
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ges_asset_request_async CGType
extractableType' CString
maybeId Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
cancellable a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeId
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Asset::request_finish
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The task result to fetch the asset from"
--                 , 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_asset_request_finish" ges_asset_request_finish :: 
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Asset)

-- | Fetches an asset requested by 'GI.GES.Objects.Asset.assetRequestAsync', which
-- finalises the request.
assetRequestFinish ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
    a
    -- ^ /@res@/: The task result to fetch the asset from
    -> m Asset
    -- ^ __Returns:__ The requested asset, or 'P.Nothing' if an error
    -- occurred. /(Can throw 'Data.GI.Base.GError.GError')/
assetRequestFinish :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m Asset
assetRequestFinish a
res = 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 AsyncResult
res' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
res
    IO Asset -> IO () -> IO 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 AsyncResult -> Ptr (Ptr GError) -> IO (Ptr Asset)
ges_asset_request_finish Ptr AsyncResult
res'
        Text -> Ptr Asset -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"assetRequestFinish" Ptr Asset
result
        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
Asset) Ptr Asset
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
res
        Asset -> IO Asset
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Asset
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif