{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Provides a base class for implementing asynchronous function results.
-- 
-- Asynchronous operations are broken up into two separate operations
-- which are chained together by a t'GI.Gio.Callbacks.AsyncReadyCallback'. To begin
-- an asynchronous operation, provide a t'GI.Gio.Callbacks.AsyncReadyCallback' to the
-- asynchronous function. This callback will be triggered when the
-- operation has completed, and must be run in a later iteration of
-- the [thread-default main context][g-main-context-push-thread-default]
-- from where the operation was initiated. It will be passed a
-- t'GI.Gio.Interfaces.AsyncResult.AsyncResult' instance filled with the details of the operation\'s
-- success or failure, the object the asynchronous function was
-- started for and any error codes returned. The asynchronous callback
-- function is then expected to call the corresponding \"@/_finish()/@\"
-- function, passing the object the function was called for, the
-- t'GI.Gio.Interfaces.AsyncResult.AsyncResult' instance, and (optionally) an /@error@/ to grab any
-- error conditions that may have occurred.
-- 
-- The \"@/_finish()/@\" function for an operation takes the generic result
-- (of type t'GI.Gio.Interfaces.AsyncResult.AsyncResult') and returns the specific result that the
-- operation in question yields (e.g. a t'GI.Gio.Objects.FileEnumerator.FileEnumerator' for a
-- \"enumerate children\" operation). If the result or error status of the
-- operation is not needed, there is no need to call the \"@/_finish()/@\"
-- function; GIO will take care of cleaning up the result and error
-- information after the t'GI.Gio.Callbacks.AsyncReadyCallback' returns. You can pass
-- 'P.Nothing' for the t'GI.Gio.Callbacks.AsyncReadyCallback' if you don\'t need to take any
-- action at all after the operation completes. Applications may also
-- take a reference to the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' and call \"@/_finish()/@\" later;
-- however, the \"@/_finish()/@\" function may be called at most once.
-- 
-- Example of a typical asynchronous operation flow:
-- 
-- === /C code/
-- >
-- >void _theoretical_frobnitz_async (Theoretical         *t,
-- >                                  GCancellable        *c,
-- >                                  GAsyncReadyCallback  cb,
-- >                                  gpointer             u);
-- >
-- >gboolean _theoretical_frobnitz_finish (Theoretical   *t,
-- >                                       GAsyncResult  *res,
-- >                                       GError       **e);
-- >
-- >static void
-- >frobnitz_result_func (GObject      *source_object,
-- >		 GAsyncResult *res,
-- >		 gpointer      user_data)
-- >{
-- >  gboolean success = FALSE;
-- >
-- >  success = _theoretical_frobnitz_finish (source_object, res, NULL);
-- >
-- >  if (success)
-- >    g_printf ("Hurray!\n");
-- >  else
-- >    g_printf ("Uh oh!\n");
-- >
-- >  ...
-- >
-- >}
-- >
-- >int main (int argc, void *argv[])
-- >{
-- >   ...
-- >
-- >   _theoretical_frobnitz_async (theoretical_data,
-- >                                NULL,
-- >                                frobnitz_result_func,
-- >                                NULL);
-- >
-- >   ...
-- >}
-- 
-- 
-- The callback for an asynchronous operation is called only once, and is
-- always called, even in the case of a cancelled operation. On cancellation
-- the result is a 'GI.Gio.Enums.IOErrorEnumCancelled' error.
-- 
-- ## I\/O Priority # {@/io/@-priority}
-- 
-- Many I\/O-related asynchronous operations have a priority parameter,
-- which is used in certain cases to determine the order in which
-- operations are executed. They are not used to determine system-wide
-- I\/O scheduling. Priorities are integers, with lower numbers indicating
-- higher priority. It is recommended to choose priorities between
-- 'GI.GLib.Constants.PRIORITY_LOW' and 'GI.GLib.Constants.PRIORITY_HIGH', with 'GI.GLib.Constants.PRIORITY_DEFAULT'
-- as a default.

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

module GI.Gio.Interfaces.AsyncResult
    ( 

-- * Exported types
    AsyncResult(..)                         ,
    IsAsyncResult                           ,
    toAsyncResult                           ,


 -- * 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"), [isTagged]("GI.Gio.Interfaces.AsyncResult#g:method:isTagged"), [legacyPropagateError]("GI.Gio.Interfaces.AsyncResult#g:method:legacyPropagateError"), [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
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSourceObject]("GI.Gio.Interfaces.AsyncResult#g:method:getSourceObject"), [getUserData]("GI.Gio.Interfaces.AsyncResult#g:method:getUserData").
-- 
-- ==== Setters
-- [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)
    ResolveAsyncResultMethod                ,
#endif

-- ** getSourceObject #method:getSourceObject#

#if defined(ENABLE_OVERLOADING)
    AsyncResultGetSourceObjectMethodInfo    ,
#endif
    asyncResultGetSourceObject              ,


-- ** getUserData #method:getUserData#

#if defined(ENABLE_OVERLOADING)
    AsyncResultGetUserDataMethodInfo        ,
#endif
    asyncResultGetUserData                  ,


-- ** isTagged #method:isTagged#

#if defined(ENABLE_OVERLOADING)
    AsyncResultIsTaggedMethodInfo           ,
#endif
    asyncResultIsTagged                     ,


-- ** legacyPropagateError #method:legacyPropagateError#

#if defined(ENABLE_OVERLOADING)
    AsyncResultLegacyPropagateErrorMethodInfo,
#endif
    asyncResultLegacyPropagateError         ,




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

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

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

foreign import ccall "g_async_result_get_type"
    c_g_async_result_get_type :: IO B.Types.GType

instance B.Types.TypedObject AsyncResult where
    glibType :: IO GType
glibType = IO GType
c_g_async_result_get_type

instance B.Types.GObject AsyncResult

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

instance O.HasParentTypes AsyncResult
type instance O.ParentTypes AsyncResult = '[GObject.Object.Object]

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

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

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

#if defined(ENABLE_OVERLOADING)
#endif

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

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

#endif

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

#endif

-- method AsyncResult::get_source_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GObject" , name = "Object" })
-- throws : False
-- Skip return : False

foreign import ccall "g_async_result_get_source_object" g_async_result_get_source_object :: 
    Ptr AsyncResult ->                      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    IO (Ptr GObject.Object.Object)

-- | Gets the source object from a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
asyncResultGetSourceObject ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsyncResult a) =>
    a
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m (Maybe GObject.Object.Object)
    -- ^ __Returns:__ a new reference to the source
    --    object for the /@res@/, or 'P.Nothing' if there is none.
asyncResultGetSourceObject :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m (Maybe Object)
asyncResultGetSourceObject a
res = IO (Maybe Object) -> m (Maybe Object)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
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
    Ptr Object
result <- Ptr AsyncResult -> IO (Ptr Object)
g_async_result_get_source_object Ptr AsyncResult
res'
    Maybe Object
maybeResult <- Ptr Object -> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Object
result ((Ptr Object -> IO Object) -> IO (Maybe Object))
-> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. (a -> b) -> a -> b
$ \Ptr Object
result' -> do
        Object
result'' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
result'
        Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
res
    Maybe Object -> IO (Maybe Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Object
maybeResult

#if defined(ENABLE_OVERLOADING)
data AsyncResultGetSourceObjectMethodInfo
instance (signature ~ (m (Maybe GObject.Object.Object)), MonadIO m, IsAsyncResult a) => O.OverloadedMethod AsyncResultGetSourceObjectMethodInfo a signature where
    overloadedMethod = asyncResultGetSourceObject

instance O.OverloadedMethodInfo AsyncResultGetSourceObjectMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.AsyncResult.asyncResultGetSourceObject",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-AsyncResult.html#v:asyncResultGetSourceObject"
        })


#endif

-- method AsyncResult::get_user_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "g_async_result_get_user_data" g_async_result_get_user_data :: 
    Ptr AsyncResult ->                      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    IO (Ptr ())

-- | Gets the user data from a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
asyncResultGetUserData ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsyncResult a) =>
    a
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m (Ptr ())
    -- ^ __Returns:__ the user data for /@res@/.
asyncResultGetUserData :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m (Ptr ())
asyncResultGetUserData a
res = IO (Ptr ()) -> m (Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
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
    Ptr ()
result <- Ptr AsyncResult -> IO (Ptr ())
g_async_result_get_user_data Ptr AsyncResult
res'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
res
    Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data AsyncResultGetUserDataMethodInfo
instance (signature ~ (m (Ptr ())), MonadIO m, IsAsyncResult a) => O.OverloadedMethod AsyncResultGetUserDataMethodInfo a signature where
    overloadedMethod = asyncResultGetUserData

instance O.OverloadedMethodInfo AsyncResultGetUserDataMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.AsyncResult.asyncResultGetUserData",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-AsyncResult.html#v:asyncResultGetUserData"
        })


#endif

-- method AsyncResult::is_tagged
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source_tag"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an application-defined tag"
--                 , 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 "g_async_result_is_tagged" g_async_result_is_tagged :: 
    Ptr AsyncResult ->                      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr () ->                               -- source_tag : TBasicType TPtr
    IO CInt

-- | Checks if /@res@/ has the given /@sourceTag@/ (generally a function
-- pointer indicating the function /@res@/ was created by).
-- 
-- /Since: 2.34/
asyncResultIsTagged ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsyncResult a) =>
    a
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> Ptr ()
    -- ^ /@sourceTag@/: an application-defined tag
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@res@/ has the indicated /@sourceTag@/, 'P.False' if
    --   not.
asyncResultIsTagged :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> Ptr () -> m Bool
asyncResultIsTagged a
res Ptr ()
sourceTag = IO Bool -> m Bool
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 AsyncResult
res' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
res
    CInt
result <- Ptr AsyncResult -> Ptr () -> IO CInt
g_async_result_is_tagged Ptr AsyncResult
res' Ptr ()
sourceTag
    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
res
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AsyncResultIsTaggedMethodInfo
instance (signature ~ (Ptr () -> m Bool), MonadIO m, IsAsyncResult a) => O.OverloadedMethod AsyncResultIsTaggedMethodInfo a signature where
    overloadedMethod = asyncResultIsTagged

instance O.OverloadedMethodInfo AsyncResultIsTaggedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.AsyncResult.asyncResultIsTagged",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-AsyncResult.html#v:asyncResultIsTagged"
        })


#endif

-- method AsyncResult::legacy_propagate_error
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_async_result_legacy_propagate_error" g_async_result_legacy_propagate_error :: 
    Ptr AsyncResult ->                      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | If /@res@/ is a t'GI.Gio.Objects.SimpleAsyncResult.SimpleAsyncResult', this is equivalent to
-- 'GI.Gio.Objects.SimpleAsyncResult.simpleAsyncResultPropagateError'. Otherwise it returns
-- 'P.False'.
-- 
-- This can be used for legacy error handling in async *@/_finish()/@
-- wrapper functions that traditionally handled t'GI.Gio.Objects.SimpleAsyncResult.SimpleAsyncResult'
-- error returns themselves rather than calling into the virtual method.
-- This should not be used in new code; t'GI.Gio.Interfaces.AsyncResult.AsyncResult' errors that are
-- set by virtual methods should also be extracted by virtual methods,
-- to enable subclasses to chain up correctly.
-- 
-- /Since: 2.34/
asyncResultLegacyPropagateError ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsyncResult a) =>
    a
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
asyncResultLegacyPropagateError :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m ()
asyncResultLegacyPropagateError a
res = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
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 () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_async_result_legacy_propagate_error Ptr AsyncResult
res'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
res
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data AsyncResultLegacyPropagateErrorMethodInfo
instance (signature ~ (m ()), MonadIO m, IsAsyncResult a) => O.OverloadedMethod AsyncResultLegacyPropagateErrorMethodInfo a signature where
    overloadedMethod = asyncResultLegacyPropagateError

instance O.OverloadedMethodInfo AsyncResultLegacyPropagateErrorMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.AsyncResult.asyncResultLegacyPropagateError",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-AsyncResult.html#v:asyncResultLegacyPropagateError"
        })


#endif

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

#endif