{-# 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.WebKit2.Structs.WebsiteData
    ( 

-- * Exported types
    WebsiteData(..)                         ,
    noWebsiteData                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveWebsiteDataMethod                ,
#endif


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    WebsiteDataGetNameMethodInfo            ,
#endif
    websiteDataGetName                      ,


-- ** getSize #method:getSize#

#if defined(ENABLE_OVERLOADING)
    WebsiteDataGetSizeMethodInfo            ,
#endif
    websiteDataGetSize                      ,


-- ** getTypes #method:getTypes#

#if defined(ENABLE_OVERLOADING)
    WebsiteDataGetTypesMethodInfo           ,
#endif
    websiteDataGetTypes                     ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    WebsiteDataRefMethodInfo                ,
#endif
    websiteDataRef                          ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    WebsiteDataUnrefMethodInfo              ,
#endif
    websiteDataUnref                        ,




    ) 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 {-# SOURCE #-} qualified GI.WebKit2.Flags as WebKit2.Flags

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

instance BoxedObject WebsiteData where
    boxedType :: WebsiteData -> IO GType
boxedType _ = IO GType
c_webkit_website_data_get_type

-- | Convert 'WebsiteData' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue WebsiteData where
    toGValue :: WebsiteData -> IO GValue
toGValue o :: WebsiteData
o = do
        GType
gtype <- IO GType
c_webkit_website_data_get_type
        WebsiteData -> (Ptr WebsiteData -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr WebsiteData
o (GType
-> (GValue -> Ptr WebsiteData -> IO ())
-> Ptr WebsiteData
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr WebsiteData -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO WebsiteData
fromGValue gv :: GValue
gv = do
        Ptr WebsiteData
ptr <- GValue -> IO (Ptr WebsiteData)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr WebsiteData)
        (ManagedPtr WebsiteData -> WebsiteData)
-> Ptr WebsiteData -> IO WebsiteData
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr WebsiteData -> WebsiteData
WebsiteData Ptr WebsiteData
ptr
        
    

-- | A convenience alias for `Nothing` :: `Maybe` `WebsiteData`.
noWebsiteData :: Maybe WebsiteData
noWebsiteData :: Maybe WebsiteData
noWebsiteData = Maybe WebsiteData
forall a. Maybe a
Nothing


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

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

foreign import ccall "webkit_website_data_get_name" webkit_website_data_get_name :: 
    Ptr WebsiteData ->                      -- website_data : TInterface (Name {namespace = "WebKit2", name = "WebsiteData"})
    IO CString

-- | Gets the name of t'GI.WebKit2.Structs.WebsiteData.WebsiteData'. This is the website name, normally represented by
-- a domain or host name. All local documents are grouped in the same t'GI.WebKit2.Structs.WebsiteData.WebsiteData' using
-- the name \"Local files\".
-- 
-- /Since: 2.16/
websiteDataGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WebsiteData
    -- ^ /@websiteData@/: a t'GI.WebKit2.Structs.WebsiteData.WebsiteData'
    -> m T.Text
    -- ^ __Returns:__ the website name of /@websiteData@/.
websiteDataGetName :: WebsiteData -> m Text
websiteDataGetName websiteData :: WebsiteData
websiteData = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsiteData
websiteData' <- WebsiteData -> IO (Ptr WebsiteData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WebsiteData
websiteData
    CString
result <- Ptr WebsiteData -> IO CString
webkit_website_data_get_name Ptr WebsiteData
websiteData'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "websiteDataGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    WebsiteData -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WebsiteData
websiteData
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data WebsiteDataGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo WebsiteDataGetNameMethodInfo WebsiteData signature where
    overloadedMethod = websiteDataGetName

#endif

-- method WebsiteData::get_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "website_data"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebsiteData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebsiteData"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "types"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "WebsiteDataTypes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a bitmask  of #WebKitWebsiteDataTypes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_website_data_get_size" webkit_website_data_get_size :: 
    Ptr WebsiteData ->                      -- website_data : TInterface (Name {namespace = "WebKit2", name = "WebsiteData"})
    CUInt ->                                -- types : TInterface (Name {namespace = "WebKit2", name = "WebsiteDataTypes"})
    IO Word64

-- | Gets the size of the data of types /@types@/ in a t'GI.WebKit2.Structs.WebsiteData.WebsiteData'.
-- Note that currently the data size is only known for 'GI.WebKit2.Flags.WebsiteDataTypesDiskCache' data type
-- so for all other types 0 will be returned.
-- 
-- /Since: 2.16/
websiteDataGetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WebsiteData
    -- ^ /@websiteData@/: a t'GI.WebKit2.Structs.WebsiteData.WebsiteData'
    -> [WebKit2.Flags.WebsiteDataTypes]
    -- ^ /@types@/: a bitmask  of t'GI.WebKit2.Flags.WebsiteDataTypes'
    -> m Word64
    -- ^ __Returns:__ the size of /@websiteData@/ for the given /@types@/.
websiteDataGetSize :: WebsiteData -> [WebsiteDataTypes] -> m Word64
websiteDataGetSize websiteData :: WebsiteData
websiteData types :: [WebsiteDataTypes]
types = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsiteData
websiteData' <- WebsiteData -> IO (Ptr WebsiteData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WebsiteData
websiteData
    let types' :: CUInt
types' = [WebsiteDataTypes] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [WebsiteDataTypes]
types
    Word64
result <- Ptr WebsiteData -> CUInt -> IO Word64
webkit_website_data_get_size Ptr WebsiteData
websiteData' CUInt
types'
    WebsiteData -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WebsiteData
websiteData
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data WebsiteDataGetSizeMethodInfo
instance (signature ~ ([WebKit2.Flags.WebsiteDataTypes] -> m Word64), MonadIO m) => O.MethodInfo WebsiteDataGetSizeMethodInfo WebsiteData signature where
    overloadedMethod = websiteDataGetSize

#endif

-- method WebsiteData::get_types
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "website_data"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebsiteData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebsiteData"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2" , name = "WebsiteDataTypes" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_website_data_get_types" webkit_website_data_get_types :: 
    Ptr WebsiteData ->                      -- website_data : TInterface (Name {namespace = "WebKit2", name = "WebsiteData"})
    IO CUInt

-- | Gets the types of data stored in the client for a t'GI.WebKit2.Structs.WebsiteData.WebsiteData'. These are the
-- types actually present, not the types queried with 'GI.WebKit2.Objects.WebsiteDataManager.websiteDataManagerFetch'.
-- 
-- /Since: 2.16/
websiteDataGetTypes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WebsiteData
    -- ^ /@websiteData@/: a t'GI.WebKit2.Structs.WebsiteData.WebsiteData'
    -> m [WebKit2.Flags.WebsiteDataTypes]
    -- ^ __Returns:__ a bitmask of t'GI.WebKit2.Flags.WebsiteDataTypes' in /@websiteData@/
websiteDataGetTypes :: WebsiteData -> m [WebsiteDataTypes]
websiteDataGetTypes websiteData :: WebsiteData
websiteData = IO [WebsiteDataTypes] -> m [WebsiteDataTypes]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [WebsiteDataTypes] -> m [WebsiteDataTypes])
-> IO [WebsiteDataTypes] -> m [WebsiteDataTypes]
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsiteData
websiteData' <- WebsiteData -> IO (Ptr WebsiteData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WebsiteData
websiteData
    CUInt
result <- Ptr WebsiteData -> IO CUInt
webkit_website_data_get_types Ptr WebsiteData
websiteData'
    let result' :: [WebsiteDataTypes]
result' = CUInt -> [WebsiteDataTypes]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    WebsiteData -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WebsiteData
websiteData
    [WebsiteDataTypes] -> IO [WebsiteDataTypes]
forall (m :: * -> *) a. Monad m => a -> m a
return [WebsiteDataTypes]
result'

#if defined(ENABLE_OVERLOADING)
data WebsiteDataGetTypesMethodInfo
instance (signature ~ (m [WebKit2.Flags.WebsiteDataTypes]), MonadIO m) => O.MethodInfo WebsiteDataGetTypesMethodInfo WebsiteData signature where
    overloadedMethod = websiteDataGetTypes

#endif

-- method WebsiteData::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "website_data"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebsiteData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebsiteData"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit2" , name = "WebsiteData" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_website_data_ref" webkit_website_data_ref :: 
    Ptr WebsiteData ->                      -- website_data : TInterface (Name {namespace = "WebKit2", name = "WebsiteData"})
    IO (Ptr WebsiteData)

-- | Atomically increments the reference count of /@websiteData@/ by one.
-- This function is MT-safe and may be called from any thread.
-- 
-- /Since: 2.16/
websiteDataRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WebsiteData
    -- ^ /@websiteData@/: a t'GI.WebKit2.Structs.WebsiteData.WebsiteData'
    -> m WebsiteData
    -- ^ __Returns:__ The passed t'GI.WebKit2.Structs.WebsiteData.WebsiteData'
websiteDataRef :: WebsiteData -> m WebsiteData
websiteDataRef websiteData :: WebsiteData
websiteData = IO WebsiteData -> m WebsiteData
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WebsiteData -> m WebsiteData)
-> IO WebsiteData -> m WebsiteData
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsiteData
websiteData' <- WebsiteData -> IO (Ptr WebsiteData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WebsiteData
websiteData
    Ptr WebsiteData
result <- Ptr WebsiteData -> IO (Ptr WebsiteData)
webkit_website_data_ref Ptr WebsiteData
websiteData'
    Text -> Ptr WebsiteData -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "websiteDataRef" Ptr WebsiteData
result
    WebsiteData
result' <- ((ManagedPtr WebsiteData -> WebsiteData)
-> Ptr WebsiteData -> IO WebsiteData
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr WebsiteData -> WebsiteData
WebsiteData) Ptr WebsiteData
result
    WebsiteData -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WebsiteData
websiteData
    WebsiteData -> IO WebsiteData
forall (m :: * -> *) a. Monad m => a -> m a
return WebsiteData
result'

#if defined(ENABLE_OVERLOADING)
data WebsiteDataRefMethodInfo
instance (signature ~ (m WebsiteData), MonadIO m) => O.MethodInfo WebsiteDataRefMethodInfo WebsiteData signature where
    overloadedMethod = websiteDataRef

#endif

-- method WebsiteData::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "website_data"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebsiteData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitWebsiteData"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_website_data_unref" webkit_website_data_unref :: 
    Ptr WebsiteData ->                      -- website_data : TInterface (Name {namespace = "WebKit2", name = "WebsiteData"})
    IO ()

-- | Atomically decrements the reference count of /@websiteData@/ by one.
-- If the reference count drops to 0, all memory allocated by
-- t'GI.WebKit2.Structs.WebsiteData.WebsiteData' is released. This function is MT-safe and may be
-- called from any thread.
-- 
-- /Since: 2.16/
websiteDataUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WebsiteData
    -- ^ /@websiteData@/: A t'GI.WebKit2.Structs.WebsiteData.WebsiteData'
    -> m ()
websiteDataUnref :: WebsiteData -> m ()
websiteDataUnref websiteData :: WebsiteData
websiteData = 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 WebsiteData
websiteData' <- WebsiteData -> IO (Ptr WebsiteData)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WebsiteData
websiteData
    Ptr WebsiteData -> IO ()
webkit_website_data_unref Ptr WebsiteData
websiteData'
    WebsiteData -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WebsiteData
websiteData
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebsiteDataUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo WebsiteDataUnrefMethodInfo WebsiteData signature where
    overloadedMethod = websiteDataUnref

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveWebsiteDataMethod (t :: Symbol) (o :: *) :: * where
    ResolveWebsiteDataMethod "ref" o = WebsiteDataRefMethodInfo
    ResolveWebsiteDataMethod "unref" o = WebsiteDataUnrefMethodInfo
    ResolveWebsiteDataMethod "getName" o = WebsiteDataGetNameMethodInfo
    ResolveWebsiteDataMethod "getSize" o = WebsiteDataGetSizeMethodInfo
    ResolveWebsiteDataMethod "getTypes" o = WebsiteDataGetTypesMethodInfo
    ResolveWebsiteDataMethod l o = O.MethodResolutionFailed l o

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

#endif