{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @GCache@ allows sharing of complex data structures, in order to
-- save system resources.
-- 
-- @GCache@ uses keys and values. A @GCache@ key describes the properties
-- of a particular resource. A @GCache@ value is the actual resource.
-- 
-- @GCache@ has been marked as deprecated, since this API is rarely
-- used and not very actively maintained.

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

module GI.GLib.Structs.Cache
    ( 

-- * Exported types
    Cache(..)                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [destroy]("GI.GLib.Structs.Cache#g:method:destroy"), [insert]("GI.GLib.Structs.Cache#g:method:insert"), [keyForeach]("GI.GLib.Structs.Cache#g:method:keyForeach"), [remove]("GI.GLib.Structs.Cache#g:method:remove"), [valueForeach]("GI.GLib.Structs.Cache#g:method:valueForeach").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveCacheMethod                      ,
#endif

-- ** destroy #method:destroy#

#if defined(ENABLE_OVERLOADING)
    CacheDestroyMethodInfo                  ,
#endif
    cacheDestroy                            ,


-- ** insert #method:insert#

#if defined(ENABLE_OVERLOADING)
    CacheInsertMethodInfo                   ,
#endif
    cacheInsert                             ,


-- ** keyForeach #method:keyForeach#

#if defined(ENABLE_OVERLOADING)
    CacheKeyForeachMethodInfo               ,
#endif
    cacheKeyForeach                         ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    CacheRemoveMethodInfo                   ,
#endif
    cacheRemove                             ,


-- ** valueForeach #method:valueForeach#

#if defined(ENABLE_OVERLOADING)
    CacheValueForeachMethodInfo             ,
#endif
    cacheValueForeach                       ,




    ) 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.GLib.Callbacks as GLib.Callbacks

#else
import qualified GI.GLib.Callbacks as GLib.Callbacks

#endif

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

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

-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr Cache where
    boxedPtrCopy :: Cache -> IO Cache
boxedPtrCopy = Cache -> IO Cache
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: Cache -> IO ()
boxedPtrFree = \Cache
_x -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Cache
type instance O.AttributeList Cache = CacheAttributeList
type CacheAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method Cache::destroy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cache"
--           , argType = TInterface Name { namespace = "GLib" , name = "Cache" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCache" , 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 "g_cache_destroy" g_cache_destroy :: 
    Ptr Cache ->                            -- cache : TInterface (Name {namespace = "GLib", name = "Cache"})
    IO ()

{-# DEPRECATED cacheDestroy ["(Since version 2.32)","Use a t'GI.GLib.Structs.HashTable.HashTable' instead"] #-}
-- | Frees the memory allocated for the t'GI.GLib.Structs.Cache.Cache'.
-- 
-- Note that it does not destroy the keys and values which were
-- contained in the t'GI.GLib.Structs.Cache.Cache'.
cacheDestroy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cache
    -- ^ /@cache@/: a t'GI.GLib.Structs.Cache.Cache'
    -> m ()
cacheDestroy :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Cache -> m ()
cacheDestroy Cache
cache = 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 Cache
cache' <- Cache -> IO (Ptr Cache)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cache
cache
    Ptr Cache -> IO ()
g_cache_destroy Ptr Cache
cache'
    Cache -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cache
cache
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CacheDestroyMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod CacheDestroyMethodInfo Cache signature where
    overloadedMethod = cacheDestroy

instance O.OverloadedMethodInfo CacheDestroyMethodInfo Cache where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Cache.cacheDestroy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Cache.html#v:cacheDestroy"
        })


#endif

-- method Cache::insert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cache"
--           , argType = TInterface Name { namespace = "GLib" , name = "Cache" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCache" , 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 "a key describing a #GCache object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "g_cache_insert" g_cache_insert :: 
    Ptr Cache ->                            -- cache : TInterface (Name {namespace = "GLib", name = "Cache"})
    Ptr () ->                               -- key : TBasicType TPtr
    IO (Ptr ())

{-# DEPRECATED cacheInsert ["(Since version 2.32)","Use a t'GI.GLib.Structs.HashTable.HashTable' instead"] #-}
-- | Gets the value corresponding to the given key, creating it if
-- necessary. It first checks if the value already exists in the
-- t'GI.GLib.Structs.Cache.Cache', by using the /@keyEqualFunc@/ function passed to
-- @/g_cache_new()/@. If it does already exist it is returned, and its
-- reference count is increased by one. If the value does not currently
-- exist, if is created by calling the /@valueNewFunc@/. The key is
-- duplicated by calling /@keyDupFunc@/ and the duplicated key and value
-- are inserted into the t'GI.GLib.Structs.Cache.Cache'.
cacheInsert ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cache
    -- ^ /@cache@/: a t'GI.GLib.Structs.Cache.Cache'
    -> Ptr ()
    -- ^ /@key@/: a key describing a t'GI.GLib.Structs.Cache.Cache' object
    -> m (Ptr ())
    -- ^ __Returns:__ a pointer to a t'GI.GLib.Structs.Cache.Cache' value
cacheInsert :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cache -> Ptr () -> m (Ptr ())
cacheInsert Cache
cache Ptr ()
key = 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 Cache
cache' <- Cache -> IO (Ptr Cache)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cache
cache
    Ptr ()
result <- Ptr Cache -> Ptr () -> IO (Ptr ())
g_cache_insert Ptr Cache
cache' Ptr ()
key
    Cache -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cache
cache
    Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data CacheInsertMethodInfo
instance (signature ~ (Ptr () -> m (Ptr ())), MonadIO m) => O.OverloadedMethod CacheInsertMethodInfo Cache signature where
    overloadedMethod = cacheInsert

instance O.OverloadedMethodInfo CacheInsertMethodInfo Cache where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Cache.cacheInsert",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Cache.html#v:cacheInsert"
        })


#endif

-- method Cache::key_foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cache"
--           , argType = TInterface Name { namespace = "GLib" , name = "Cache" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCache" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType = TInterface Name { namespace = "GLib" , name = "HFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the function to call with each #GCache key"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to the function"
--                 , 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 "g_cache_key_foreach" g_cache_key_foreach :: 
    Ptr Cache ->                            -- cache : TInterface (Name {namespace = "GLib", name = "Cache"})
    FunPtr GLib.Callbacks.C_HFunc ->        -- func : TInterface (Name {namespace = "GLib", name = "HFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

{-# DEPRECATED cacheKeyForeach ["(Since version 2.32)","Use a t'GI.GLib.Structs.HashTable.HashTable' instead"] #-}
-- | Calls the given function for each of the keys in the t'GI.GLib.Structs.Cache.Cache'.
-- 
-- NOTE /@func@/ is passed three parameters, the value and key of a cache
-- entry and the /@userData@/. The order of value and key is different
-- from the order in which 'GI.GLib.Functions.hashTableForeach' passes key-value
-- pairs to its callback function !
cacheKeyForeach ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cache
    -- ^ /@cache@/: a t'GI.GLib.Structs.Cache.Cache'
    -> GLib.Callbacks.HFunc
    -- ^ /@func@/: the function to call with each t'GI.GLib.Structs.Cache.Cache' key
    -> m ()
cacheKeyForeach :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cache -> HFunc -> m ()
cacheKeyForeach Cache
cache HFunc
func = 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 Cache
cache' <- Cache -> IO (Ptr Cache)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cache
cache
    FunPtr C_HFunc
func' <- C_HFunc -> IO (FunPtr C_HFunc)
GLib.Callbacks.mk_HFunc (Maybe (Ptr (FunPtr C_HFunc)) -> C_HFunc -> C_HFunc
GLib.Callbacks.wrap_HFunc Maybe (Ptr (FunPtr C_HFunc))
forall a. Maybe a
Nothing (HFunc -> C_HFunc
GLib.Callbacks.drop_closures_HFunc HFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Cache -> FunPtr C_HFunc -> Ptr () -> IO ()
g_cache_key_foreach Ptr Cache
cache' FunPtr C_HFunc
func' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_HFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_HFunc
func'
    Cache -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cache
cache
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CacheKeyForeachMethodInfo
instance (signature ~ (GLib.Callbacks.HFunc -> m ()), MonadIO m) => O.OverloadedMethod CacheKeyForeachMethodInfo Cache signature where
    overloadedMethod = cacheKeyForeach

instance O.OverloadedMethodInfo CacheKeyForeachMethodInfo Cache where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Cache.cacheKeyForeach",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Cache.html#v:cacheKeyForeach"
        })


#endif

-- method Cache::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cache"
--           , argType = TInterface Name { namespace = "GLib" , name = "Cache" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCache" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value to remove"
--                 , 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 "g_cache_remove" g_cache_remove :: 
    Ptr Cache ->                            -- cache : TInterface (Name {namespace = "GLib", name = "Cache"})
    Ptr () ->                               -- value : TBasicType TPtr
    IO ()

{-# DEPRECATED cacheRemove ["(Since version 2.32)","Use a t'GI.GLib.Structs.HashTable.HashTable' instead"] #-}
-- | Decreases the reference count of the given value. If it drops to 0
-- then the value and its corresponding key are destroyed, using the
-- /@valueDestroyFunc@/ and /@keyDestroyFunc@/ passed to @/g_cache_new()/@.
cacheRemove ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cache
    -- ^ /@cache@/: a t'GI.GLib.Structs.Cache.Cache'
    -> Ptr ()
    -- ^ /@value@/: the value to remove
    -> m ()
cacheRemove :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cache -> Ptr () -> m ()
cacheRemove Cache
cache Ptr ()
value = 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 Cache
cache' <- Cache -> IO (Ptr Cache)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cache
cache
    Ptr Cache -> Ptr () -> IO ()
g_cache_remove Ptr Cache
cache' Ptr ()
value
    Cache -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cache
cache
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CacheRemoveMethodInfo
instance (signature ~ (Ptr () -> m ()), MonadIO m) => O.OverloadedMethod CacheRemoveMethodInfo Cache signature where
    overloadedMethod = cacheRemove

instance O.OverloadedMethodInfo CacheRemoveMethodInfo Cache where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Cache.cacheRemove",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Cache.html#v:cacheRemove"
        })


#endif

-- method Cache::value_foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cache"
--           , argType = TInterface Name { namespace = "GLib" , name = "Cache" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCache" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType = TInterface Name { namespace = "GLib" , name = "HFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the function to call with each #GCache value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to the function"
--                 , 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 "g_cache_value_foreach" g_cache_value_foreach :: 
    Ptr Cache ->                            -- cache : TInterface (Name {namespace = "GLib", name = "Cache"})
    FunPtr GLib.Callbacks.C_HFunc ->        -- func : TInterface (Name {namespace = "GLib", name = "HFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

{-# DEPRECATED cacheValueForeach ["(Since version 2.10)","The reason is that it passes pointers to internal","   data structures to /@func@/; use 'GI.GLib.Structs.Cache.cacheKeyForeach' instead"] #-}
-- | Calls the given function for each of the values in the t'GI.GLib.Structs.Cache.Cache'.
cacheValueForeach ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cache
    -- ^ /@cache@/: a t'GI.GLib.Structs.Cache.Cache'
    -> GLib.Callbacks.HFunc
    -- ^ /@func@/: the function to call with each t'GI.GLib.Structs.Cache.Cache' value
    -> m ()
cacheValueForeach :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cache -> HFunc -> m ()
cacheValueForeach Cache
cache HFunc
func = 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 Cache
cache' <- Cache -> IO (Ptr Cache)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cache
cache
    FunPtr C_HFunc
func' <- C_HFunc -> IO (FunPtr C_HFunc)
GLib.Callbacks.mk_HFunc (Maybe (Ptr (FunPtr C_HFunc)) -> C_HFunc -> C_HFunc
GLib.Callbacks.wrap_HFunc Maybe (Ptr (FunPtr C_HFunc))
forall a. Maybe a
Nothing (HFunc -> C_HFunc
GLib.Callbacks.drop_closures_HFunc HFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Cache -> FunPtr C_HFunc -> Ptr () -> IO ()
g_cache_value_foreach Ptr Cache
cache' FunPtr C_HFunc
func' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_HFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_HFunc
func'
    Cache -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cache
cache
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CacheValueForeachMethodInfo
instance (signature ~ (GLib.Callbacks.HFunc -> m ()), MonadIO m) => O.OverloadedMethod CacheValueForeachMethodInfo Cache signature where
    overloadedMethod = cacheValueForeach

instance O.OverloadedMethodInfo CacheValueForeachMethodInfo Cache where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Cache.cacheValueForeach",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Cache.html#v:cacheValueForeach"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveCacheMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveCacheMethod "destroy" o = CacheDestroyMethodInfo
    ResolveCacheMethod "insert" o = CacheInsertMethodInfo
    ResolveCacheMethod "keyForeach" o = CacheKeyForeachMethodInfo
    ResolveCacheMethod "remove" o = CacheRemoveMethodInfo
    ResolveCacheMethod "valueForeach" o = CacheValueForeachMethodInfo
    ResolveCacheMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif