{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- 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.Dazzle.Objects.TaskCache
    ( 

-- * Exported types
    TaskCache(..)                           ,
    IsTaskCache                             ,
    toTaskCache                             ,


 -- * 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"), [evict]("GI.Dazzle.Objects.TaskCache#g:method:evict"), [evictAll]("GI.Dazzle.Objects.TaskCache#g:method:evictAll"), [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"), [peek]("GI.Dazzle.Objects.TaskCache#g:method:peek"), [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
-- [getAsync]("GI.Dazzle.Objects.TaskCache#g:method:getAsync"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFinish]("GI.Dazzle.Objects.TaskCache#g:method:getFinish"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setName]("GI.Dazzle.Objects.TaskCache#g:method:setName"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveTaskCacheMethod                  ,
#endif

-- ** evict #method:evict#

#if defined(ENABLE_OVERLOADING)
    TaskCacheEvictMethodInfo                ,
#endif
    taskCacheEvict                          ,


-- ** evictAll #method:evictAll#

#if defined(ENABLE_OVERLOADING)
    TaskCacheEvictAllMethodInfo             ,
#endif
    taskCacheEvictAll                       ,


-- ** getAsync #method:getAsync#

#if defined(ENABLE_OVERLOADING)
    TaskCacheGetAsyncMethodInfo             ,
#endif
    taskCacheGetAsync                       ,


-- ** getFinish #method:getFinish#

#if defined(ENABLE_OVERLOADING)
    TaskCacheGetFinishMethodInfo            ,
#endif
    taskCacheGetFinish                      ,


-- ** peek #method:peek#

#if defined(ENABLE_OVERLOADING)
    TaskCachePeekMethodInfo                 ,
#endif
    taskCachePeek                           ,


-- ** setName #method:setName#

#if defined(ENABLE_OVERLOADING)
    TaskCacheSetNameMethodInfo              ,
#endif
    taskCacheSetName                        ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    TaskCacheKeyCopyFuncPropertyInfo        ,
#endif
    constructTaskCacheKeyCopyFunc           ,
#if defined(ENABLE_OVERLOADING)
    taskCacheKeyCopyFunc                    ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TaskCacheKeyDestroyFuncPropertyInfo     ,
#endif
    constructTaskCacheKeyDestroyFunc        ,
#if defined(ENABLE_OVERLOADING)
    taskCacheKeyDestroyFunc                 ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TaskCacheKeyEqualFuncPropertyInfo       ,
#endif
    constructTaskCacheKeyEqualFunc          ,
#if defined(ENABLE_OVERLOADING)
    taskCacheKeyEqualFunc                   ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TaskCacheKeyHashFuncPropertyInfo        ,
#endif
    constructTaskCacheKeyHashFunc           ,
#if defined(ENABLE_OVERLOADING)
    taskCacheKeyHashFunc                    ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TaskCachePopulateCallbackPropertyInfo   ,
#endif
    constructTaskCachePopulateCallback      ,
#if defined(ENABLE_OVERLOADING)
    taskCachePopulateCallback               ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TaskCachePopulateCallbackDataPropertyInfo,
#endif
    constructTaskCachePopulateCallbackData  ,
#if defined(ENABLE_OVERLOADING)
    taskCachePopulateCallbackData           ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TaskCachePopulateCallbackDataDestroyPropertyInfo,
#endif
    constructTaskCachePopulateCallbackDataDestroy,
#if defined(ENABLE_OVERLOADING)
    taskCachePopulateCallbackDataDestroy    ,
#endif


-- ** timeToLive #attr:timeToLive#
-- | This is the number of milliseconds before an item should be evicted
-- from the cache.
-- 
-- A value of zero indicates no eviction.

#if defined(ENABLE_OVERLOADING)
    TaskCacheTimeToLivePropertyInfo         ,
#endif
    constructTaskCacheTimeToLive            ,
#if defined(ENABLE_OVERLOADING)
    taskCacheTimeToLive                     ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TaskCacheValueCopyFuncPropertyInfo      ,
#endif
    constructTaskCacheValueCopyFunc         ,
#if defined(ENABLE_OVERLOADING)
    taskCacheValueCopyFunc                  ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    TaskCacheValueDestroyFuncPropertyInfo   ,
#endif
    constructTaskCacheValueDestroyFunc      ,
#if defined(ENABLE_OVERLOADING)
    taskCacheValueDestroyFunc               ,
#endif




    ) where

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

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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable

#endif

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

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

foreign import ccall "dzl_task_cache_get_type"
    c_dzl_task_cache_get_type :: IO B.Types.GType

instance B.Types.TypedObject TaskCache where
    glibType :: IO GType
glibType = IO GType
c_dzl_task_cache_get_type

instance B.Types.GObject TaskCache

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveTaskCacheMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTaskCacheMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTaskCacheMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTaskCacheMethod "evict" o = TaskCacheEvictMethodInfo
    ResolveTaskCacheMethod "evictAll" o = TaskCacheEvictAllMethodInfo
    ResolveTaskCacheMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTaskCacheMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTaskCacheMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTaskCacheMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTaskCacheMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTaskCacheMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTaskCacheMethod "peek" o = TaskCachePeekMethodInfo
    ResolveTaskCacheMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTaskCacheMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTaskCacheMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTaskCacheMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTaskCacheMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTaskCacheMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTaskCacheMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTaskCacheMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTaskCacheMethod "getAsync" o = TaskCacheGetAsyncMethodInfo
    ResolveTaskCacheMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTaskCacheMethod "getFinish" o = TaskCacheGetFinishMethodInfo
    ResolveTaskCacheMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTaskCacheMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTaskCacheMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTaskCacheMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTaskCacheMethod "setName" o = TaskCacheSetNameMethodInfo
    ResolveTaskCacheMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTaskCacheMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "key-copy-func"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@key-copy-func@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTaskCacheKeyCopyFunc :: (IsTaskCache o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructTaskCacheKeyCopyFunc :: forall o (m :: * -> *).
(IsTaskCache o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructTaskCacheKeyCopyFunc Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"key-copy-func" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data TaskCacheKeyCopyFuncPropertyInfo
instance AttrInfo TaskCacheKeyCopyFuncPropertyInfo where
    type AttrAllowedOps TaskCacheKeyCopyFuncPropertyInfo = '[ 'AttrConstruct]
    type AttrBaseTypeConstraint TaskCacheKeyCopyFuncPropertyInfo = IsTaskCache
    type AttrSetTypeConstraint TaskCacheKeyCopyFuncPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint TaskCacheKeyCopyFuncPropertyInfo = (~) (Ptr ())
    type AttrTransferType TaskCacheKeyCopyFuncPropertyInfo = Ptr ()
    type AttrGetType TaskCacheKeyCopyFuncPropertyInfo = ()
    type AttrLabel TaskCacheKeyCopyFuncPropertyInfo = "key-copy-func"
    type AttrOrigin TaskCacheKeyCopyFuncPropertyInfo = TaskCache
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTaskCacheKeyCopyFunc
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.keyCopyFunc"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#g:attr:keyCopyFunc"
        })
#endif

-- VVV Prop "key-destroy-func"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@key-destroy-func@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTaskCacheKeyDestroyFunc :: (IsTaskCache o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructTaskCacheKeyDestroyFunc :: forall o (m :: * -> *).
(IsTaskCache o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructTaskCacheKeyDestroyFunc Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"key-destroy-func" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data TaskCacheKeyDestroyFuncPropertyInfo
instance AttrInfo TaskCacheKeyDestroyFuncPropertyInfo where
    type AttrAllowedOps TaskCacheKeyDestroyFuncPropertyInfo = '[ 'AttrConstruct]
    type AttrBaseTypeConstraint TaskCacheKeyDestroyFuncPropertyInfo = IsTaskCache
    type AttrSetTypeConstraint TaskCacheKeyDestroyFuncPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint TaskCacheKeyDestroyFuncPropertyInfo = (~) (Ptr ())
    type AttrTransferType TaskCacheKeyDestroyFuncPropertyInfo = Ptr ()
    type AttrGetType TaskCacheKeyDestroyFuncPropertyInfo = ()
    type AttrLabel TaskCacheKeyDestroyFuncPropertyInfo = "key-destroy-func"
    type AttrOrigin TaskCacheKeyDestroyFuncPropertyInfo = TaskCache
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTaskCacheKeyDestroyFunc
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.keyDestroyFunc"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#g:attr:keyDestroyFunc"
        })
#endif

-- VVV Prop "key-equal-func"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@key-equal-func@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTaskCacheKeyEqualFunc :: (IsTaskCache o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructTaskCacheKeyEqualFunc :: forall o (m :: * -> *).
(IsTaskCache o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructTaskCacheKeyEqualFunc Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"key-equal-func" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data TaskCacheKeyEqualFuncPropertyInfo
instance AttrInfo TaskCacheKeyEqualFuncPropertyInfo where
    type AttrAllowedOps TaskCacheKeyEqualFuncPropertyInfo = '[ 'AttrConstruct]
    type AttrBaseTypeConstraint TaskCacheKeyEqualFuncPropertyInfo = IsTaskCache
    type AttrSetTypeConstraint TaskCacheKeyEqualFuncPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint TaskCacheKeyEqualFuncPropertyInfo = (~) (Ptr ())
    type AttrTransferType TaskCacheKeyEqualFuncPropertyInfo = Ptr ()
    type AttrGetType TaskCacheKeyEqualFuncPropertyInfo = ()
    type AttrLabel TaskCacheKeyEqualFuncPropertyInfo = "key-equal-func"
    type AttrOrigin TaskCacheKeyEqualFuncPropertyInfo = TaskCache
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTaskCacheKeyEqualFunc
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.keyEqualFunc"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#g:attr:keyEqualFunc"
        })
#endif

-- VVV Prop "key-hash-func"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@key-hash-func@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTaskCacheKeyHashFunc :: (IsTaskCache o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructTaskCacheKeyHashFunc :: forall o (m :: * -> *).
(IsTaskCache o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructTaskCacheKeyHashFunc Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"key-hash-func" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data TaskCacheKeyHashFuncPropertyInfo
instance AttrInfo TaskCacheKeyHashFuncPropertyInfo where
    type AttrAllowedOps TaskCacheKeyHashFuncPropertyInfo = '[ 'AttrConstruct]
    type AttrBaseTypeConstraint TaskCacheKeyHashFuncPropertyInfo = IsTaskCache
    type AttrSetTypeConstraint TaskCacheKeyHashFuncPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint TaskCacheKeyHashFuncPropertyInfo = (~) (Ptr ())
    type AttrTransferType TaskCacheKeyHashFuncPropertyInfo = Ptr ()
    type AttrGetType TaskCacheKeyHashFuncPropertyInfo = ()
    type AttrLabel TaskCacheKeyHashFuncPropertyInfo = "key-hash-func"
    type AttrOrigin TaskCacheKeyHashFuncPropertyInfo = TaskCache
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTaskCacheKeyHashFunc
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.keyHashFunc"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#g:attr:keyHashFunc"
        })
#endif

-- VVV Prop "populate-callback"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@populate-callback@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTaskCachePopulateCallback :: (IsTaskCache o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructTaskCachePopulateCallback :: forall o (m :: * -> *).
(IsTaskCache o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructTaskCachePopulateCallback Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"populate-callback" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data TaskCachePopulateCallbackPropertyInfo
instance AttrInfo TaskCachePopulateCallbackPropertyInfo where
    type AttrAllowedOps TaskCachePopulateCallbackPropertyInfo = '[ 'AttrConstruct]
    type AttrBaseTypeConstraint TaskCachePopulateCallbackPropertyInfo = IsTaskCache
    type AttrSetTypeConstraint TaskCachePopulateCallbackPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint TaskCachePopulateCallbackPropertyInfo = (~) (Ptr ())
    type AttrTransferType TaskCachePopulateCallbackPropertyInfo = Ptr ()
    type AttrGetType TaskCachePopulateCallbackPropertyInfo = ()
    type AttrLabel TaskCachePopulateCallbackPropertyInfo = "populate-callback"
    type AttrOrigin TaskCachePopulateCallbackPropertyInfo = TaskCache
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTaskCachePopulateCallback
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.populateCallback"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#g:attr:populateCallback"
        })
#endif

-- VVV Prop "populate-callback-data"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@populate-callback-data@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTaskCachePopulateCallbackData :: (IsTaskCache o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructTaskCachePopulateCallbackData :: forall o (m :: * -> *).
(IsTaskCache o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructTaskCachePopulateCallbackData Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"populate-callback-data" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data TaskCachePopulateCallbackDataPropertyInfo
instance AttrInfo TaskCachePopulateCallbackDataPropertyInfo where
    type AttrAllowedOps TaskCachePopulateCallbackDataPropertyInfo = '[ 'AttrConstruct]
    type AttrBaseTypeConstraint TaskCachePopulateCallbackDataPropertyInfo = IsTaskCache
    type AttrSetTypeConstraint TaskCachePopulateCallbackDataPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint TaskCachePopulateCallbackDataPropertyInfo = (~) (Ptr ())
    type AttrTransferType TaskCachePopulateCallbackDataPropertyInfo = Ptr ()
    type AttrGetType TaskCachePopulateCallbackDataPropertyInfo = ()
    type AttrLabel TaskCachePopulateCallbackDataPropertyInfo = "populate-callback-data"
    type AttrOrigin TaskCachePopulateCallbackDataPropertyInfo = TaskCache
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTaskCachePopulateCallbackData
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.populateCallbackData"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#g:attr:populateCallbackData"
        })
#endif

-- VVV Prop "populate-callback-data-destroy"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@populate-callback-data-destroy@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTaskCachePopulateCallbackDataDestroy :: (IsTaskCache o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructTaskCachePopulateCallbackDataDestroy :: forall o (m :: * -> *).
(IsTaskCache o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructTaskCachePopulateCallbackDataDestroy Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"populate-callback-data-destroy" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data TaskCachePopulateCallbackDataDestroyPropertyInfo
instance AttrInfo TaskCachePopulateCallbackDataDestroyPropertyInfo where
    type AttrAllowedOps TaskCachePopulateCallbackDataDestroyPropertyInfo = '[ 'AttrConstruct]
    type AttrBaseTypeConstraint TaskCachePopulateCallbackDataDestroyPropertyInfo = IsTaskCache
    type AttrSetTypeConstraint TaskCachePopulateCallbackDataDestroyPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint TaskCachePopulateCallbackDataDestroyPropertyInfo = (~) (Ptr ())
    type AttrTransferType TaskCachePopulateCallbackDataDestroyPropertyInfo = Ptr ()
    type AttrGetType TaskCachePopulateCallbackDataDestroyPropertyInfo = ()
    type AttrLabel TaskCachePopulateCallbackDataDestroyPropertyInfo = "populate-callback-data-destroy"
    type AttrOrigin TaskCachePopulateCallbackDataDestroyPropertyInfo = TaskCache
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTaskCachePopulateCallbackDataDestroy
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.populateCallbackDataDestroy"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#g:attr:populateCallbackDataDestroy"
        })
#endif

-- VVV Prop "time-to-live"
   -- Type: TBasicType TInt64
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@time-to-live@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTaskCacheTimeToLive :: (IsTaskCache o, MIO.MonadIO m) => Int64 -> m (GValueConstruct o)
constructTaskCacheTimeToLive :: forall o (m :: * -> *).
(IsTaskCache o, MonadIO m) =>
Int64 -> m (GValueConstruct o)
constructTaskCacheTimeToLive Int64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int64 -> IO (GValueConstruct o)
forall o. String -> Int64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt64 String
"time-to-live" Int64
val

#if defined(ENABLE_OVERLOADING)
data TaskCacheTimeToLivePropertyInfo
instance AttrInfo TaskCacheTimeToLivePropertyInfo where
    type AttrAllowedOps TaskCacheTimeToLivePropertyInfo = '[ 'AttrConstruct]
    type AttrBaseTypeConstraint TaskCacheTimeToLivePropertyInfo = IsTaskCache
    type AttrSetTypeConstraint TaskCacheTimeToLivePropertyInfo = (~) Int64
    type AttrTransferTypeConstraint TaskCacheTimeToLivePropertyInfo = (~) Int64
    type AttrTransferType TaskCacheTimeToLivePropertyInfo = Int64
    type AttrGetType TaskCacheTimeToLivePropertyInfo = ()
    type AttrLabel TaskCacheTimeToLivePropertyInfo = "time-to-live"
    type AttrOrigin TaskCacheTimeToLivePropertyInfo = TaskCache
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTaskCacheTimeToLive
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.timeToLive"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#g:attr:timeToLive"
        })
#endif

-- VVV Prop "value-copy-func"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@value-copy-func@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTaskCacheValueCopyFunc :: (IsTaskCache o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructTaskCacheValueCopyFunc :: forall o (m :: * -> *).
(IsTaskCache o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructTaskCacheValueCopyFunc Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"value-copy-func" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data TaskCacheValueCopyFuncPropertyInfo
instance AttrInfo TaskCacheValueCopyFuncPropertyInfo where
    type AttrAllowedOps TaskCacheValueCopyFuncPropertyInfo = '[ 'AttrConstruct]
    type AttrBaseTypeConstraint TaskCacheValueCopyFuncPropertyInfo = IsTaskCache
    type AttrSetTypeConstraint TaskCacheValueCopyFuncPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint TaskCacheValueCopyFuncPropertyInfo = (~) (Ptr ())
    type AttrTransferType TaskCacheValueCopyFuncPropertyInfo = Ptr ()
    type AttrGetType TaskCacheValueCopyFuncPropertyInfo = ()
    type AttrLabel TaskCacheValueCopyFuncPropertyInfo = "value-copy-func"
    type AttrOrigin TaskCacheValueCopyFuncPropertyInfo = TaskCache
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTaskCacheValueCopyFunc
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.valueCopyFunc"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#g:attr:valueCopyFunc"
        })
#endif

-- VVV Prop "value-destroy-func"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@value-destroy-func@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTaskCacheValueDestroyFunc :: (IsTaskCache o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructTaskCacheValueDestroyFunc :: forall o (m :: * -> *).
(IsTaskCache o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructTaskCacheValueDestroyFunc Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"value-destroy-func" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data TaskCacheValueDestroyFuncPropertyInfo
instance AttrInfo TaskCacheValueDestroyFuncPropertyInfo where
    type AttrAllowedOps TaskCacheValueDestroyFuncPropertyInfo = '[ 'AttrConstruct]
    type AttrBaseTypeConstraint TaskCacheValueDestroyFuncPropertyInfo = IsTaskCache
    type AttrSetTypeConstraint TaskCacheValueDestroyFuncPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint TaskCacheValueDestroyFuncPropertyInfo = (~) (Ptr ())
    type AttrTransferType TaskCacheValueDestroyFuncPropertyInfo = Ptr ()
    type AttrGetType TaskCacheValueDestroyFuncPropertyInfo = ()
    type AttrLabel TaskCacheValueDestroyFuncPropertyInfo = "value-destroy-func"
    type AttrOrigin TaskCacheValueDestroyFuncPropertyInfo = TaskCache
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTaskCacheValueDestroyFunc
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.valueDestroyFunc"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#g:attr:valueDestroyFunc"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TaskCache
type instance O.AttributeList TaskCache = TaskCacheAttributeList
type TaskCacheAttributeList = ('[ '("keyCopyFunc", TaskCacheKeyCopyFuncPropertyInfo), '("keyDestroyFunc", TaskCacheKeyDestroyFuncPropertyInfo), '("keyEqualFunc", TaskCacheKeyEqualFuncPropertyInfo), '("keyHashFunc", TaskCacheKeyHashFuncPropertyInfo), '("populateCallback", TaskCachePopulateCallbackPropertyInfo), '("populateCallbackData", TaskCachePopulateCallbackDataPropertyInfo), '("populateCallbackDataDestroy", TaskCachePopulateCallbackDataDestroyPropertyInfo), '("timeToLive", TaskCacheTimeToLivePropertyInfo), '("valueCopyFunc", TaskCacheValueCopyFuncPropertyInfo), '("valueDestroyFunc", TaskCacheValueDestroyFuncPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
taskCacheKeyCopyFunc :: AttrLabelProxy "keyCopyFunc"
taskCacheKeyCopyFunc = AttrLabelProxy

taskCacheKeyDestroyFunc :: AttrLabelProxy "keyDestroyFunc"
taskCacheKeyDestroyFunc = AttrLabelProxy

taskCacheKeyEqualFunc :: AttrLabelProxy "keyEqualFunc"
taskCacheKeyEqualFunc = AttrLabelProxy

taskCacheKeyHashFunc :: AttrLabelProxy "keyHashFunc"
taskCacheKeyHashFunc = AttrLabelProxy

taskCachePopulateCallback :: AttrLabelProxy "populateCallback"
taskCachePopulateCallback = AttrLabelProxy

taskCachePopulateCallbackData :: AttrLabelProxy "populateCallbackData"
taskCachePopulateCallbackData = AttrLabelProxy

taskCachePopulateCallbackDataDestroy :: AttrLabelProxy "populateCallbackDataDestroy"
taskCachePopulateCallbackDataDestroy = AttrLabelProxy

taskCacheTimeToLive :: AttrLabelProxy "timeToLive"
taskCacheTimeToLive = AttrLabelProxy

taskCacheValueCopyFunc :: AttrLabelProxy "valueCopyFunc"
taskCacheValueCopyFunc = AttrLabelProxy

taskCacheValueDestroyFunc :: AttrLabelProxy "valueDestroyFunc"
taskCacheValueDestroyFunc = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList TaskCache = TaskCacheSignalList
type TaskCacheSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

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

foreign import ccall "dzl_task_cache_evict" dzl_task_cache_evict :: 
    Ptr TaskCache ->                        -- self : TInterface (Name {namespace = "Dazzle", name = "TaskCache"})
    Ptr () ->                               -- key : TBasicType TPtr
    IO CInt

-- | /No description available in the introspection data./
taskCacheEvict ::
    (B.CallStack.HasCallStack, MonadIO m, IsTaskCache a) =>
    a
    -> Ptr ()
    -> m Bool
taskCacheEvict :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTaskCache a) =>
a -> Ptr () -> m Bool
taskCacheEvict a
self Ptr ()
key = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr TaskCache
self' <- a -> IO (Ptr TaskCache)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr TaskCache -> Ptr () -> IO CInt
dzl_task_cache_evict Ptr TaskCache
self' Ptr ()
key
    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
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

instance O.OverloadedMethodInfo TaskCacheEvictMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.taskCacheEvict",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#v:taskCacheEvict"
        })


#endif

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

foreign import ccall "dzl_task_cache_evict_all" dzl_task_cache_evict_all :: 
    Ptr TaskCache ->                        -- self : TInterface (Name {namespace = "Dazzle", name = "TaskCache"})
    IO ()

-- | /No description available in the introspection data./
taskCacheEvictAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsTaskCache a) =>
    a
    -> m ()
taskCacheEvictAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTaskCache a) =>
a -> m ()
taskCacheEvictAll a
self = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TaskCache
self' <- a -> IO (Ptr TaskCache)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TaskCache -> IO ()
dzl_task_cache_evict_all Ptr TaskCache
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TaskCacheEvictAllMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTaskCache a) => O.OverloadedMethod TaskCacheEvictAllMethodInfo a signature where
    overloadedMethod = taskCacheEvictAll

instance O.OverloadedMethodInfo TaskCacheEvictAllMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.taskCacheEvictAll",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#v:taskCacheEvictAll"
        })


#endif

-- method TaskCache::get_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "TaskCache" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "force_update"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_task_cache_get_async" dzl_task_cache_get_async :: 
    Ptr TaskCache ->                        -- self : TInterface (Name {namespace = "Dazzle", name = "TaskCache"})
    Ptr () ->                               -- key : TBasicType TPtr
    CInt ->                                 -- force_update : TBasicType TBoolean
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | /No description available in the introspection data./
taskCacheGetAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsTaskCache a, Gio.Cancellable.IsCancellable b) =>
    a
    -> Ptr ()
    -> Bool
    -> Maybe (b)
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -> m ()
taskCacheGetAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTaskCache a, IsCancellable b) =>
a -> Ptr () -> Bool -> Maybe b -> Maybe AsyncReadyCallback -> m ()
taskCacheGetAsync a
self Ptr ()
key Bool
forceUpdate Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TaskCache
self' <- a -> IO (Ptr TaskCache)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let forceUpdate' :: CInt
forceUpdate' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
forceUpdate
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr TaskCache
-> Ptr ()
-> CInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
dzl_task_cache_get_async Ptr TaskCache
self' Ptr ()
key CInt
forceUpdate' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TaskCacheGetAsyncMethodInfo
instance (signature ~ (Ptr () -> Bool -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsTaskCache a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod TaskCacheGetAsyncMethodInfo a signature where
    overloadedMethod = taskCacheGetAsync

instance O.OverloadedMethodInfo TaskCacheGetAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.taskCacheGetAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#v:taskCacheGetAsync"
        })


#endif

-- method TaskCache::get_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "TaskCache" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : True
-- Skip return : False

foreign import ccall "dzl_task_cache_get_finish" dzl_task_cache_get_finish :: 
    Ptr TaskCache ->                        -- self : TInterface (Name {namespace = "Dazzle", name = "TaskCache"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr ())

-- | Finish a call to 'GI.Dazzle.Objects.TaskCache.taskCacheGetAsync'.
taskCacheGetFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsTaskCache a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -> b
    -> m (Ptr ())
    -- ^ __Returns:__ The result from the cache. /(Can throw 'Data.GI.Base.GError.GError')/
taskCacheGetFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTaskCache a, IsAsyncResult b) =>
a -> b -> m (Ptr ())
taskCacheGetFinish a
self b
result_ = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
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 TaskCache
self' <- a -> IO (Ptr TaskCache)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO (Ptr ()) -> IO () -> IO (Ptr ())
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr ()
result <- (Ptr (Ptr GError) -> IO (Ptr ())) -> IO (Ptr ())
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr (Ptr GError) -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Ptr TaskCache -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr ())
dzl_task_cache_get_finish Ptr TaskCache
self' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data TaskCacheGetFinishMethodInfo
instance (signature ~ (b -> m (Ptr ())), MonadIO m, IsTaskCache a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod TaskCacheGetFinishMethodInfo a signature where
    overloadedMethod = taskCacheGetFinish

instance O.OverloadedMethodInfo TaskCacheGetFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.taskCacheGetFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#v:taskCacheGetFinish"
        })


#endif

-- method TaskCache::peek
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "TaskCache" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #DzlTaskCache" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The key for the cache"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GObject" , name = "Object" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_task_cache_peek" dzl_task_cache_peek :: 
    Ptr TaskCache ->                        -- self : TInterface (Name {namespace = "Dazzle", name = "TaskCache"})
    Ptr () ->                               -- key : TBasicType TPtr
    IO (Ptr GObject.Object.Object)

-- | Peeks to see /@key@/ is contained in the cache and returns the
-- matching t'GI.GObject.Objects.Object.Object' if it does.
-- 
-- The reference count of the resulting t'GI.GObject.Objects.Object.Object' is not incremented.
-- For that reason, it is important to remember that this function
-- may only be called from the main thread.
taskCachePeek ::
    (B.CallStack.HasCallStack, MonadIO m, IsTaskCache a) =>
    a
    -- ^ /@self@/: An t'GI.Dazzle.Objects.TaskCache.TaskCache'
    -> Ptr ()
    -- ^ /@key@/: The key for the cache
    -> m (Maybe GObject.Object.Object)
    -- ^ __Returns:__ A t'GI.GObject.Objects.Object.Object' or
    --   'P.Nothing' if the key was not found in the cache.
taskCachePeek :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTaskCache a) =>
a -> Ptr () -> m (Maybe Object)
taskCachePeek a
self Ptr ()
key = IO (Maybe Object) -> m (Maybe Object)
forall a. IO a -> m a
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 TaskCache
self' <- a -> IO (Ptr TaskCache)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Object
result <- Ptr TaskCache -> Ptr () -> IO (Ptr Object)
dzl_task_cache_peek Ptr TaskCache
self' Ptr ()
key
    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
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
result'
        Object -> IO Object
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Object -> IO (Maybe Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Object
maybeResult

#if defined(ENABLE_OVERLOADING)
data TaskCachePeekMethodInfo
instance (signature ~ (Ptr () -> m (Maybe GObject.Object.Object)), MonadIO m, IsTaskCache a) => O.OverloadedMethod TaskCachePeekMethodInfo a signature where
    overloadedMethod = taskCachePeek

instance O.OverloadedMethodInfo TaskCachePeekMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.taskCachePeek",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#v:taskCachePeek"
        })


#endif

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

foreign import ccall "dzl_task_cache_set_name" dzl_task_cache_set_name :: 
    Ptr TaskCache ->                        -- self : TInterface (Name {namespace = "Dazzle", name = "TaskCache"})
    CString ->                              -- name : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
taskCacheSetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsTaskCache a) =>
    a
    -> T.Text
    -> m ()
taskCacheSetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTaskCache a) =>
a -> Text -> m ()
taskCacheSetName a
self Text
name = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TaskCache
self' <- a -> IO (Ptr TaskCache)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr TaskCache -> CString -> IO ()
dzl_task_cache_set_name Ptr TaskCache
self' CString
name'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TaskCacheSetNameMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsTaskCache a) => O.OverloadedMethod TaskCacheSetNameMethodInfo a signature where
    overloadedMethod = taskCacheSetName

instance O.OverloadedMethodInfo TaskCacheSetNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.TaskCache.taskCacheSetName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-TaskCache.html#v:taskCacheSetName"
        })


#endif