{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.OSTree.Objects.AsyncProgress
    ( 

-- * Exported types
    AsyncProgress(..)                       ,
    IsAsyncProgress                         ,
    toAsyncProgress                         ,
    noAsyncProgress                         ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveAsyncProgressMethod              ,
#endif


-- ** finish #method:finish#

#if defined(ENABLE_OVERLOADING)
    AsyncProgressFinishMethodInfo           ,
#endif
    asyncProgressFinish                     ,


-- ** getStatus #method:getStatus#

#if defined(ENABLE_OVERLOADING)
    AsyncProgressGetStatusMethodInfo        ,
#endif
    asyncProgressGetStatus                  ,


-- ** getUint #method:getUint#

#if defined(ENABLE_OVERLOADING)
    AsyncProgressGetUintMethodInfo          ,
#endif
    asyncProgressGetUint                    ,


-- ** getUint64 #method:getUint64#

#if defined(ENABLE_OVERLOADING)
    AsyncProgressGetUint64MethodInfo        ,
#endif
    asyncProgressGetUint64                  ,


-- ** getVariant #method:getVariant#

#if defined(ENABLE_OVERLOADING)
    AsyncProgressGetVariantMethodInfo       ,
#endif
    asyncProgressGetVariant                 ,


-- ** new #method:new#

    asyncProgressNew                        ,


-- ** newAndConnect #method:newAndConnect#

    asyncProgressNewAndConnect              ,


-- ** setStatus #method:setStatus#

#if defined(ENABLE_OVERLOADING)
    AsyncProgressSetStatusMethodInfo        ,
#endif
    asyncProgressSetStatus                  ,


-- ** setUint #method:setUint#

#if defined(ENABLE_OVERLOADING)
    AsyncProgressSetUintMethodInfo          ,
#endif
    asyncProgressSetUint                    ,


-- ** setUint64 #method:setUint64#

#if defined(ENABLE_OVERLOADING)
    AsyncProgressSetUint64MethodInfo        ,
#endif
    asyncProgressSetUint64                  ,


-- ** setVariant #method:setVariant#

#if defined(ENABLE_OVERLOADING)
    AsyncProgressSetVariantMethodInfo       ,
#endif
    asyncProgressSetVariant                 ,




 -- * Signals
-- ** changed #signal:changed#

    AsyncProgressChangedCallback            ,
#if defined(ENABLE_OVERLOADING)
    AsyncProgressChangedSignalInfo          ,
#endif
    C_AsyncProgressChangedCallback          ,
    afterAsyncProgressChanged               ,
    genClosure_AsyncProgressChanged         ,
    mk_AsyncProgressChangedCallback         ,
    noAsyncProgressChangedCallback          ,
    onAsyncProgressChanged                  ,
    wrap_AsyncProgressChangedCallback       ,




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

-- | Memory-managed wrapper type.
newtype AsyncProgress = AsyncProgress (ManagedPtr AsyncProgress)
    deriving (AsyncProgress -> AsyncProgress -> Bool
(AsyncProgress -> AsyncProgress -> Bool)
-> (AsyncProgress -> AsyncProgress -> Bool) -> Eq AsyncProgress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AsyncProgress -> AsyncProgress -> Bool
$c/= :: AsyncProgress -> AsyncProgress -> Bool
== :: AsyncProgress -> AsyncProgress -> Bool
$c== :: AsyncProgress -> AsyncProgress -> Bool
Eq)
foreign import ccall "ostree_async_progress_get_type"
    c_ostree_async_progress_get_type :: IO GType

instance GObject AsyncProgress where
    gobjectType :: IO GType
gobjectType = IO GType
c_ostree_async_progress_get_type
    

-- | Convert 'AsyncProgress' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue AsyncProgress where
    toGValue :: AsyncProgress -> IO GValue
toGValue o :: AsyncProgress
o = do
        GType
gtype <- IO GType
c_ostree_async_progress_get_type
        AsyncProgress -> (Ptr AsyncProgress -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr AsyncProgress
o (GType
-> (GValue -> Ptr AsyncProgress -> IO ())
-> Ptr AsyncProgress
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr AsyncProgress -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO AsyncProgress
fromGValue gv :: GValue
gv = do
        Ptr AsyncProgress
ptr <- GValue -> IO (Ptr AsyncProgress)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr AsyncProgress)
        (ManagedPtr AsyncProgress -> AsyncProgress)
-> Ptr AsyncProgress -> IO AsyncProgress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr AsyncProgress -> AsyncProgress
AsyncProgress Ptr AsyncProgress
ptr
        
    

-- | Type class for types which can be safely cast to `AsyncProgress`, for instance with `toAsyncProgress`.
class (GObject o, O.IsDescendantOf AsyncProgress o) => IsAsyncProgress o
instance (GObject o, O.IsDescendantOf AsyncProgress o) => IsAsyncProgress o

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

-- | Cast to `AsyncProgress`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toAsyncProgress :: (MonadIO m, IsAsyncProgress o) => o -> m AsyncProgress
toAsyncProgress :: o -> m AsyncProgress
toAsyncProgress = IO AsyncProgress -> m AsyncProgress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AsyncProgress -> m AsyncProgress)
-> (o -> IO AsyncProgress) -> o -> m AsyncProgress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr AsyncProgress -> AsyncProgress)
-> o -> IO AsyncProgress
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr AsyncProgress -> AsyncProgress
AsyncProgress

-- | A convenience alias for `Nothing` :: `Maybe` `AsyncProgress`.
noAsyncProgress :: Maybe AsyncProgress
noAsyncProgress :: Maybe AsyncProgress
noAsyncProgress = Maybe AsyncProgress
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveAsyncProgressMethod (t :: Symbol) (o :: *) :: * where
    ResolveAsyncProgressMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAsyncProgressMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAsyncProgressMethod "finish" o = AsyncProgressFinishMethodInfo
    ResolveAsyncProgressMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAsyncProgressMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAsyncProgressMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAsyncProgressMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAsyncProgressMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAsyncProgressMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAsyncProgressMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAsyncProgressMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAsyncProgressMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAsyncProgressMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAsyncProgressMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAsyncProgressMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAsyncProgressMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAsyncProgressMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAsyncProgressMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAsyncProgressMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAsyncProgressMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAsyncProgressMethod "getStatus" o = AsyncProgressGetStatusMethodInfo
    ResolveAsyncProgressMethod "getUint" o = AsyncProgressGetUintMethodInfo
    ResolveAsyncProgressMethod "getUint64" o = AsyncProgressGetUint64MethodInfo
    ResolveAsyncProgressMethod "getVariant" o = AsyncProgressGetVariantMethodInfo
    ResolveAsyncProgressMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAsyncProgressMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAsyncProgressMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAsyncProgressMethod "setStatus" o = AsyncProgressSetStatusMethodInfo
    ResolveAsyncProgressMethod "setUint" o = AsyncProgressSetUintMethodInfo
    ResolveAsyncProgressMethod "setUint64" o = AsyncProgressSetUint64MethodInfo
    ResolveAsyncProgressMethod "setVariant" o = AsyncProgressSetVariantMethodInfo
    ResolveAsyncProgressMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveAsyncProgressMethod t AsyncProgress, O.MethodInfo info AsyncProgress p) => OL.IsLabel t (AsyncProgress -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

-- signal AsyncProgress::changed
-- | Emitted when /@self@/ has been changed.
type AsyncProgressChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `AsyncProgressChangedCallback`@.
noAsyncProgressChangedCallback :: Maybe AsyncProgressChangedCallback
noAsyncProgressChangedCallback :: Maybe (IO ())
noAsyncProgressChangedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_AsyncProgressChangedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_AsyncProgressChanged :: MonadIO m => AsyncProgressChangedCallback -> m (GClosure C_AsyncProgressChangedCallback)
genClosure_AsyncProgressChanged :: IO () -> m (GClosure C_AsyncProgressChangedCallback)
genClosure_AsyncProgressChanged cb :: IO ()
cb = IO (GClosure C_AsyncProgressChangedCallback)
-> m (GClosure C_AsyncProgressChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_AsyncProgressChangedCallback)
 -> m (GClosure C_AsyncProgressChangedCallback))
-> IO (GClosure C_AsyncProgressChangedCallback)
-> m (GClosure C_AsyncProgressChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_AsyncProgressChangedCallback
cb' = IO () -> C_AsyncProgressChangedCallback
wrap_AsyncProgressChangedCallback IO ()
cb
    C_AsyncProgressChangedCallback
-> IO (FunPtr C_AsyncProgressChangedCallback)
mk_AsyncProgressChangedCallback C_AsyncProgressChangedCallback
cb' IO (FunPtr C_AsyncProgressChangedCallback)
-> (FunPtr C_AsyncProgressChangedCallback
    -> IO (GClosure C_AsyncProgressChangedCallback))
-> IO (GClosure C_AsyncProgressChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_AsyncProgressChangedCallback
-> IO (GClosure C_AsyncProgressChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `AsyncProgressChangedCallback` into a `C_AsyncProgressChangedCallback`.
wrap_AsyncProgressChangedCallback ::
    AsyncProgressChangedCallback ->
    C_AsyncProgressChangedCallback
wrap_AsyncProgressChangedCallback :: IO () -> C_AsyncProgressChangedCallback
wrap_AsyncProgressChangedCallback _cb :: IO ()
_cb _ _ = do
    IO ()
_cb 


-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' asyncProgress #changed callback
-- @
-- 
-- 
onAsyncProgressChanged :: (IsAsyncProgress a, MonadIO m) => a -> AsyncProgressChangedCallback -> m SignalHandlerId
onAsyncProgressChanged :: a -> IO () -> m SignalHandlerId
onAsyncProgressChanged obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_AsyncProgressChangedCallback
cb' = IO () -> C_AsyncProgressChangedCallback
wrap_AsyncProgressChangedCallback IO ()
cb
    FunPtr C_AsyncProgressChangedCallback
cb'' <- C_AsyncProgressChangedCallback
-> IO (FunPtr C_AsyncProgressChangedCallback)
mk_AsyncProgressChangedCallback C_AsyncProgressChangedCallback
cb'
    a
-> Text
-> FunPtr C_AsyncProgressChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "changed" FunPtr C_AsyncProgressChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' asyncProgress #changed callback
-- @
-- 
-- 
afterAsyncProgressChanged :: (IsAsyncProgress a, MonadIO m) => a -> AsyncProgressChangedCallback -> m SignalHandlerId
afterAsyncProgressChanged :: a -> IO () -> m SignalHandlerId
afterAsyncProgressChanged obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_AsyncProgressChangedCallback
cb' = IO () -> C_AsyncProgressChangedCallback
wrap_AsyncProgressChangedCallback IO ()
cb
    FunPtr C_AsyncProgressChangedCallback
cb'' <- C_AsyncProgressChangedCallback
-> IO (FunPtr C_AsyncProgressChangedCallback)
mk_AsyncProgressChangedCallback C_AsyncProgressChangedCallback
cb'
    a
-> Text
-> FunPtr C_AsyncProgressChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "changed" FunPtr C_AsyncProgressChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data AsyncProgressChangedSignalInfo
instance SignalInfo AsyncProgressChangedSignalInfo where
    type HaskellCallbackType AsyncProgressChangedSignalInfo = AsyncProgressChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_AsyncProgressChangedCallback cb
        cb'' <- mk_AsyncProgressChangedCallback cb'
        connectSignalFunPtr obj "changed" cb'' connectMode detail

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "ostree_async_progress_new" ostree_async_progress_new :: 
    IO (Ptr AsyncProgress)

-- | /No description available in the introspection data./
asyncProgressNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m AsyncProgress
    -- ^ __Returns:__ A new progress object
asyncProgressNew :: m AsyncProgress
asyncProgressNew  = IO AsyncProgress -> m AsyncProgress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AsyncProgress -> m AsyncProgress)
-> IO AsyncProgress -> m AsyncProgress
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncProgress
result <- IO (Ptr AsyncProgress)
ostree_async_progress_new
    Text -> Ptr AsyncProgress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "asyncProgressNew" Ptr AsyncProgress
result
    AsyncProgress
result' <- ((ManagedPtr AsyncProgress -> AsyncProgress)
-> Ptr AsyncProgress -> IO AsyncProgress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr AsyncProgress -> AsyncProgress
AsyncProgress) Ptr AsyncProgress
result
    AsyncProgress -> IO AsyncProgress
forall (m :: * -> *) a. Monad m => a -> m a
return AsyncProgress
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method AsyncProgress::new_and_connect
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "changed"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "OSTree" , name = "AsyncProgress" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_async_progress_new_and_connect" ostree_async_progress_new_and_connect :: 
    Ptr () ->                               -- changed : TBasicType TPtr
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO (Ptr AsyncProgress)

-- | /No description available in the introspection data./
asyncProgressNewAndConnect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -> Ptr ()
    -> m AsyncProgress
asyncProgressNewAndConnect :: Ptr () -> Ptr () -> m AsyncProgress
asyncProgressNewAndConnect changed :: Ptr ()
changed userData :: Ptr ()
userData = IO AsyncProgress -> m AsyncProgress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AsyncProgress -> m AsyncProgress)
-> IO AsyncProgress -> m AsyncProgress
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncProgress
result <- Ptr () -> Ptr () -> IO (Ptr AsyncProgress)
ostree_async_progress_new_and_connect Ptr ()
changed Ptr ()
userData
    Text -> Ptr AsyncProgress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "asyncProgressNewAndConnect" Ptr AsyncProgress
result
    AsyncProgress
result' <- ((ManagedPtr AsyncProgress -> AsyncProgress)
-> Ptr AsyncProgress -> IO AsyncProgress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr AsyncProgress -> AsyncProgress
AsyncProgress) Ptr AsyncProgress
result
    AsyncProgress -> IO AsyncProgress
forall (m :: * -> *) a. Monad m => a -> m a
return AsyncProgress
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "ostree_async_progress_finish" ostree_async_progress_finish :: 
    Ptr AsyncProgress ->                    -- self : TInterface (Name {namespace = "OSTree", name = "AsyncProgress"})
    IO ()

-- | Process any pending signals, ensuring the main context is cleared
-- of sources used by this object.  Also ensures that no further
-- events will be queued.
asyncProgressFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsyncProgress a) =>
    a
    -- ^ /@self@/: Self
    -> m ()
asyncProgressFinish :: a -> m ()
asyncProgressFinish self :: a
self = 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 AsyncProgress
self' <- a -> IO (Ptr AsyncProgress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncProgress -> IO ()
ostree_async_progress_finish Ptr AsyncProgress
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AsyncProgressFinishMethodInfo
instance (signature ~ (m ()), MonadIO m, IsAsyncProgress a) => O.MethodInfo AsyncProgressFinishMethodInfo a signature where
    overloadedMethod = asyncProgressFinish

#endif

-- method AsyncProgress::get_status
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "AsyncProgress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeAsyncProgress"
--                 , 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 "ostree_async_progress_get_status" ostree_async_progress_get_status :: 
    Ptr AsyncProgress ->                    -- self : TInterface (Name {namespace = "OSTree", name = "AsyncProgress"})
    IO CString

-- | Get the human-readable status string from the t'GI.OSTree.Objects.AsyncProgress.AsyncProgress'. This
-- operation is thread-safe. The retuned value may be 'P.Nothing' if no status is
-- set.
-- 
-- This is a convenience function to get the well-known @status@ key.
-- 
-- /Since: 2017.6/
asyncProgressGetStatus ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsyncProgress a) =>
    a
    -- ^ /@self@/: an t'GI.OSTree.Objects.AsyncProgress.AsyncProgress'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the current status, or 'P.Nothing' if none is set
asyncProgressGetStatus :: a -> m (Maybe Text)
asyncProgressGetStatus self :: a
self = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncProgress
self' <- a -> IO (Ptr AsyncProgress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr AsyncProgress -> IO CString
ostree_async_progress_get_status Ptr AsyncProgress
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data AsyncProgressGetStatusMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsAsyncProgress a) => O.MethodInfo AsyncProgressGetStatusMethodInfo a signature where
    overloadedMethod = asyncProgressGetStatus

#endif

-- method AsyncProgress::get_uint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "AsyncProgress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "ostree_async_progress_get_uint" ostree_async_progress_get_uint :: 
    Ptr AsyncProgress ->                    -- self : TInterface (Name {namespace = "OSTree", name = "AsyncProgress"})
    CString ->                              -- key : TBasicType TUTF8
    IO Word32

-- | /No description available in the introspection data./
asyncProgressGetUint ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsyncProgress a) =>
    a
    -> T.Text
    -> m Word32
asyncProgressGetUint :: a -> Text -> m Word32
asyncProgressGetUint self :: a
self key :: Text
key = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncProgress
self' <- a -> IO (Ptr AsyncProgress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
key' <- Text -> IO CString
textToCString Text
key
    Word32
result <- Ptr AsyncProgress -> CString -> IO Word32
ostree_async_progress_get_uint Ptr AsyncProgress
self' CString
key'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data AsyncProgressGetUintMethodInfo
instance (signature ~ (T.Text -> m Word32), MonadIO m, IsAsyncProgress a) => O.MethodInfo AsyncProgressGetUintMethodInfo a signature where
    overloadedMethod = asyncProgressGetUint

#endif

-- method AsyncProgress::get_uint64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "AsyncProgress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "ostree_async_progress_get_uint64" ostree_async_progress_get_uint64 :: 
    Ptr AsyncProgress ->                    -- self : TInterface (Name {namespace = "OSTree", name = "AsyncProgress"})
    CString ->                              -- key : TBasicType TUTF8
    IO Word64

-- | /No description available in the introspection data./
asyncProgressGetUint64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsyncProgress a) =>
    a
    -> T.Text
    -> m Word64
asyncProgressGetUint64 :: a -> Text -> m Word64
asyncProgressGetUint64 self :: a
self key :: Text
key = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncProgress
self' <- a -> IO (Ptr AsyncProgress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
key' <- Text -> IO CString
textToCString Text
key
    Word64
result <- Ptr AsyncProgress -> CString -> IO Word64
ostree_async_progress_get_uint64 Ptr AsyncProgress
self' CString
key'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AsyncProgressGetUint64MethodInfo
instance (signature ~ (T.Text -> m Word64), MonadIO m, IsAsyncProgress a) => O.MethodInfo AsyncProgressGetUint64MethodInfo a signature where
    overloadedMethod = asyncProgressGetUint64

#endif

-- method AsyncProgress::get_variant
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "AsyncProgress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeAsyncProgress"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a key to look up" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : False
-- Skip return : False

foreign import ccall "ostree_async_progress_get_variant" ostree_async_progress_get_variant :: 
    Ptr AsyncProgress ->                    -- self : TInterface (Name {namespace = "OSTree", name = "AsyncProgress"})
    CString ->                              -- key : TBasicType TUTF8
    IO (Ptr GVariant)

-- | Look up a key in the t'GI.OSTree.Objects.AsyncProgress.AsyncProgress' and return the t'GVariant' associated
-- with it. The lookup is thread-safe.
-- 
-- /Since: 2017.6/
asyncProgressGetVariant ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsyncProgress a) =>
    a
    -- ^ /@self@/: an t'GI.OSTree.Objects.AsyncProgress.AsyncProgress'
    -> T.Text
    -- ^ /@key@/: a key to look up
    -> m (Maybe GVariant)
    -- ^ __Returns:__ value for the given /@key@/, or 'P.Nothing' if
    --    it was not set
asyncProgressGetVariant :: a -> Text -> m (Maybe GVariant)
asyncProgressGetVariant self :: a
self key :: Text
key = IO (Maybe GVariant) -> m (Maybe GVariant)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GVariant) -> m (Maybe GVariant))
-> IO (Maybe GVariant) -> m (Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncProgress
self' <- a -> IO (Ptr AsyncProgress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr GVariant
result <- Ptr AsyncProgress -> CString -> IO (Ptr GVariant)
ostree_async_progress_get_variant Ptr AsyncProgress
self' CString
key'
    Maybe GVariant
maybeResult <- Ptr GVariant
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GVariant
result ((Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant))
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr GVariant
result' -> do
        GVariant
result'' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result'
        GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    Maybe GVariant -> IO (Maybe GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GVariant
maybeResult

#if defined(ENABLE_OVERLOADING)
data AsyncProgressGetVariantMethodInfo
instance (signature ~ (T.Text -> m (Maybe GVariant)), MonadIO m, IsAsyncProgress a) => O.MethodInfo AsyncProgressGetVariantMethodInfo a signature where
    overloadedMethod = asyncProgressGetVariant

#endif

-- method AsyncProgress::set_status
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "AsyncProgress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeAsyncProgress"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "status"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "new status string, or %NULL to clear the status"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_async_progress_set_status" ostree_async_progress_set_status :: 
    Ptr AsyncProgress ->                    -- self : TInterface (Name {namespace = "OSTree", name = "AsyncProgress"})
    CString ->                              -- status : TBasicType TUTF8
    IO ()

-- | Set the human-readable status string for the t'GI.OSTree.Objects.AsyncProgress.AsyncProgress'. This
-- operation is thread-safe. 'P.Nothing' may be passed to clear the status.
-- 
-- This is a convenience function to set the well-known @status@ key.
-- 
-- /Since: 2017.6/
asyncProgressSetStatus ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsyncProgress a) =>
    a
    -- ^ /@self@/: an t'GI.OSTree.Objects.AsyncProgress.AsyncProgress'
    -> Maybe (T.Text)
    -- ^ /@status@/: new status string, or 'P.Nothing' to clear the status
    -> m ()
asyncProgressSetStatus :: a -> Maybe Text -> m ()
asyncProgressSetStatus self :: a
self status :: Maybe Text
status = 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 AsyncProgress
self' <- a -> IO (Ptr AsyncProgress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeStatus <- case Maybe Text
status of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jStatus :: Text
jStatus -> do
            CString
jStatus' <- Text -> IO CString
textToCString Text
jStatus
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jStatus'
    Ptr AsyncProgress -> CString -> IO ()
ostree_async_progress_set_status Ptr AsyncProgress
self' CString
maybeStatus
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeStatus
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AsyncProgressSetStatusMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsAsyncProgress a) => O.MethodInfo AsyncProgressSetStatusMethodInfo a signature where
    overloadedMethod = asyncProgressSetStatus

#endif

-- method AsyncProgress::set_uint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "AsyncProgress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_async_progress_set_uint" ostree_async_progress_set_uint :: 
    Ptr AsyncProgress ->                    -- self : TInterface (Name {namespace = "OSTree", name = "AsyncProgress"})
    CString ->                              -- key : TBasicType TUTF8
    Word32 ->                               -- value : TBasicType TUInt
    IO ()

-- | /No description available in the introspection data./
asyncProgressSetUint ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsyncProgress a) =>
    a
    -> T.Text
    -> Word32
    -> m ()
asyncProgressSetUint :: a -> Text -> Word32 -> m ()
asyncProgressSetUint self :: a
self key :: Text
key value :: Word32
value = 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 AsyncProgress
self' <- a -> IO (Ptr AsyncProgress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr AsyncProgress -> CString -> Word32 -> IO ()
ostree_async_progress_set_uint Ptr AsyncProgress
self' CString
key' Word32
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AsyncProgressSetUintMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ()), MonadIO m, IsAsyncProgress a) => O.MethodInfo AsyncProgressSetUintMethodInfo a signature where
    overloadedMethod = asyncProgressSetUint

#endif

-- method AsyncProgress::set_uint64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "AsyncProgress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_async_progress_set_uint64" ostree_async_progress_set_uint64 :: 
    Ptr AsyncProgress ->                    -- self : TInterface (Name {namespace = "OSTree", name = "AsyncProgress"})
    CString ->                              -- key : TBasicType TUTF8
    Word64 ->                               -- value : TBasicType TUInt64
    IO ()

-- | /No description available in the introspection data./
asyncProgressSetUint64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsyncProgress a) =>
    a
    -> T.Text
    -> Word64
    -> m ()
asyncProgressSetUint64 :: a -> Text -> Word64 -> m ()
asyncProgressSetUint64 self :: a
self key :: Text
key value :: Word64
value = 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 AsyncProgress
self' <- a -> IO (Ptr AsyncProgress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr AsyncProgress -> CString -> Word64 -> IO ()
ostree_async_progress_set_uint64 Ptr AsyncProgress
self' CString
key' Word64
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AsyncProgressSetUint64MethodInfo
instance (signature ~ (T.Text -> Word64 -> m ()), MonadIO m, IsAsyncProgress a) => O.MethodInfo AsyncProgressSetUint64MethodInfo a signature where
    overloadedMethod = asyncProgressSetUint64

#endif

-- method AsyncProgress::set_variant
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "AsyncProgress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeAsyncProgress"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a key to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value to assign to @key"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_async_progress_set_variant" ostree_async_progress_set_variant :: 
    Ptr AsyncProgress ->                    -- self : TInterface (Name {namespace = "OSTree", name = "AsyncProgress"})
    CString ->                              -- key : TBasicType TUTF8
    Ptr GVariant ->                         -- value : TVariant
    IO ()

-- | Assign a new /@value@/ to the given /@key@/, replacing any existing value. The
-- operation is thread-safe. /@value@/ may be a floating reference;
-- 'GI.GLib.Structs.Variant.variantRefSink' will be called on it.
-- 
-- Any watchers of the t'GI.OSTree.Objects.AsyncProgress.AsyncProgress' will be notified of the change if
-- /@value@/ differs from the existing value for /@key@/.
-- 
-- /Since: 2017.6/
asyncProgressSetVariant ::
    (B.CallStack.HasCallStack, MonadIO m, IsAsyncProgress a) =>
    a
    -- ^ /@self@/: an t'GI.OSTree.Objects.AsyncProgress.AsyncProgress'
    -> T.Text
    -- ^ /@key@/: a key to set
    -> GVariant
    -- ^ /@value@/: the value to assign to /@key@/
    -> m ()
asyncProgressSetVariant :: a -> Text -> GVariant -> m ()
asyncProgressSetVariant self :: a
self key :: Text
key value :: GVariant
value = 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 AsyncProgress
self' <- a -> IO (Ptr AsyncProgress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr GVariant
value' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
value
    Ptr AsyncProgress -> CString -> Ptr GVariant -> IO ()
ostree_async_progress_set_variant Ptr AsyncProgress
self' CString
key' Ptr GVariant
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AsyncProgressSetVariantMethodInfo
instance (signature ~ (T.Text -> GVariant -> m ()), MonadIO m, IsAsyncProgress a) => O.MethodInfo AsyncProgressSetVariantMethodInfo a signature where
    overloadedMethod = asyncProgressSetVariant

#endif