{-# 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.Soup.Objects.Cache
    ( 

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


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addFeature]("GI.Soup.Interfaces.SessionFeature#g:method:addFeature"), [attach]("GI.Soup.Interfaces.SessionFeature#g:method:attach"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [clear]("GI.Soup.Objects.Cache#g:method:clear"), [detach]("GI.Soup.Interfaces.SessionFeature#g:method:detach"), [dump]("GI.Soup.Objects.Cache#g:method:dump"), [flush]("GI.Soup.Objects.Cache#g:method:flush"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasFeature]("GI.Soup.Interfaces.SessionFeature#g:method:hasFeature"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [load]("GI.Soup.Objects.Cache#g:method:load"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeFeature]("GI.Soup.Interfaces.SessionFeature#g:method:removeFeature"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getMaxSize]("GI.Soup.Objects.Cache#g:method:getMaxSize"), [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"), [setMaxSize]("GI.Soup.Objects.Cache#g:method:setMaxSize"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
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 (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
/= :: Cache -> Cache -> Bool
$c/= :: Cache -> Cache -> Bool
== :: Cache -> Cache -> Bool
$c== :: Cache -> Cache -> Bool
Eq)

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

foreign import ccall "soup_cache_get_type"
    c_soup_cache_get_type :: IO B.Types.GType

instance B.Types.TypedObject Cache where
    glibType :: IO GType
glibType = IO GType
c_soup_cache_get_type

instance B.Types.GObject Cache

-- | Type class for types which can be safely cast to `Cache`, for instance with `toCache`.
class (SP.GObject o, O.IsDescendantOf Cache o) => IsCache o
instance (SP.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 :: (MIO.MonadIO m, IsCache o) => o -> m Cache
toCache :: forall (m :: * -> *) o. (MonadIO m, IsCache o) => o -> m Cache
toCache = IO Cache -> m Cache
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Cache -> Cache
Cache

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

-- 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 :: forall (m :: * -> *) o.
(MonadIO m, IsCache o) =>
o -> m (Maybe Text)
getCacheCacheDir o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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 String
"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, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructCacheCacheDir :: forall o (m :: * -> *).
(IsCache o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructCacheCacheDir Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"cache-dir" (Text -> Maybe Text
forall a. a -> Maybe a
P.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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Cache.cacheDir"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-Cache.html#g:attr:cacheDir"
        })
#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 :: forall (m :: * -> *) o. (MonadIO m, IsCache o) => o -> m CacheType
getCacheCacheType o
obj = IO CacheType -> m CacheType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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 String
"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, MIO.MonadIO m) => Soup.Enums.CacheType -> m (GValueConstruct o)
constructCacheCacheType :: forall o (m :: * -> *).
(IsCache o, MonadIO m) =>
CacheType -> m (GValueConstruct o)
constructCacheCacheType CacheType
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> CacheType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Cache.cacheType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-Cache.html#g:attr:cacheType"
        })
#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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> CacheType -> m Cache
cacheNew Maybe Text
cacheDir 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
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just 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 Text
"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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCache a) =>
a -> m ()
cacheClear 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.OverloadedMethod CacheClearMethodInfo a signature where
    overloadedMethod = cacheClear

instance O.OverloadedMethodInfo CacheClearMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Cache.cacheClear",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-Cache.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCache a) =>
a -> m ()
cacheDump 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.OverloadedMethod CacheDumpMethodInfo a signature where
    overloadedMethod = cacheDump

instance O.OverloadedMethodInfo CacheDumpMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Cache.cacheDump",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-Cache.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCache a) =>
a -> m ()
cacheFlush 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.OverloadedMethod CacheFlushMethodInfo a signature where
    overloadedMethod = cacheFlush

instance O.OverloadedMethodInfo CacheFlushMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Cache.cacheFlush",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-Cache.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCache a) =>
a -> m Word32
cacheGetMaxSize 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.OverloadedMethod CacheGetMaxSizeMethodInfo a signature where
    overloadedMethod = cacheGetMaxSize

instance O.OverloadedMethodInfo CacheGetMaxSizeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Cache.cacheGetMaxSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-Cache.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCache a) =>
a -> m ()
cacheLoad 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.OverloadedMethod CacheLoadMethodInfo a signature where
    overloadedMethod = cacheLoad

instance O.OverloadedMethodInfo CacheLoadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Cache.cacheLoad",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-Cache.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCache a) =>
a -> Word32 -> m ()
cacheSetMaxSize a
cache 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.OverloadedMethod CacheSetMaxSizeMethodInfo a signature where
    overloadedMethod = cacheSetMaxSize

instance O.OverloadedMethodInfo CacheSetMaxSizeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Cache.cacheSetMaxSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-Cache.html#v:cacheSetMaxSize"
        })


#endif