{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.GObject.Objects.Object.Object' that implements the t'GI.GES.Interfaces.Extractable.Extractable' interface can be
-- extracted from a t'GI.GES.Objects.Asset.Asset' using 'GI.GES.Objects.Asset.assetExtract'.
-- 
-- Each extractable type will have its own way of interpreting the
-- [Asset:id]("GI.GES.Objects.Asset#g:attr:id") of an asset (or, if it is associated with a specific
-- subclass of t'GI.GES.Objects.Asset.Asset', the asset subclass may handle the
-- interpretation of the [Asset:id]("GI.GES.Objects.Asset#g:attr:id")). By default, the requested asset
-- [Asset:id]("GI.GES.Objects.Asset#g:attr:id") will be ignored by a t'GI.GES.Interfaces.Extractable.Extractable' and will be set to
-- the type name of the extractable instead. Also by default, when the
-- requested asset is extracted, the returned object will simply be a
-- newly created default object of that extractable type. You should check
-- the documentation for each extractable type to see if they differ from
-- the default.
-- 
-- After the object is extracted, it will have a reference to the asset it
-- came from, which you can retrieve using 'GI.GES.Interfaces.Extractable.extractableGetAsset'.

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

module GI.GES.Interfaces.Extractable
    ( 

-- * Exported types
    Extractable(..)                         ,
    IsExtractable                           ,
    toExtractable                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [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"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAsset]("GI.GES.Interfaces.Extractable#g:method:getAsset"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getId]("GI.GES.Interfaces.Extractable#g:method:getId"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setAsset]("GI.GES.Interfaces.Extractable#g:method:setAsset"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveExtractableMethod                ,
#endif

-- ** getAsset #method:getAsset#

#if defined(ENABLE_OVERLOADING)
    ExtractableGetAssetMethodInfo           ,
#endif
    extractableGetAsset                     ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    ExtractableGetIdMethodInfo              ,
#endif
    extractableGetId                        ,


-- ** setAsset #method:setAsset#

#if defined(ENABLE_OVERLOADING)
    ExtractableSetAssetMethodInfo           ,
#endif
    extractableSetAsset                     ,




    ) 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.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.Objects.Asset as GES.Asset
import qualified GI.GObject.Objects.InitiallyUnowned as GObject.InitiallyUnowned
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "ges_extractable_get_type"
    c_ges_extractable_get_type :: IO B.Types.GType

instance B.Types.TypedObject Extractable where
    glibType :: IO GType
glibType = IO GType
c_ges_extractable_get_type

instance B.Types.GObject Extractable

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

instance O.HasParentTypes Extractable
type instance O.ParentTypes Extractable = '[GObject.InitiallyUnowned.InitiallyUnowned, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Extractable
type instance O.AttributeList Extractable = ExtractableAttributeList
type ExtractableAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveExtractableMethod (t :: Symbol) (o :: *) :: * where
    ResolveExtractableMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveExtractableMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveExtractableMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveExtractableMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveExtractableMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveExtractableMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveExtractableMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveExtractableMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveExtractableMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveExtractableMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveExtractableMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveExtractableMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveExtractableMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveExtractableMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveExtractableMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveExtractableMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveExtractableMethod "getAsset" o = ExtractableGetAssetMethodInfo
    ResolveExtractableMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveExtractableMethod "getId" o = ExtractableGetIdMethodInfo
    ResolveExtractableMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveExtractableMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveExtractableMethod "setAsset" o = ExtractableSetAssetMethodInfo
    ResolveExtractableMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveExtractableMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveExtractableMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveExtractableMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- method Extractable::get_asset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Extractable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESExtractable" , 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_extractable_get_asset" ges_extractable_get_asset :: 
    Ptr Extractable ->                      -- self : TInterface (Name {namespace = "GES", name = "Extractable"})
    IO (Ptr GES.Asset.Asset)

-- | Get the asset that has been set on the extractable object.
extractableGetAsset ::
    (B.CallStack.HasCallStack, MonadIO m, IsExtractable a) =>
    a
    -- ^ /@self@/: A t'GI.GES.Interfaces.Extractable.Extractable'
    -> m (Maybe GES.Asset.Asset)
    -- ^ __Returns:__ The asset set on /@self@/, or 'P.Nothing'
    -- if no asset has been set.
extractableGetAsset :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsExtractable a) =>
a -> m (Maybe Asset)
extractableGetAsset a
self = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Ptr Extractable
self' <- forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Asset
result <- Ptr Extractable -> IO (Ptr Asset)
ges_extractable_get_asset Ptr Extractable
self'
    Maybe Asset
maybeResult <- forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Asset
result forall a b. (a -> b) -> a -> b
$ \Ptr Asset
result' -> do
        Asset
result'' <- (forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Asset -> Asset
GES.Asset.Asset) Ptr Asset
result'
        forall (m :: * -> *) a. Monad m => a -> m a
return Asset
result''
    forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Asset
maybeResult

#if defined(ENABLE_OVERLOADING)
data ExtractableGetAssetMethodInfo
instance (signature ~ (m (Maybe GES.Asset.Asset)), MonadIO m, IsExtractable a) => O.OverloadedMethod ExtractableGetAssetMethodInfo a signature where
    overloadedMethod = extractableGetAsset

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


#endif

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

-- | Gets the [Asset:id]("GI.GES.Objects.Asset#g:attr:id") of some associated asset. It may be the case
-- that the object has no set asset, or even that such an asset does not
-- yet exist in the GES cache. Instead, this will return the asset
-- [Asset:id]("GI.GES.Objects.Asset#g:attr:id") that is _compatible_ with the current state of the object,
-- as determined by the t'GI.GES.Interfaces.Extractable.Extractable' implementer. If it was indeed
-- extracted from an asset, this should return the same as its
-- corresponding asset [Asset:id]("GI.GES.Objects.Asset#g:attr:id").
extractableGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsExtractable a) =>
    a
    -- ^ /@self@/: A t'GI.GES.Interfaces.Extractable.Extractable'
    -> m T.Text
    -- ^ __Returns:__ The [Asset:id]("GI.GES.Objects.Asset#g:attr:id") of some associated t'GI.GES.Objects.Asset.Asset'
    -- that is compatible with /@self@/\'s current state.
extractableGetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsExtractable a) =>
a -> m Text
extractableGetId a
self = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Ptr Extractable
self' <- forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Extractable -> IO CString
ges_extractable_get_id Ptr Extractable
self'
    forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"extractableGetId" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
cstringToText CString
result
    forall a. Ptr a -> IO ()
freeMem CString
result
    forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ExtractableGetIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsExtractable a) => O.OverloadedMethod ExtractableGetIdMethodInfo a signature where
    overloadedMethod = extractableGetId

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


#endif

-- method Extractable::set_asset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "Extractable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESExtractable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "asset"
--           , argType = TInterface Name { namespace = "GES" , name = "Asset" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The asset to set" , 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_extractable_set_asset" ges_extractable_set_asset :: 
    Ptr Extractable ->                      -- self : TInterface (Name {namespace = "GES", name = "Extractable"})
    Ptr GES.Asset.Asset ->                  -- asset : TInterface (Name {namespace = "GES", name = "Asset"})
    IO CInt

-- | Sets the asset for this extractable object.
-- 
-- When an object is extracted from an asset using 'GI.GES.Objects.Asset.assetExtract' its
-- asset will be automatically set. Note that many classes that implement
-- t'GI.GES.Interfaces.Extractable.Extractable' will automatically create their objects using assets
-- when you call their /@new@/ methods. However, you can use this method to
-- associate an object with a compatible asset if it was created by other
-- means and does not yet have an asset. Or, for some implementations of
-- t'GI.GES.Interfaces.Extractable.Extractable', you can use this to change the asset of the given
-- extractable object, which will lead to a change in its state to
-- match the new asset [Asset:id]("GI.GES.Objects.Asset#g:attr:id").
extractableSetAsset ::
    (B.CallStack.HasCallStack, MonadIO m, IsExtractable a, GES.Asset.IsAsset b) =>
    a
    -- ^ /@self@/: A t'GI.GES.Interfaces.Extractable.Extractable'
    -> b
    -- ^ /@asset@/: The asset to set
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@asset@/ could be successfully set on /@self@/.
extractableSetAsset :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsExtractable a, IsAsset b) =>
a -> b -> m Bool
extractableSetAsset a
self b
asset = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Ptr Extractable
self' <- forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Asset
asset' <- forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
asset
    CInt
result <- Ptr Extractable -> Ptr Asset -> IO CInt
ges_extractable_set_asset Ptr Extractable
self' Ptr Asset
asset'
    let result' :: Bool
result' = (forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
asset
    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

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


#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Extractable = ExtractableSignalList
type ExtractableSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif