{-# LANGUAGE TypeApplications #-}


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

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

module GI.Soup.Objects.Cache
    ( 

-- * Exported types
    Cache(..)                               ,
    IsCache                                 ,
    toCache                                 ,
    noCache                                 ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveCacheMethod                      ,
#endif


-- ** clear #method:clear#

#if defined(ENABLE_OVERLOADING)
    CacheClearMethodInfo                    ,
#endif
    cacheClear                              ,


-- ** dump #method:dump#

#if defined(ENABLE_OVERLOADING)
    CacheDumpMethodInfo                     ,
#endif
    cacheDump                               ,


-- ** flush #method:flush#

#if defined(ENABLE_OVERLOADING)
    CacheFlushMethodInfo                    ,
#endif
    cacheFlush                              ,


-- ** getMaxSize #method:getMaxSize#

#if defined(ENABLE_OVERLOADING)
    CacheGetMaxSizeMethodInfo               ,
#endif
    cacheGetMaxSize                         ,


-- ** load #method:load#

#if defined(ENABLE_OVERLOADING)
    CacheLoadMethodInfo                     ,
#endif
    cacheLoad                               ,


-- ** new #method:new#

    cacheNew                                ,


-- ** setMaxSize #method:setMaxSize#

#if defined(ENABLE_OVERLOADING)
    CacheSetMaxSizeMethodInfo               ,
#endif
    cacheSetMaxSize                         ,




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

#if defined(ENABLE_OVERLOADING)
    CacheCacheDirPropertyInfo               ,
#endif
#if defined(ENABLE_OVERLOADING)
    cacheCacheDir                           ,
#endif
    constructCacheCacheDir                  ,
    getCacheCacheDir                        ,


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

#if defined(ENABLE_OVERLOADING)
    CacheCacheTypePropertyInfo              ,
#endif
#if defined(ENABLE_OVERLOADING)
    cacheCacheType                          ,
#endif
    constructCacheCacheType                 ,
    getCacheCacheType                       ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Soup.Enums as Soup.Enums
import {-# SOURCE #-} qualified GI.Soup.Interfaces.SessionFeature as Soup.SessionFeature

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

instance GObject Cache where
    gobjectType :: IO GType
gobjectType = IO GType
c_soup_cache_get_type
    

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

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

instance O.HasParentTypes Cache
type instance O.ParentTypes Cache = '[GObject.Object.Object, Soup.SessionFeature.SessionFeature]

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

-- | A convenience alias for `Nothing` :: `Maybe` `Cache`.
noCache :: Maybe Cache
noCache :: Maybe Cache
noCache = Maybe Cache
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveCacheMethod (t :: Symbol) (o :: *) :: * where
    ResolveCacheMethod "addFeature" o = Soup.SessionFeature.SessionFeatureAddFeatureMethodInfo
    ResolveCacheMethod "attach" o = Soup.SessionFeature.SessionFeatureAttachMethodInfo
    ResolveCacheMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveCacheMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveCacheMethod "clear" o = CacheClearMethodInfo
    ResolveCacheMethod "detach" o = Soup.SessionFeature.SessionFeatureDetachMethodInfo
    ResolveCacheMethod "dump" o = CacheDumpMethodInfo
    ResolveCacheMethod "flush" o = CacheFlushMethodInfo
    ResolveCacheMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveCacheMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveCacheMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveCacheMethod "hasFeature" o = Soup.SessionFeature.SessionFeatureHasFeatureMethodInfo
    ResolveCacheMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveCacheMethod "load" o = CacheLoadMethodInfo
    ResolveCacheMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveCacheMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveCacheMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveCacheMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveCacheMethod "removeFeature" o = Soup.SessionFeature.SessionFeatureRemoveFeatureMethodInfo
    ResolveCacheMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveCacheMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveCacheMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveCacheMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveCacheMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveCacheMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveCacheMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveCacheMethod "getMaxSize" o = CacheGetMaxSizeMethodInfo
    ResolveCacheMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveCacheMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveCacheMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveCacheMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveCacheMethod "setMaxSize" o = CacheSetMaxSizeMethodInfo
    ResolveCacheMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveCacheMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveCacheMethod t Cache, O.MethodInfo 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

#endif

-- VVV Prop "cache-dir"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@cache-dir@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cache #cacheDir
-- @
getCacheCacheDir :: (MonadIO m, IsCache o) => o -> m (Maybe T.Text)
getCacheCacheDir :: o -> m (Maybe Text)
getCacheCacheDir obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "cache-dir"

-- | Construct a `GValueConstruct` with valid value for the “@cache-dir@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCacheCacheDir :: (IsCache o) => T.Text -> IO (GValueConstruct o)
constructCacheCacheDir :: Text -> IO (GValueConstruct o)
constructCacheCacheDir val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "cache-dir" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

#if defined(ENABLE_OVERLOADING)
data CacheCacheDirPropertyInfo
instance AttrInfo CacheCacheDirPropertyInfo where
    type AttrAllowedOps CacheCacheDirPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint CacheCacheDirPropertyInfo = IsCache
    type AttrSetTypeConstraint CacheCacheDirPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint CacheCacheDirPropertyInfo = (~) T.Text
    type AttrTransferType CacheCacheDirPropertyInfo = T.Text
    type AttrGetType CacheCacheDirPropertyInfo = (Maybe T.Text)
    type AttrLabel CacheCacheDirPropertyInfo = "cache-dir"
    type AttrOrigin CacheCacheDirPropertyInfo = Cache
    attrGet = getCacheCacheDir
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructCacheCacheDir
    attrClear = undefined
#endif

-- VVV Prop "cache-type"
   -- Type: TInterface (Name {namespace = "Soup", name = "CacheType"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@cache-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cache #cacheType
-- @
getCacheCacheType :: (MonadIO m, IsCache o) => o -> m Soup.Enums.CacheType
getCacheCacheType :: o -> m CacheType
getCacheCacheType obj :: o
obj = IO CacheType -> m CacheType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CacheType -> m CacheType) -> IO CacheType -> m CacheType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO CacheType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "cache-type"

-- | Construct a `GValueConstruct` with valid value for the “@cache-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCacheCacheType :: (IsCache o) => Soup.Enums.CacheType -> IO (GValueConstruct o)
constructCacheCacheType :: CacheType -> IO (GValueConstruct o)
constructCacheCacheType val :: CacheType
val = String -> CacheType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum "cache-type" CacheType
val

#if defined(ENABLE_OVERLOADING)
data CacheCacheTypePropertyInfo
instance AttrInfo CacheCacheTypePropertyInfo where
    type AttrAllowedOps CacheCacheTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CacheCacheTypePropertyInfo = IsCache
    type AttrSetTypeConstraint CacheCacheTypePropertyInfo = (~) Soup.Enums.CacheType
    type AttrTransferTypeConstraint CacheCacheTypePropertyInfo = (~) Soup.Enums.CacheType
    type AttrTransferType CacheCacheTypePropertyInfo = Soup.Enums.CacheType
    type AttrGetType CacheCacheTypePropertyInfo = Soup.Enums.CacheType
    type AttrLabel CacheCacheTypePropertyInfo = "cache-type"
    type AttrOrigin CacheCacheTypePropertyInfo = Cache
    attrGet = getCacheCacheType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructCacheCacheType
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Cache
type instance O.AttributeList Cache = CacheAttributeList
type CacheAttributeList = ('[ '("cacheDir", CacheCacheDirPropertyInfo), '("cacheType", CacheCacheTypePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
cacheCacheDir :: AttrLabelProxy "cacheDir"
cacheCacheDir = AttrLabelProxy

cacheCacheType :: AttrLabelProxy "cacheType"
cacheCacheType = AttrLabelProxy

#endif

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

#endif

-- method Cache::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "cache_dir"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the directory to store the cached data, or %NULL\n  to use the default one. Note that since the cache isn't safe to access for\n  multiple processes at once, and the default directory isn't namespaced by\n  process, clients are strongly discouraged from passing %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cache_type"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "CacheType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #SoupCacheType of the cache"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Cache" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_cache_new" soup_cache_new :: 
    CString ->                              -- cache_dir : TBasicType TUTF8
    CUInt ->                                -- cache_type : TInterface (Name {namespace = "Soup", name = "CacheType"})
    IO (Ptr Cache)

-- | Creates a new t'GI.Soup.Objects.Cache.Cache'.
-- 
-- /Since: 2.34/
cacheNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@cacheDir@/: the directory to store the cached data, or 'P.Nothing'
    --   to use the default one. Note that since the cache isn\'t safe to access for
    --   multiple processes at once, and the default directory isn\'t namespaced by
    --   process, clients are strongly discouraged from passing 'P.Nothing'.
    -> Soup.Enums.CacheType
    -- ^ /@cacheType@/: the t'GI.Soup.Enums.CacheType' of the cache
    -> m Cache
    -- ^ __Returns:__ a new t'GI.Soup.Objects.Cache.Cache'
cacheNew :: Maybe Text -> CacheType -> m Cache
cacheNew cacheDir :: Maybe Text
cacheDir cacheType :: CacheType
cacheType = IO Cache -> m Cache
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Cache -> m Cache) -> IO Cache -> m Cache
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeCacheDir <- case Maybe Text
cacheDir of
        Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just jCacheDir :: Text
jCacheDir -> do
            Ptr CChar
jCacheDir' <- Text -> IO (Ptr CChar)
textToCString Text
jCacheDir
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jCacheDir'
    let cacheType' :: CUInt
cacheType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (CacheType -> Int) -> CacheType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CacheType -> Int
forall a. Enum a => a -> Int
fromEnum) CacheType
cacheType
    Ptr Cache
result <- Ptr CChar -> CUInt -> IO (Ptr Cache)
soup_cache_new Ptr CChar
maybeCacheDir CUInt
cacheType'
    Text -> Ptr Cache -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "cacheNew" Ptr Cache
result
    Cache
result' <- ((ManagedPtr Cache -> Cache) -> Ptr Cache -> IO Cache
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Cache -> Cache
Cache) Ptr Cache
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeCacheDir
    Cache -> IO Cache
forall (m :: * -> *) a. Monad m => a -> m a
return Cache
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Cache::clear
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cache"
--           , argType = TInterface Name { namespace = "Soup" , name = "Cache" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCache" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_cache_clear" soup_cache_clear :: 
    Ptr Cache ->                            -- cache : TInterface (Name {namespace = "Soup", name = "Cache"})
    IO ()

-- | Will remove all entries in the /@cache@/ plus all the cache files.
-- 
-- /Since: 2.34/
cacheClear ::
    (B.CallStack.HasCallStack, MonadIO m, IsCache a) =>
    a
    -- ^ /@cache@/: a t'GI.Soup.Objects.Cache.Cache'
    -> m ()
cacheClear :: a -> m ()
cacheClear cache :: a
cache = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cache
cache' <- a -> IO (Ptr Cache)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cache
    Ptr Cache -> IO ()
soup_cache_clear Ptr Cache
cache'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
cache
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CacheClearMethodInfo
instance (signature ~ (m ()), MonadIO m, IsCache a) => O.MethodInfo CacheClearMethodInfo a signature where
    overloadedMethod = cacheClear

#endif

-- method Cache::dump
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cache"
--           , argType = TInterface Name { namespace = "Soup" , name = "Cache" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCache" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_cache_dump" soup_cache_dump :: 
    Ptr Cache ->                            -- cache : TInterface (Name {namespace = "Soup", name = "Cache"})
    IO ()

-- | Synchronously writes the cache index out to disk. Contrast with
-- 'GI.Soup.Objects.Cache.cacheFlush', which writes pending cache
-- \<emphasis>entries\<\/emphasis> to disk.
-- 
-- You must call this before exiting if you want your cache data to
-- persist between sessions.
-- 
-- /Since: 2.34./
cacheDump ::
    (B.CallStack.HasCallStack, MonadIO m, IsCache a) =>
    a
    -- ^ /@cache@/: a t'GI.Soup.Objects.Cache.Cache'
    -> m ()
cacheDump :: a -> m ()
cacheDump cache :: a
cache = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cache
cache' <- a -> IO (Ptr Cache)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cache
    Ptr Cache -> IO ()
soup_cache_dump Ptr Cache
cache'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
cache
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CacheDumpMethodInfo
instance (signature ~ (m ()), MonadIO m, IsCache a) => O.MethodInfo CacheDumpMethodInfo a signature where
    overloadedMethod = cacheDump

#endif

-- method Cache::flush
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cache"
--           , argType = TInterface Name { namespace = "Soup" , name = "Cache" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCache" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_cache_flush" soup_cache_flush :: 
    Ptr Cache ->                            -- cache : TInterface (Name {namespace = "Soup", name = "Cache"})
    IO ()

-- | This function will force all pending writes in the /@cache@/ to be
-- committed to disk. For doing so it will iterate the t'GI.GLib.Structs.MainContext.MainContext'
-- associated with /@cache@/\'s session as long as needed.
-- 
-- Contrast with 'GI.Soup.Objects.Cache.cacheDump', which writes out the cache index
-- file.
-- 
-- /Since: 2.34/
cacheFlush ::
    (B.CallStack.HasCallStack, MonadIO m, IsCache a) =>
    a
    -- ^ /@cache@/: a t'GI.Soup.Objects.Cache.Cache'
    -> m ()
cacheFlush :: a -> m ()
cacheFlush cache :: a
cache = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cache
cache' <- a -> IO (Ptr Cache)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cache
    Ptr Cache -> IO ()
soup_cache_flush Ptr Cache
cache'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
cache
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CacheFlushMethodInfo
instance (signature ~ (m ()), MonadIO m, IsCache a) => O.MethodInfo CacheFlushMethodInfo a signature where
    overloadedMethod = cacheFlush

#endif

-- method Cache::get_max_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cache"
--           , argType = TInterface Name { namespace = "Soup" , name = "Cache" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCache" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "soup_cache_get_max_size" soup_cache_get_max_size :: 
    Ptr Cache ->                            -- cache : TInterface (Name {namespace = "Soup", name = "Cache"})
    IO Word32

-- | Gets the maximum size of the cache.
-- 
-- /Since: 2.34/
cacheGetMaxSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsCache a) =>
    a
    -- ^ /@cache@/: a t'GI.Soup.Objects.Cache.Cache'
    -> m Word32
    -- ^ __Returns:__ the maximum size of the cache, in bytes.
cacheGetMaxSize :: a -> m Word32
cacheGetMaxSize cache :: a
cache = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cache
cache' <- a -> IO (Ptr Cache)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cache
    Word32
result <- Ptr Cache -> IO Word32
soup_cache_get_max_size Ptr Cache
cache'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
cache
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data CacheGetMaxSizeMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsCache a) => O.MethodInfo CacheGetMaxSizeMethodInfo a signature where
    overloadedMethod = cacheGetMaxSize

#endif

-- method Cache::load
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cache"
--           , argType = TInterface Name { namespace = "Soup" , name = "Cache" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCache" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_cache_load" soup_cache_load :: 
    Ptr Cache ->                            -- cache : TInterface (Name {namespace = "Soup", name = "Cache"})
    IO ()

-- | Loads the contents of /@cache@/\'s index into memory.
-- 
-- /Since: 2.34/
cacheLoad ::
    (B.CallStack.HasCallStack, MonadIO m, IsCache a) =>
    a
    -- ^ /@cache@/: a t'GI.Soup.Objects.Cache.Cache'
    -> m ()
cacheLoad :: a -> m ()
cacheLoad cache :: a
cache = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cache
cache' <- a -> IO (Ptr Cache)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cache
    Ptr Cache -> IO ()
soup_cache_load Ptr Cache
cache'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
cache
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CacheLoadMethodInfo
instance (signature ~ (m ()), MonadIO m, IsCache a) => O.MethodInfo CacheLoadMethodInfo a signature where
    overloadedMethod = cacheLoad

#endif

-- method Cache::set_max_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cache"
--           , argType = TInterface Name { namespace = "Soup" , name = "Cache" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCache" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max_size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the maximum size of the cache, in bytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_cache_set_max_size" soup_cache_set_max_size :: 
    Ptr Cache ->                            -- cache : TInterface (Name {namespace = "Soup", name = "Cache"})
    Word32 ->                               -- max_size : TBasicType TUInt
    IO ()

-- | Sets the maximum size of the cache.
-- 
-- /Since: 2.34/
cacheSetMaxSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsCache a) =>
    a
    -- ^ /@cache@/: a t'GI.Soup.Objects.Cache.Cache'
    -> Word32
    -- ^ /@maxSize@/: the maximum size of the cache, in bytes
    -> m ()
cacheSetMaxSize :: a -> Word32 -> m ()
cacheSetMaxSize cache :: a
cache maxSize :: Word32
maxSize = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cache
cache' <- a -> IO (Ptr Cache)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cache
    Ptr Cache -> Word32 -> IO ()
soup_cache_set_max_size Ptr Cache
cache' Word32
maxSize
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
cache
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CacheSetMaxSizeMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsCache a) => O.MethodInfo CacheSetMaxSizeMethodInfo a signature where
    overloadedMethod = cacheSetMaxSize

#endif