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

-- * Exported types
    WebContext(..)                          ,
    IsWebContext                            ,
    toWebContext                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveWebContextMethod                 ,
#endif


-- ** addPathToSandbox #method:addPathToSandbox#

#if defined(ENABLE_OVERLOADING)
    WebContextAddPathToSandboxMethodInfo    ,
#endif
    webContextAddPathToSandbox              ,


-- ** allowTlsCertificateForHost #method:allowTlsCertificateForHost#

#if defined(ENABLE_OVERLOADING)
    WebContextAllowTlsCertificateForHostMethodInfo,
#endif
    webContextAllowTlsCertificateForHost    ,


-- ** clearCache #method:clearCache#

#if defined(ENABLE_OVERLOADING)
    WebContextClearCacheMethodInfo          ,
#endif
    webContextClearCache                    ,


-- ** downloadUri #method:downloadUri#

#if defined(ENABLE_OVERLOADING)
    WebContextDownloadUriMethodInfo         ,
#endif
    webContextDownloadUri                   ,


-- ** getCacheModel #method:getCacheModel#

#if defined(ENABLE_OVERLOADING)
    WebContextGetCacheModelMethodInfo       ,
#endif
    webContextGetCacheModel                 ,


-- ** getCookieManager #method:getCookieManager#

#if defined(ENABLE_OVERLOADING)
    WebContextGetCookieManagerMethodInfo    ,
#endif
    webContextGetCookieManager              ,


-- ** getDefault #method:getDefault#

    webContextGetDefault                    ,


-- ** getFaviconDatabase #method:getFaviconDatabase#

#if defined(ENABLE_OVERLOADING)
    WebContextGetFaviconDatabaseMethodInfo  ,
#endif
    webContextGetFaviconDatabase            ,


-- ** getFaviconDatabaseDirectory #method:getFaviconDatabaseDirectory#

#if defined(ENABLE_OVERLOADING)
    WebContextGetFaviconDatabaseDirectoryMethodInfo,
#endif
    webContextGetFaviconDatabaseDirectory   ,


-- ** getGeolocationManager #method:getGeolocationManager#

#if defined(ENABLE_OVERLOADING)
    WebContextGetGeolocationManagerMethodInfo,
#endif
    webContextGetGeolocationManager         ,


-- ** getPlugins #method:getPlugins#

#if defined(ENABLE_OVERLOADING)
    WebContextGetPluginsMethodInfo          ,
#endif
    webContextGetPlugins                    ,


-- ** getPluginsFinish #method:getPluginsFinish#

#if defined(ENABLE_OVERLOADING)
    WebContextGetPluginsFinishMethodInfo    ,
#endif
    webContextGetPluginsFinish              ,


-- ** getProcessModel #method:getProcessModel#

#if defined(ENABLE_OVERLOADING)
    WebContextGetProcessModelMethodInfo     ,
#endif
    webContextGetProcessModel               ,


-- ** getSandboxEnabled #method:getSandboxEnabled#

#if defined(ENABLE_OVERLOADING)
    WebContextGetSandboxEnabledMethodInfo   ,
#endif
    webContextGetSandboxEnabled             ,


-- ** getSecurityManager #method:getSecurityManager#

#if defined(ENABLE_OVERLOADING)
    WebContextGetSecurityManagerMethodInfo  ,
#endif
    webContextGetSecurityManager            ,


-- ** getSpellCheckingEnabled #method:getSpellCheckingEnabled#

#if defined(ENABLE_OVERLOADING)
    WebContextGetSpellCheckingEnabledMethodInfo,
#endif
    webContextGetSpellCheckingEnabled       ,


-- ** getSpellCheckingLanguages #method:getSpellCheckingLanguages#

#if defined(ENABLE_OVERLOADING)
    WebContextGetSpellCheckingLanguagesMethodInfo,
#endif
    webContextGetSpellCheckingLanguages     ,


-- ** getTlsErrorsPolicy #method:getTlsErrorsPolicy#

#if defined(ENABLE_OVERLOADING)
    WebContextGetTlsErrorsPolicyMethodInfo  ,
#endif
    webContextGetTlsErrorsPolicy            ,


-- ** getWebProcessCountLimit #method:getWebProcessCountLimit#

#if defined(ENABLE_OVERLOADING)
    WebContextGetWebProcessCountLimitMethodInfo,
#endif
    webContextGetWebProcessCountLimit       ,


-- ** getWebsiteDataManager #method:getWebsiteDataManager#

#if defined(ENABLE_OVERLOADING)
    WebContextGetWebsiteDataManagerMethodInfo,
#endif
    webContextGetWebsiteDataManager         ,


-- ** initializeNotificationPermissions #method:initializeNotificationPermissions#

#if defined(ENABLE_OVERLOADING)
    WebContextInitializeNotificationPermissionsMethodInfo,
#endif
    webContextInitializeNotificationPermissions,


-- ** isAutomationAllowed #method:isAutomationAllowed#

#if defined(ENABLE_OVERLOADING)
    WebContextIsAutomationAllowedMethodInfo ,
#endif
    webContextIsAutomationAllowed           ,


-- ** isEphemeral #method:isEphemeral#

#if defined(ENABLE_OVERLOADING)
    WebContextIsEphemeralMethodInfo         ,
#endif
    webContextIsEphemeral                   ,


-- ** new #method:new#

    webContextNew                           ,


-- ** newEphemeral #method:newEphemeral#

    webContextNewEphemeral                  ,


-- ** newWithWebsiteDataManager #method:newWithWebsiteDataManager#

    webContextNewWithWebsiteDataManager     ,


-- ** prefetchDns #method:prefetchDns#

#if defined(ENABLE_OVERLOADING)
    WebContextPrefetchDnsMethodInfo         ,
#endif
    webContextPrefetchDns                   ,


-- ** registerUriScheme #method:registerUriScheme#

#if defined(ENABLE_OVERLOADING)
    WebContextRegisterUriSchemeMethodInfo   ,
#endif
    webContextRegisterUriScheme             ,


-- ** sendMessageToAllExtensions #method:sendMessageToAllExtensions#

#if defined(ENABLE_OVERLOADING)
    WebContextSendMessageToAllExtensionsMethodInfo,
#endif
    webContextSendMessageToAllExtensions    ,


-- ** setAdditionalPluginsDirectory #method:setAdditionalPluginsDirectory#

#if defined(ENABLE_OVERLOADING)
    WebContextSetAdditionalPluginsDirectoryMethodInfo,
#endif
    webContextSetAdditionalPluginsDirectory ,


-- ** setAutomationAllowed #method:setAutomationAllowed#

#if defined(ENABLE_OVERLOADING)
    WebContextSetAutomationAllowedMethodInfo,
#endif
    webContextSetAutomationAllowed          ,


-- ** setCacheModel #method:setCacheModel#

#if defined(ENABLE_OVERLOADING)
    WebContextSetCacheModelMethodInfo       ,
#endif
    webContextSetCacheModel                 ,


-- ** setDiskCacheDirectory #method:setDiskCacheDirectory#

#if defined(ENABLE_OVERLOADING)
    WebContextSetDiskCacheDirectoryMethodInfo,
#endif
    webContextSetDiskCacheDirectory         ,


-- ** setFaviconDatabaseDirectory #method:setFaviconDatabaseDirectory#

#if defined(ENABLE_OVERLOADING)
    WebContextSetFaviconDatabaseDirectoryMethodInfo,
#endif
    webContextSetFaviconDatabaseDirectory   ,


-- ** setNetworkProxySettings #method:setNetworkProxySettings#

#if defined(ENABLE_OVERLOADING)
    WebContextSetNetworkProxySettingsMethodInfo,
#endif
    webContextSetNetworkProxySettings       ,


-- ** setPreferredLanguages #method:setPreferredLanguages#

#if defined(ENABLE_OVERLOADING)
    WebContextSetPreferredLanguagesMethodInfo,
#endif
    webContextSetPreferredLanguages         ,


-- ** setProcessModel #method:setProcessModel#

#if defined(ENABLE_OVERLOADING)
    WebContextSetProcessModelMethodInfo     ,
#endif
    webContextSetProcessModel               ,


-- ** setSandboxEnabled #method:setSandboxEnabled#

#if defined(ENABLE_OVERLOADING)
    WebContextSetSandboxEnabledMethodInfo   ,
#endif
    webContextSetSandboxEnabled             ,


-- ** setSpellCheckingEnabled #method:setSpellCheckingEnabled#

#if defined(ENABLE_OVERLOADING)
    WebContextSetSpellCheckingEnabledMethodInfo,
#endif
    webContextSetSpellCheckingEnabled       ,


-- ** setSpellCheckingLanguages #method:setSpellCheckingLanguages#

#if defined(ENABLE_OVERLOADING)
    WebContextSetSpellCheckingLanguagesMethodInfo,
#endif
    webContextSetSpellCheckingLanguages     ,


-- ** setTlsErrorsPolicy #method:setTlsErrorsPolicy#

#if defined(ENABLE_OVERLOADING)
    WebContextSetTlsErrorsPolicyMethodInfo  ,
#endif
    webContextSetTlsErrorsPolicy            ,


-- ** setWebExtensionsDirectory #method:setWebExtensionsDirectory#

#if defined(ENABLE_OVERLOADING)
    WebContextSetWebExtensionsDirectoryMethodInfo,
#endif
    webContextSetWebExtensionsDirectory     ,


-- ** setWebExtensionsInitializationUserData #method:setWebExtensionsInitializationUserData#

#if defined(ENABLE_OVERLOADING)
    WebContextSetWebExtensionsInitializationUserDataMethodInfo,
#endif
    webContextSetWebExtensionsInitializationUserData,


-- ** setWebProcessCountLimit #method:setWebProcessCountLimit#

#if defined(ENABLE_OVERLOADING)
    WebContextSetWebProcessCountLimitMethodInfo,
#endif
    webContextSetWebProcessCountLimit       ,




 -- * Properties
-- ** localStorageDirectory #attr:localStorageDirectory#
-- | The directory where local storage data will be saved.
-- 
-- /Since: 2.8/

#if defined(ENABLE_OVERLOADING)
    WebContextLocalStorageDirectoryPropertyInfo,
#endif
    constructWebContextLocalStorageDirectory,
    getWebContextLocalStorageDirectory      ,
#if defined(ENABLE_OVERLOADING)
    webContextLocalStorageDirectory         ,
#endif


-- ** processSwapOnCrossSiteNavigationEnabled #attr:processSwapOnCrossSiteNavigationEnabled#
-- | Whether swap Web processes on cross-site navigations is enabled.
-- 
-- When enabled, pages from each security origin will be handled by
-- their own separate Web processes, which are started (and
-- terminated) on demand as the user navigates across different
-- domains. This is an important security measure which helps prevent
-- websites stealing data from other visited pages.
-- 
-- /Since: 2.28/

#if defined(ENABLE_OVERLOADING)
    WebContextProcessSwapOnCrossSiteNavigationEnabledPropertyInfo,
#endif
    constructWebContextProcessSwapOnCrossSiteNavigationEnabled,
    getWebContextProcessSwapOnCrossSiteNavigationEnabled,
#if defined(ENABLE_OVERLOADING)
    webContextProcessSwapOnCrossSiteNavigationEnabled,
#endif


-- ** websiteDataManager #attr:websiteDataManager#
-- | The t'GI.WebKit2.Objects.WebsiteDataManager.WebsiteDataManager' associated with this context.
-- 
-- /Since: 2.10/

#if defined(ENABLE_OVERLOADING)
    WebContextWebsiteDataManagerPropertyInfo,
#endif
    constructWebContextWebsiteDataManager   ,
    getWebContextWebsiteDataManager         ,
#if defined(ENABLE_OVERLOADING)
    webContextWebsiteDataManager            ,
#endif




 -- * Signals
-- ** automationStarted #signal:automationStarted#

    C_WebContextAutomationStartedCallback   ,
    WebContextAutomationStartedCallback     ,
#if defined(ENABLE_OVERLOADING)
    WebContextAutomationStartedSignalInfo   ,
#endif
    afterWebContextAutomationStarted        ,
    genClosure_WebContextAutomationStarted  ,
    mk_WebContextAutomationStartedCallback  ,
    noWebContextAutomationStartedCallback   ,
    onWebContextAutomationStarted           ,
    wrap_WebContextAutomationStartedCallback,


-- ** downloadStarted #signal:downloadStarted#

    C_WebContextDownloadStartedCallback     ,
    WebContextDownloadStartedCallback       ,
#if defined(ENABLE_OVERLOADING)
    WebContextDownloadStartedSignalInfo     ,
#endif
    afterWebContextDownloadStarted          ,
    genClosure_WebContextDownloadStarted    ,
    mk_WebContextDownloadStartedCallback    ,
    noWebContextDownloadStartedCallback     ,
    onWebContextDownloadStarted             ,
    wrap_WebContextDownloadStartedCallback  ,


-- ** initializeNotificationPermissions #signal:initializeNotificationPermissions#

    C_WebContextInitializeNotificationPermissionsCallback,
    WebContextInitializeNotificationPermissionsCallback,
#if defined(ENABLE_OVERLOADING)
    WebContextInitializeNotificationPermissionsSignalInfo,
#endif
    afterWebContextInitializeNotificationPermissions,
    genClosure_WebContextInitializeNotificationPermissions,
    mk_WebContextInitializeNotificationPermissionsCallback,
    noWebContextInitializeNotificationPermissionsCallback,
    onWebContextInitializeNotificationPermissions,
    wrap_WebContextInitializeNotificationPermissionsCallback,


-- ** initializeWebExtensions #signal:initializeWebExtensions#

    C_WebContextInitializeWebExtensionsCallback,
    WebContextInitializeWebExtensionsCallback,
#if defined(ENABLE_OVERLOADING)
    WebContextInitializeWebExtensionsSignalInfo,
#endif
    afterWebContextInitializeWebExtensions  ,
    genClosure_WebContextInitializeWebExtensions,
    mk_WebContextInitializeWebExtensionsCallback,
    noWebContextInitializeWebExtensionsCallback,
    onWebContextInitializeWebExtensions     ,
    wrap_WebContextInitializeWebExtensionsCallback,


-- ** userMessageReceived #signal:userMessageReceived#

    C_WebContextUserMessageReceivedCallback ,
    WebContextUserMessageReceivedCallback   ,
#if defined(ENABLE_OVERLOADING)
    WebContextUserMessageReceivedSignalInfo ,
#endif
    afterWebContextUserMessageReceived      ,
    genClosure_WebContextUserMessageReceived,
    mk_WebContextUserMessageReceivedCallback,
    noWebContextUserMessageReceivedCallback ,
    onWebContextUserMessageReceived         ,
    wrap_WebContextUserMessageReceivedCallback,




    ) 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.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.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.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.TlsCertificate as Gio.TlsCertificate
import qualified GI.WebKit2.Callbacks as WebKit2.Callbacks
import {-# SOURCE #-} qualified GI.WebKit2.Enums as WebKit2.Enums
import {-# SOURCE #-} qualified GI.WebKit2.Objects.AutomationSession as WebKit2.AutomationSession
import {-# SOURCE #-} qualified GI.WebKit2.Objects.CookieManager as WebKit2.CookieManager
import {-# SOURCE #-} qualified GI.WebKit2.Objects.Download as WebKit2.Download
import {-# SOURCE #-} qualified GI.WebKit2.Objects.FaviconDatabase as WebKit2.FaviconDatabase
import {-# SOURCE #-} qualified GI.WebKit2.Objects.GeolocationManager as WebKit2.GeolocationManager
import {-# SOURCE #-} qualified GI.WebKit2.Objects.Plugin as WebKit2.Plugin
import {-# SOURCE #-} qualified GI.WebKit2.Objects.SecurityManager as WebKit2.SecurityManager
import {-# SOURCE #-} qualified GI.WebKit2.Objects.UserMessage as WebKit2.UserMessage
import {-# SOURCE #-} qualified GI.WebKit2.Objects.WebsiteDataManager as WebKit2.WebsiteDataManager
import {-# SOURCE #-} qualified GI.WebKit2.Structs.NetworkProxySettings as WebKit2.NetworkProxySettings
import {-# SOURCE #-} qualified GI.WebKit2.Structs.SecurityOrigin as WebKit2.SecurityOrigin

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

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

foreign import ccall "webkit_web_context_get_type"
    c_webkit_web_context_get_type :: IO B.Types.GType

instance B.Types.TypedObject WebContext where
    glibType :: IO GType
glibType = IO GType
c_webkit_web_context_get_type

instance B.Types.GObject WebContext

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveWebContextMethod (t :: Symbol) (o :: *) :: * where
    ResolveWebContextMethod "addPathToSandbox" o = WebContextAddPathToSandboxMethodInfo
    ResolveWebContextMethod "allowTlsCertificateForHost" o = WebContextAllowTlsCertificateForHostMethodInfo
    ResolveWebContextMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveWebContextMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveWebContextMethod "clearCache" o = WebContextClearCacheMethodInfo
    ResolveWebContextMethod "downloadUri" o = WebContextDownloadUriMethodInfo
    ResolveWebContextMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveWebContextMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveWebContextMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveWebContextMethod "initializeNotificationPermissions" o = WebContextInitializeNotificationPermissionsMethodInfo
    ResolveWebContextMethod "isAutomationAllowed" o = WebContextIsAutomationAllowedMethodInfo
    ResolveWebContextMethod "isEphemeral" o = WebContextIsEphemeralMethodInfo
    ResolveWebContextMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveWebContextMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveWebContextMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveWebContextMethod "prefetchDns" o = WebContextPrefetchDnsMethodInfo
    ResolveWebContextMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveWebContextMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveWebContextMethod "registerUriScheme" o = WebContextRegisterUriSchemeMethodInfo
    ResolveWebContextMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveWebContextMethod "sendMessageToAllExtensions" o = WebContextSendMessageToAllExtensionsMethodInfo
    ResolveWebContextMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveWebContextMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveWebContextMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveWebContextMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveWebContextMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveWebContextMethod "getCacheModel" o = WebContextGetCacheModelMethodInfo
    ResolveWebContextMethod "getCookieManager" o = WebContextGetCookieManagerMethodInfo
    ResolveWebContextMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveWebContextMethod "getFaviconDatabase" o = WebContextGetFaviconDatabaseMethodInfo
    ResolveWebContextMethod "getFaviconDatabaseDirectory" o = WebContextGetFaviconDatabaseDirectoryMethodInfo
    ResolveWebContextMethod "getGeolocationManager" o = WebContextGetGeolocationManagerMethodInfo
    ResolveWebContextMethod "getPlugins" o = WebContextGetPluginsMethodInfo
    ResolveWebContextMethod "getPluginsFinish" o = WebContextGetPluginsFinishMethodInfo
    ResolveWebContextMethod "getProcessModel" o = WebContextGetProcessModelMethodInfo
    ResolveWebContextMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveWebContextMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveWebContextMethod "getSandboxEnabled" o = WebContextGetSandboxEnabledMethodInfo
    ResolveWebContextMethod "getSecurityManager" o = WebContextGetSecurityManagerMethodInfo
    ResolveWebContextMethod "getSpellCheckingEnabled" o = WebContextGetSpellCheckingEnabledMethodInfo
    ResolveWebContextMethod "getSpellCheckingLanguages" o = WebContextGetSpellCheckingLanguagesMethodInfo
    ResolveWebContextMethod "getTlsErrorsPolicy" o = WebContextGetTlsErrorsPolicyMethodInfo
    ResolveWebContextMethod "getWebProcessCountLimit" o = WebContextGetWebProcessCountLimitMethodInfo
    ResolveWebContextMethod "getWebsiteDataManager" o = WebContextGetWebsiteDataManagerMethodInfo
    ResolveWebContextMethod "setAdditionalPluginsDirectory" o = WebContextSetAdditionalPluginsDirectoryMethodInfo
    ResolveWebContextMethod "setAutomationAllowed" o = WebContextSetAutomationAllowedMethodInfo
    ResolveWebContextMethod "setCacheModel" o = WebContextSetCacheModelMethodInfo
    ResolveWebContextMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveWebContextMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveWebContextMethod "setDiskCacheDirectory" o = WebContextSetDiskCacheDirectoryMethodInfo
    ResolveWebContextMethod "setFaviconDatabaseDirectory" o = WebContextSetFaviconDatabaseDirectoryMethodInfo
    ResolveWebContextMethod "setNetworkProxySettings" o = WebContextSetNetworkProxySettingsMethodInfo
    ResolveWebContextMethod "setPreferredLanguages" o = WebContextSetPreferredLanguagesMethodInfo
    ResolveWebContextMethod "setProcessModel" o = WebContextSetProcessModelMethodInfo
    ResolveWebContextMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveWebContextMethod "setSandboxEnabled" o = WebContextSetSandboxEnabledMethodInfo
    ResolveWebContextMethod "setSpellCheckingEnabled" o = WebContextSetSpellCheckingEnabledMethodInfo
    ResolveWebContextMethod "setSpellCheckingLanguages" o = WebContextSetSpellCheckingLanguagesMethodInfo
    ResolveWebContextMethod "setTlsErrorsPolicy" o = WebContextSetTlsErrorsPolicyMethodInfo
    ResolveWebContextMethod "setWebExtensionsDirectory" o = WebContextSetWebExtensionsDirectoryMethodInfo
    ResolveWebContextMethod "setWebExtensionsInitializationUserData" o = WebContextSetWebExtensionsInitializationUserDataMethodInfo
    ResolveWebContextMethod "setWebProcessCountLimit" o = WebContextSetWebProcessCountLimitMethodInfo
    ResolveWebContextMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal WebContext::automation-started
-- | This signal is emitted when a new automation request is made.
-- Note that it will never be emitted if automation is not enabled in /@context@/,
-- see 'GI.WebKit2.Objects.WebContext.webContextSetAutomationAllowed' for more details.
-- 
-- /Since: 2.18/
type WebContextAutomationStartedCallback =
    WebKit2.AutomationSession.AutomationSession
    -- ^ /@session@/: the t'GI.WebKit2.Objects.AutomationSession.AutomationSession' associated with this event
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `WebContextAutomationStartedCallback`@.
noWebContextAutomationStartedCallback :: Maybe WebContextAutomationStartedCallback
noWebContextAutomationStartedCallback :: Maybe WebContextAutomationStartedCallback
noWebContextAutomationStartedCallback = Maybe WebContextAutomationStartedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_WebContextAutomationStartedCallback =
    Ptr () ->                               -- object
    Ptr WebKit2.AutomationSession.AutomationSession ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_WebContextAutomationStartedCallback`.
foreign import ccall "wrapper"
    mk_WebContextAutomationStartedCallback :: C_WebContextAutomationStartedCallback -> IO (FunPtr C_WebContextAutomationStartedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_WebContextAutomationStarted :: MonadIO m => WebContextAutomationStartedCallback -> m (GClosure C_WebContextAutomationStartedCallback)
genClosure_WebContextAutomationStarted :: WebContextAutomationStartedCallback
-> m (GClosure C_WebContextAutomationStartedCallback)
genClosure_WebContextAutomationStarted WebContextAutomationStartedCallback
cb = IO (GClosure C_WebContextAutomationStartedCallback)
-> m (GClosure C_WebContextAutomationStartedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_WebContextAutomationStartedCallback)
 -> m (GClosure C_WebContextAutomationStartedCallback))
-> IO (GClosure C_WebContextAutomationStartedCallback)
-> m (GClosure C_WebContextAutomationStartedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebContextAutomationStartedCallback
cb' = WebContextAutomationStartedCallback
-> C_WebContextAutomationStartedCallback
wrap_WebContextAutomationStartedCallback WebContextAutomationStartedCallback
cb
    C_WebContextAutomationStartedCallback
-> IO (FunPtr C_WebContextAutomationStartedCallback)
mk_WebContextAutomationStartedCallback C_WebContextAutomationStartedCallback
cb' IO (FunPtr C_WebContextAutomationStartedCallback)
-> (FunPtr C_WebContextAutomationStartedCallback
    -> IO (GClosure C_WebContextAutomationStartedCallback))
-> IO (GClosure C_WebContextAutomationStartedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_WebContextAutomationStartedCallback
-> IO (GClosure C_WebContextAutomationStartedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `WebContextAutomationStartedCallback` into a `C_WebContextAutomationStartedCallback`.
wrap_WebContextAutomationStartedCallback ::
    WebContextAutomationStartedCallback ->
    C_WebContextAutomationStartedCallback
wrap_WebContextAutomationStartedCallback :: WebContextAutomationStartedCallback
-> C_WebContextAutomationStartedCallback
wrap_WebContextAutomationStartedCallback WebContextAutomationStartedCallback
_cb Ptr ()
_ Ptr AutomationSession
session Ptr ()
_ = do
    AutomationSession
session' <- ((ManagedPtr AutomationSession -> AutomationSession)
-> Ptr AutomationSession -> IO AutomationSession
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr AutomationSession -> AutomationSession
WebKit2.AutomationSession.AutomationSession) Ptr AutomationSession
session
    WebContextAutomationStartedCallback
_cb  AutomationSession
session'


-- | Connect a signal handler for the [automationStarted](#signal:automationStarted) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' webContext #automationStarted callback
-- @
-- 
-- 
onWebContextAutomationStarted :: (IsWebContext a, MonadIO m) => a -> WebContextAutomationStartedCallback -> m SignalHandlerId
onWebContextAutomationStarted :: a -> WebContextAutomationStartedCallback -> m SignalHandlerId
onWebContextAutomationStarted a
obj WebContextAutomationStartedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebContextAutomationStartedCallback
cb' = WebContextAutomationStartedCallback
-> C_WebContextAutomationStartedCallback
wrap_WebContextAutomationStartedCallback WebContextAutomationStartedCallback
cb
    FunPtr C_WebContextAutomationStartedCallback
cb'' <- C_WebContextAutomationStartedCallback
-> IO (FunPtr C_WebContextAutomationStartedCallback)
mk_WebContextAutomationStartedCallback C_WebContextAutomationStartedCallback
cb'
    a
-> Text
-> FunPtr C_WebContextAutomationStartedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"automation-started" FunPtr C_WebContextAutomationStartedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [automationStarted](#signal:automationStarted) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' webContext #automationStarted callback
-- @
-- 
-- 
afterWebContextAutomationStarted :: (IsWebContext a, MonadIO m) => a -> WebContextAutomationStartedCallback -> m SignalHandlerId
afterWebContextAutomationStarted :: a -> WebContextAutomationStartedCallback -> m SignalHandlerId
afterWebContextAutomationStarted a
obj WebContextAutomationStartedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebContextAutomationStartedCallback
cb' = WebContextAutomationStartedCallback
-> C_WebContextAutomationStartedCallback
wrap_WebContextAutomationStartedCallback WebContextAutomationStartedCallback
cb
    FunPtr C_WebContextAutomationStartedCallback
cb'' <- C_WebContextAutomationStartedCallback
-> IO (FunPtr C_WebContextAutomationStartedCallback)
mk_WebContextAutomationStartedCallback C_WebContextAutomationStartedCallback
cb'
    a
-> Text
-> FunPtr C_WebContextAutomationStartedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"automation-started" FunPtr C_WebContextAutomationStartedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebContextAutomationStartedSignalInfo
instance SignalInfo WebContextAutomationStartedSignalInfo where
    type HaskellCallbackType WebContextAutomationStartedSignalInfo = WebContextAutomationStartedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebContextAutomationStartedCallback cb
        cb'' <- mk_WebContextAutomationStartedCallback cb'
        connectSignalFunPtr obj "automation-started" cb'' connectMode detail

#endif

-- signal WebContext::download-started
-- | This signal is emitted when a new download request is made.
type WebContextDownloadStartedCallback =
    WebKit2.Download.Download
    -- ^ /@download@/: the t'GI.WebKit2.Objects.Download.Download' associated with this event
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `WebContextDownloadStartedCallback`@.
noWebContextDownloadStartedCallback :: Maybe WebContextDownloadStartedCallback
noWebContextDownloadStartedCallback :: Maybe WebContextDownloadStartedCallback
noWebContextDownloadStartedCallback = Maybe WebContextDownloadStartedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_WebContextDownloadStartedCallback =
    Ptr () ->                               -- object
    Ptr WebKit2.Download.Download ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_WebContextDownloadStartedCallback`.
foreign import ccall "wrapper"
    mk_WebContextDownloadStartedCallback :: C_WebContextDownloadStartedCallback -> IO (FunPtr C_WebContextDownloadStartedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_WebContextDownloadStarted :: MonadIO m => WebContextDownloadStartedCallback -> m (GClosure C_WebContextDownloadStartedCallback)
genClosure_WebContextDownloadStarted :: WebContextDownloadStartedCallback
-> m (GClosure C_WebContextDownloadStartedCallback)
genClosure_WebContextDownloadStarted WebContextDownloadStartedCallback
cb = IO (GClosure C_WebContextDownloadStartedCallback)
-> m (GClosure C_WebContextDownloadStartedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_WebContextDownloadStartedCallback)
 -> m (GClosure C_WebContextDownloadStartedCallback))
-> IO (GClosure C_WebContextDownloadStartedCallback)
-> m (GClosure C_WebContextDownloadStartedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebContextDownloadStartedCallback
cb' = WebContextDownloadStartedCallback
-> C_WebContextDownloadStartedCallback
wrap_WebContextDownloadStartedCallback WebContextDownloadStartedCallback
cb
    C_WebContextDownloadStartedCallback
-> IO (FunPtr C_WebContextDownloadStartedCallback)
mk_WebContextDownloadStartedCallback C_WebContextDownloadStartedCallback
cb' IO (FunPtr C_WebContextDownloadStartedCallback)
-> (FunPtr C_WebContextDownloadStartedCallback
    -> IO (GClosure C_WebContextDownloadStartedCallback))
-> IO (GClosure C_WebContextDownloadStartedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_WebContextDownloadStartedCallback
-> IO (GClosure C_WebContextDownloadStartedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `WebContextDownloadStartedCallback` into a `C_WebContextDownloadStartedCallback`.
wrap_WebContextDownloadStartedCallback ::
    WebContextDownloadStartedCallback ->
    C_WebContextDownloadStartedCallback
wrap_WebContextDownloadStartedCallback :: WebContextDownloadStartedCallback
-> C_WebContextDownloadStartedCallback
wrap_WebContextDownloadStartedCallback WebContextDownloadStartedCallback
_cb Ptr ()
_ Ptr Download
download Ptr ()
_ = do
    Download
download' <- ((ManagedPtr Download -> Download) -> Ptr Download -> IO Download
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Download -> Download
WebKit2.Download.Download) Ptr Download
download
    WebContextDownloadStartedCallback
_cb  Download
download'


-- | Connect a signal handler for the [downloadStarted](#signal:downloadStarted) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' webContext #downloadStarted callback
-- @
-- 
-- 
onWebContextDownloadStarted :: (IsWebContext a, MonadIO m) => a -> WebContextDownloadStartedCallback -> m SignalHandlerId
onWebContextDownloadStarted :: a -> WebContextDownloadStartedCallback -> m SignalHandlerId
onWebContextDownloadStarted a
obj WebContextDownloadStartedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebContextDownloadStartedCallback
cb' = WebContextDownloadStartedCallback
-> C_WebContextDownloadStartedCallback
wrap_WebContextDownloadStartedCallback WebContextDownloadStartedCallback
cb
    FunPtr C_WebContextDownloadStartedCallback
cb'' <- C_WebContextDownloadStartedCallback
-> IO (FunPtr C_WebContextDownloadStartedCallback)
mk_WebContextDownloadStartedCallback C_WebContextDownloadStartedCallback
cb'
    a
-> Text
-> FunPtr C_WebContextDownloadStartedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"download-started" FunPtr C_WebContextDownloadStartedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [downloadStarted](#signal:downloadStarted) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' webContext #downloadStarted callback
-- @
-- 
-- 
afterWebContextDownloadStarted :: (IsWebContext a, MonadIO m) => a -> WebContextDownloadStartedCallback -> m SignalHandlerId
afterWebContextDownloadStarted :: a -> WebContextDownloadStartedCallback -> m SignalHandlerId
afterWebContextDownloadStarted a
obj WebContextDownloadStartedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebContextDownloadStartedCallback
cb' = WebContextDownloadStartedCallback
-> C_WebContextDownloadStartedCallback
wrap_WebContextDownloadStartedCallback WebContextDownloadStartedCallback
cb
    FunPtr C_WebContextDownloadStartedCallback
cb'' <- C_WebContextDownloadStartedCallback
-> IO (FunPtr C_WebContextDownloadStartedCallback)
mk_WebContextDownloadStartedCallback C_WebContextDownloadStartedCallback
cb'
    a
-> Text
-> FunPtr C_WebContextDownloadStartedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"download-started" FunPtr C_WebContextDownloadStartedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebContextDownloadStartedSignalInfo
instance SignalInfo WebContextDownloadStartedSignalInfo where
    type HaskellCallbackType WebContextDownloadStartedSignalInfo = WebContextDownloadStartedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebContextDownloadStartedCallback cb
        cb'' <- mk_WebContextDownloadStartedCallback cb'
        connectSignalFunPtr obj "download-started" cb'' connectMode detail

#endif

-- signal WebContext::initialize-notification-permissions
-- | This signal is emitted when a t'GI.WebKit2.Objects.WebContext.WebContext' needs to set
-- initial notification permissions for a web process. It is emitted
-- when a new web process is about to be launched, and signals the
-- most appropriate moment to use
-- 'GI.WebKit2.Objects.WebContext.webContextInitializeNotificationPermissions'. If no
-- notification permissions have changed since the last time this
-- signal was emitted, then there is no need to call
-- 'GI.WebKit2.Objects.WebContext.webContextInitializeNotificationPermissions' again.
-- 
-- /Since: 2.16/
type WebContextInitializeNotificationPermissionsCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `WebContextInitializeNotificationPermissionsCallback`@.
noWebContextInitializeNotificationPermissionsCallback :: Maybe WebContextInitializeNotificationPermissionsCallback
noWebContextInitializeNotificationPermissionsCallback :: Maybe (IO ())
noWebContextInitializeNotificationPermissionsCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_WebContextInitializeNotificationPermissionsCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_WebContextInitializeNotificationPermissionsCallback`.
foreign import ccall "wrapper"
    mk_WebContextInitializeNotificationPermissionsCallback :: C_WebContextInitializeNotificationPermissionsCallback -> IO (FunPtr C_WebContextInitializeNotificationPermissionsCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_WebContextInitializeNotificationPermissions :: MonadIO m => WebContextInitializeNotificationPermissionsCallback -> m (GClosure C_WebContextInitializeNotificationPermissionsCallback)
genClosure_WebContextInitializeNotificationPermissions :: IO ()
-> m (GClosure
        C_WebContextInitializeNotificationPermissionsCallback)
genClosure_WebContextInitializeNotificationPermissions IO ()
cb = IO (GClosure C_WebContextInitializeNotificationPermissionsCallback)
-> m (GClosure
        C_WebContextInitializeNotificationPermissionsCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (GClosure C_WebContextInitializeNotificationPermissionsCallback)
 -> m (GClosure
         C_WebContextInitializeNotificationPermissionsCallback))
-> IO
     (GClosure C_WebContextInitializeNotificationPermissionsCallback)
-> m (GClosure
        C_WebContextInitializeNotificationPermissionsCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebContextInitializeNotificationPermissionsCallback
cb' = IO () -> C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeNotificationPermissionsCallback IO ()
cb
    C_WebContextInitializeNotificationPermissionsCallback
-> IO
     (FunPtr C_WebContextInitializeNotificationPermissionsCallback)
mk_WebContextInitializeNotificationPermissionsCallback C_WebContextInitializeNotificationPermissionsCallback
cb' IO (FunPtr C_WebContextInitializeNotificationPermissionsCallback)
-> (FunPtr C_WebContextInitializeNotificationPermissionsCallback
    -> IO
         (GClosure C_WebContextInitializeNotificationPermissionsCallback))
-> IO
     (GClosure C_WebContextInitializeNotificationPermissionsCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_WebContextInitializeNotificationPermissionsCallback
-> IO
     (GClosure C_WebContextInitializeNotificationPermissionsCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `WebContextInitializeNotificationPermissionsCallback` into a `C_WebContextInitializeNotificationPermissionsCallback`.
wrap_WebContextInitializeNotificationPermissionsCallback ::
    WebContextInitializeNotificationPermissionsCallback ->
    C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeNotificationPermissionsCallback :: IO () -> C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeNotificationPermissionsCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [initializeNotificationPermissions](#signal:initializeNotificationPermissions) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' webContext #initializeNotificationPermissions callback
-- @
-- 
-- 
onWebContextInitializeNotificationPermissions :: (IsWebContext a, MonadIO m) => a -> WebContextInitializeNotificationPermissionsCallback -> m SignalHandlerId
onWebContextInitializeNotificationPermissions :: a -> IO () -> m SignalHandlerId
onWebContextInitializeNotificationPermissions a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebContextInitializeNotificationPermissionsCallback
cb' = IO () -> C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeNotificationPermissionsCallback IO ()
cb
    FunPtr C_WebContextInitializeNotificationPermissionsCallback
cb'' <- C_WebContextInitializeNotificationPermissionsCallback
-> IO
     (FunPtr C_WebContextInitializeNotificationPermissionsCallback)
mk_WebContextInitializeNotificationPermissionsCallback C_WebContextInitializeNotificationPermissionsCallback
cb'
    a
-> Text
-> FunPtr C_WebContextInitializeNotificationPermissionsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"initialize-notification-permissions" FunPtr C_WebContextInitializeNotificationPermissionsCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [initializeNotificationPermissions](#signal:initializeNotificationPermissions) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' webContext #initializeNotificationPermissions callback
-- @
-- 
-- 
afterWebContextInitializeNotificationPermissions :: (IsWebContext a, MonadIO m) => a -> WebContextInitializeNotificationPermissionsCallback -> m SignalHandlerId
afterWebContextInitializeNotificationPermissions :: a -> IO () -> m SignalHandlerId
afterWebContextInitializeNotificationPermissions a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebContextInitializeNotificationPermissionsCallback
cb' = IO () -> C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeNotificationPermissionsCallback IO ()
cb
    FunPtr C_WebContextInitializeNotificationPermissionsCallback
cb'' <- C_WebContextInitializeNotificationPermissionsCallback
-> IO
     (FunPtr C_WebContextInitializeNotificationPermissionsCallback)
mk_WebContextInitializeNotificationPermissionsCallback C_WebContextInitializeNotificationPermissionsCallback
cb'
    a
-> Text
-> FunPtr C_WebContextInitializeNotificationPermissionsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"initialize-notification-permissions" FunPtr C_WebContextInitializeNotificationPermissionsCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebContextInitializeNotificationPermissionsSignalInfo
instance SignalInfo WebContextInitializeNotificationPermissionsSignalInfo where
    type HaskellCallbackType WebContextInitializeNotificationPermissionsSignalInfo = WebContextInitializeNotificationPermissionsCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebContextInitializeNotificationPermissionsCallback cb
        cb'' <- mk_WebContextInitializeNotificationPermissionsCallback cb'
        connectSignalFunPtr obj "initialize-notification-permissions" cb'' connectMode detail

#endif

-- signal WebContext::initialize-web-extensions
-- | This signal is emitted when a new web process is about to be
-- launched. It signals the most appropriate moment to use
-- 'GI.WebKit2.Objects.WebContext.webContextSetWebExtensionsInitializationUserData'
-- and 'GI.WebKit2.Objects.WebContext.webContextSetWebExtensionsDirectory'.
-- 
-- /Since: 2.4/
type WebContextInitializeWebExtensionsCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `WebContextInitializeWebExtensionsCallback`@.
noWebContextInitializeWebExtensionsCallback :: Maybe WebContextInitializeWebExtensionsCallback
noWebContextInitializeWebExtensionsCallback :: Maybe (IO ())
noWebContextInitializeWebExtensionsCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_WebContextInitializeWebExtensionsCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_WebContextInitializeWebExtensionsCallback`.
foreign import ccall "wrapper"
    mk_WebContextInitializeWebExtensionsCallback :: C_WebContextInitializeWebExtensionsCallback -> IO (FunPtr C_WebContextInitializeWebExtensionsCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_WebContextInitializeWebExtensions :: MonadIO m => WebContextInitializeWebExtensionsCallback -> m (GClosure C_WebContextInitializeWebExtensionsCallback)
genClosure_WebContextInitializeWebExtensions :: IO ()
-> m (GClosure
        C_WebContextInitializeNotificationPermissionsCallback)
genClosure_WebContextInitializeWebExtensions IO ()
cb = IO (GClosure C_WebContextInitializeNotificationPermissionsCallback)
-> m (GClosure
        C_WebContextInitializeNotificationPermissionsCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (GClosure C_WebContextInitializeNotificationPermissionsCallback)
 -> m (GClosure
         C_WebContextInitializeNotificationPermissionsCallback))
-> IO
     (GClosure C_WebContextInitializeNotificationPermissionsCallback)
-> m (GClosure
        C_WebContextInitializeNotificationPermissionsCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebContextInitializeNotificationPermissionsCallback
cb' = IO () -> C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeWebExtensionsCallback IO ()
cb
    C_WebContextInitializeNotificationPermissionsCallback
-> IO
     (FunPtr C_WebContextInitializeNotificationPermissionsCallback)
mk_WebContextInitializeWebExtensionsCallback C_WebContextInitializeNotificationPermissionsCallback
cb' IO (FunPtr C_WebContextInitializeNotificationPermissionsCallback)
-> (FunPtr C_WebContextInitializeNotificationPermissionsCallback
    -> IO
         (GClosure C_WebContextInitializeNotificationPermissionsCallback))
-> IO
     (GClosure C_WebContextInitializeNotificationPermissionsCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_WebContextInitializeNotificationPermissionsCallback
-> IO
     (GClosure C_WebContextInitializeNotificationPermissionsCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `WebContextInitializeWebExtensionsCallback` into a `C_WebContextInitializeWebExtensionsCallback`.
wrap_WebContextInitializeWebExtensionsCallback ::
    WebContextInitializeWebExtensionsCallback ->
    C_WebContextInitializeWebExtensionsCallback
wrap_WebContextInitializeWebExtensionsCallback :: IO () -> C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeWebExtensionsCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [initializeWebExtensions](#signal:initializeWebExtensions) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' webContext #initializeWebExtensions callback
-- @
-- 
-- 
onWebContextInitializeWebExtensions :: (IsWebContext a, MonadIO m) => a -> WebContextInitializeWebExtensionsCallback -> m SignalHandlerId
onWebContextInitializeWebExtensions :: a -> IO () -> m SignalHandlerId
onWebContextInitializeWebExtensions a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebContextInitializeNotificationPermissionsCallback
cb' = IO () -> C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeWebExtensionsCallback IO ()
cb
    FunPtr C_WebContextInitializeNotificationPermissionsCallback
cb'' <- C_WebContextInitializeNotificationPermissionsCallback
-> IO
     (FunPtr C_WebContextInitializeNotificationPermissionsCallback)
mk_WebContextInitializeWebExtensionsCallback C_WebContextInitializeNotificationPermissionsCallback
cb'
    a
-> Text
-> FunPtr C_WebContextInitializeNotificationPermissionsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"initialize-web-extensions" FunPtr C_WebContextInitializeNotificationPermissionsCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [initializeWebExtensions](#signal:initializeWebExtensions) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' webContext #initializeWebExtensions callback
-- @
-- 
-- 
afterWebContextInitializeWebExtensions :: (IsWebContext a, MonadIO m) => a -> WebContextInitializeWebExtensionsCallback -> m SignalHandlerId
afterWebContextInitializeWebExtensions :: a -> IO () -> m SignalHandlerId
afterWebContextInitializeWebExtensions a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebContextInitializeNotificationPermissionsCallback
cb' = IO () -> C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeWebExtensionsCallback IO ()
cb
    FunPtr C_WebContextInitializeNotificationPermissionsCallback
cb'' <- C_WebContextInitializeNotificationPermissionsCallback
-> IO
     (FunPtr C_WebContextInitializeNotificationPermissionsCallback)
mk_WebContextInitializeWebExtensionsCallback C_WebContextInitializeNotificationPermissionsCallback
cb'
    a
-> Text
-> FunPtr C_WebContextInitializeNotificationPermissionsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"initialize-web-extensions" FunPtr C_WebContextInitializeNotificationPermissionsCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebContextInitializeWebExtensionsSignalInfo
instance SignalInfo WebContextInitializeWebExtensionsSignalInfo where
    type HaskellCallbackType WebContextInitializeWebExtensionsSignalInfo = WebContextInitializeWebExtensionsCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebContextInitializeWebExtensionsCallback cb
        cb'' <- mk_WebContextInitializeWebExtensionsCallback cb'
        connectSignalFunPtr obj "initialize-web-extensions" cb'' connectMode detail

#endif

-- signal WebContext::user-message-received
-- | This signal is emitted when a t'GI.WebKit2.Objects.UserMessage.UserMessage' is received from a
-- @/WebKitWebExtension/@. You can reply to the message using
-- 'GI.WebKit2.Objects.UserMessage.userMessageSendReply'.
-- 
-- You can handle the user message asynchronously by calling 'GI.GObject.Objects.Object.objectRef' on
-- /@message@/ and returning 'P.True'.
-- 
-- /Since: 2.28/
type WebContextUserMessageReceivedCallback =
    WebKit2.UserMessage.UserMessage
    -- ^ /@message@/: the t'GI.WebKit2.Objects.UserMessage.UserMessage' received
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if the message was handled, or 'P.False' otherwise.

-- | A convenience synonym for @`Nothing` :: `Maybe` `WebContextUserMessageReceivedCallback`@.
noWebContextUserMessageReceivedCallback :: Maybe WebContextUserMessageReceivedCallback
noWebContextUserMessageReceivedCallback :: Maybe WebContextUserMessageReceivedCallback
noWebContextUserMessageReceivedCallback = Maybe WebContextUserMessageReceivedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_WebContextUserMessageReceivedCallback =
    Ptr () ->                               -- object
    Ptr WebKit2.UserMessage.UserMessage ->
    Ptr () ->                               -- user_data
    IO CInt

-- | Generate a function pointer callable from C code, from a `C_WebContextUserMessageReceivedCallback`.
foreign import ccall "wrapper"
    mk_WebContextUserMessageReceivedCallback :: C_WebContextUserMessageReceivedCallback -> IO (FunPtr C_WebContextUserMessageReceivedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_WebContextUserMessageReceived :: MonadIO m => WebContextUserMessageReceivedCallback -> m (GClosure C_WebContextUserMessageReceivedCallback)
genClosure_WebContextUserMessageReceived :: WebContextUserMessageReceivedCallback
-> m (GClosure C_WebContextUserMessageReceivedCallback)
genClosure_WebContextUserMessageReceived WebContextUserMessageReceivedCallback
cb = IO (GClosure C_WebContextUserMessageReceivedCallback)
-> m (GClosure C_WebContextUserMessageReceivedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_WebContextUserMessageReceivedCallback)
 -> m (GClosure C_WebContextUserMessageReceivedCallback))
-> IO (GClosure C_WebContextUserMessageReceivedCallback)
-> m (GClosure C_WebContextUserMessageReceivedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebContextUserMessageReceivedCallback
cb' = WebContextUserMessageReceivedCallback
-> C_WebContextUserMessageReceivedCallback
wrap_WebContextUserMessageReceivedCallback WebContextUserMessageReceivedCallback
cb
    C_WebContextUserMessageReceivedCallback
-> IO (FunPtr C_WebContextUserMessageReceivedCallback)
mk_WebContextUserMessageReceivedCallback C_WebContextUserMessageReceivedCallback
cb' IO (FunPtr C_WebContextUserMessageReceivedCallback)
-> (FunPtr C_WebContextUserMessageReceivedCallback
    -> IO (GClosure C_WebContextUserMessageReceivedCallback))
-> IO (GClosure C_WebContextUserMessageReceivedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_WebContextUserMessageReceivedCallback
-> IO (GClosure C_WebContextUserMessageReceivedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `WebContextUserMessageReceivedCallback` into a `C_WebContextUserMessageReceivedCallback`.
wrap_WebContextUserMessageReceivedCallback ::
    WebContextUserMessageReceivedCallback ->
    C_WebContextUserMessageReceivedCallback
wrap_WebContextUserMessageReceivedCallback :: WebContextUserMessageReceivedCallback
-> C_WebContextUserMessageReceivedCallback
wrap_WebContextUserMessageReceivedCallback WebContextUserMessageReceivedCallback
_cb Ptr ()
_ Ptr UserMessage
message Ptr ()
_ = do
    UserMessage
message' <- ((ManagedPtr UserMessage -> UserMessage)
-> Ptr UserMessage -> IO UserMessage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr UserMessage -> UserMessage
WebKit2.UserMessage.UserMessage) Ptr UserMessage
message
    Bool
result <- WebContextUserMessageReceivedCallback
_cb  UserMessage
message'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [userMessageReceived](#signal:userMessageReceived) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' webContext #userMessageReceived callback
-- @
-- 
-- 
onWebContextUserMessageReceived :: (IsWebContext a, MonadIO m) => a -> WebContextUserMessageReceivedCallback -> m SignalHandlerId
onWebContextUserMessageReceived :: a -> WebContextUserMessageReceivedCallback -> m SignalHandlerId
onWebContextUserMessageReceived a
obj WebContextUserMessageReceivedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebContextUserMessageReceivedCallback
cb' = WebContextUserMessageReceivedCallback
-> C_WebContextUserMessageReceivedCallback
wrap_WebContextUserMessageReceivedCallback WebContextUserMessageReceivedCallback
cb
    FunPtr C_WebContextUserMessageReceivedCallback
cb'' <- C_WebContextUserMessageReceivedCallback
-> IO (FunPtr C_WebContextUserMessageReceivedCallback)
mk_WebContextUserMessageReceivedCallback C_WebContextUserMessageReceivedCallback
cb'
    a
-> Text
-> FunPtr C_WebContextUserMessageReceivedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"user-message-received" FunPtr C_WebContextUserMessageReceivedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [userMessageReceived](#signal:userMessageReceived) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' webContext #userMessageReceived callback
-- @
-- 
-- 
afterWebContextUserMessageReceived :: (IsWebContext a, MonadIO m) => a -> WebContextUserMessageReceivedCallback -> m SignalHandlerId
afterWebContextUserMessageReceived :: a -> WebContextUserMessageReceivedCallback -> m SignalHandlerId
afterWebContextUserMessageReceived a
obj WebContextUserMessageReceivedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebContextUserMessageReceivedCallback
cb' = WebContextUserMessageReceivedCallback
-> C_WebContextUserMessageReceivedCallback
wrap_WebContextUserMessageReceivedCallback WebContextUserMessageReceivedCallback
cb
    FunPtr C_WebContextUserMessageReceivedCallback
cb'' <- C_WebContextUserMessageReceivedCallback
-> IO (FunPtr C_WebContextUserMessageReceivedCallback)
mk_WebContextUserMessageReceivedCallback C_WebContextUserMessageReceivedCallback
cb'
    a
-> Text
-> FunPtr C_WebContextUserMessageReceivedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"user-message-received" FunPtr C_WebContextUserMessageReceivedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebContextUserMessageReceivedSignalInfo
instance SignalInfo WebContextUserMessageReceivedSignalInfo where
    type HaskellCallbackType WebContextUserMessageReceivedSignalInfo = WebContextUserMessageReceivedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebContextUserMessageReceivedCallback cb
        cb'' <- mk_WebContextUserMessageReceivedCallback cb'
        connectSignalFunPtr obj "user-message-received" cb'' connectMode detail

#endif

-- VVV Prop "local-storage-directory"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@local-storage-directory@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' webContext #localStorageDirectory
-- @
getWebContextLocalStorageDirectory :: (MonadIO m, IsWebContext o) => o -> m (Maybe T.Text)
getWebContextLocalStorageDirectory :: o -> m (Maybe Text)
getWebContextLocalStorageDirectory 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 String
"local-storage-directory"

-- | Construct a `GValueConstruct` with valid value for the “@local-storage-directory@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructWebContextLocalStorageDirectory :: (IsWebContext o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructWebContextLocalStorageDirectory :: Text -> m (GValueConstruct o)
constructWebContextLocalStorageDirectory 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
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"local-storage-directory" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data WebContextLocalStorageDirectoryPropertyInfo
instance AttrInfo WebContextLocalStorageDirectoryPropertyInfo where
    type AttrAllowedOps WebContextLocalStorageDirectoryPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint WebContextLocalStorageDirectoryPropertyInfo = IsWebContext
    type AttrSetTypeConstraint WebContextLocalStorageDirectoryPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint WebContextLocalStorageDirectoryPropertyInfo = (~) T.Text
    type AttrTransferType WebContextLocalStorageDirectoryPropertyInfo = T.Text
    type AttrGetType WebContextLocalStorageDirectoryPropertyInfo = (Maybe T.Text)
    type AttrLabel WebContextLocalStorageDirectoryPropertyInfo = "local-storage-directory"
    type AttrOrigin WebContextLocalStorageDirectoryPropertyInfo = WebContext
    attrGet = getWebContextLocalStorageDirectory
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructWebContextLocalStorageDirectory
    attrClear = undefined
#endif

-- VVV Prop "process-swap-on-cross-site-navigation-enabled"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@process-swap-on-cross-site-navigation-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' webContext #processSwapOnCrossSiteNavigationEnabled
-- @
getWebContextProcessSwapOnCrossSiteNavigationEnabled :: (MonadIO m, IsWebContext o) => o -> m Bool
getWebContextProcessSwapOnCrossSiteNavigationEnabled :: o -> m Bool
getWebContextProcessSwapOnCrossSiteNavigationEnabled o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"process-swap-on-cross-site-navigation-enabled"

-- | Construct a `GValueConstruct` with valid value for the “@process-swap-on-cross-site-navigation-enabled@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructWebContextProcessSwapOnCrossSiteNavigationEnabled :: (IsWebContext o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructWebContextProcessSwapOnCrossSiteNavigationEnabled :: Bool -> m (GValueConstruct o)
constructWebContextProcessSwapOnCrossSiteNavigationEnabled Bool
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
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"process-swap-on-cross-site-navigation-enabled" Bool
val

#if defined(ENABLE_OVERLOADING)
data WebContextProcessSwapOnCrossSiteNavigationEnabledPropertyInfo
instance AttrInfo WebContextProcessSwapOnCrossSiteNavigationEnabledPropertyInfo where
    type AttrAllowedOps WebContextProcessSwapOnCrossSiteNavigationEnabledPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint WebContextProcessSwapOnCrossSiteNavigationEnabledPropertyInfo = IsWebContext
    type AttrSetTypeConstraint WebContextProcessSwapOnCrossSiteNavigationEnabledPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint WebContextProcessSwapOnCrossSiteNavigationEnabledPropertyInfo = (~) Bool
    type AttrTransferType WebContextProcessSwapOnCrossSiteNavigationEnabledPropertyInfo = Bool
    type AttrGetType WebContextProcessSwapOnCrossSiteNavigationEnabledPropertyInfo = Bool
    type AttrLabel WebContextProcessSwapOnCrossSiteNavigationEnabledPropertyInfo = "process-swap-on-cross-site-navigation-enabled"
    type AttrOrigin WebContextProcessSwapOnCrossSiteNavigationEnabledPropertyInfo = WebContext
    attrGet = getWebContextProcessSwapOnCrossSiteNavigationEnabled
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructWebContextProcessSwapOnCrossSiteNavigationEnabled
    attrClear = undefined
#endif

-- VVV Prop "website-data-manager"
   -- Type: TInterface (Name {namespace = "WebKit2", name = "WebsiteDataManager"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@website-data-manager@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' webContext #websiteDataManager
-- @
getWebContextWebsiteDataManager :: (MonadIO m, IsWebContext o) => o -> m WebKit2.WebsiteDataManager.WebsiteDataManager
getWebContextWebsiteDataManager :: o -> m WebsiteDataManager
getWebContextWebsiteDataManager o
obj = IO WebsiteDataManager -> m WebsiteDataManager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WebsiteDataManager -> m WebsiteDataManager)
-> IO WebsiteDataManager -> m WebsiteDataManager
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe WebsiteDataManager) -> IO WebsiteDataManager
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getWebContextWebsiteDataManager" (IO (Maybe WebsiteDataManager) -> IO WebsiteDataManager)
-> IO (Maybe WebsiteDataManager) -> IO WebsiteDataManager
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr WebsiteDataManager -> WebsiteDataManager)
-> IO (Maybe WebsiteDataManager)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"website-data-manager" ManagedPtr WebsiteDataManager -> WebsiteDataManager
WebKit2.WebsiteDataManager.WebsiteDataManager

-- | Construct a `GValueConstruct` with valid value for the “@website-data-manager@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructWebContextWebsiteDataManager :: (IsWebContext o, MIO.MonadIO m, WebKit2.WebsiteDataManager.IsWebsiteDataManager a) => a -> m (GValueConstruct o)
constructWebContextWebsiteDataManager :: a -> m (GValueConstruct o)
constructWebContextWebsiteDataManager a
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
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"website-data-manager" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data WebContextWebsiteDataManagerPropertyInfo
instance AttrInfo WebContextWebsiteDataManagerPropertyInfo where
    type AttrAllowedOps WebContextWebsiteDataManagerPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint WebContextWebsiteDataManagerPropertyInfo = IsWebContext
    type AttrSetTypeConstraint WebContextWebsiteDataManagerPropertyInfo = WebKit2.WebsiteDataManager.IsWebsiteDataManager
    type AttrTransferTypeConstraint WebContextWebsiteDataManagerPropertyInfo = WebKit2.WebsiteDataManager.IsWebsiteDataManager
    type AttrTransferType WebContextWebsiteDataManagerPropertyInfo = WebKit2.WebsiteDataManager.WebsiteDataManager
    type AttrGetType WebContextWebsiteDataManagerPropertyInfo = WebKit2.WebsiteDataManager.WebsiteDataManager
    type AttrLabel WebContextWebsiteDataManagerPropertyInfo = "website-data-manager"
    type AttrOrigin WebContextWebsiteDataManagerPropertyInfo = WebContext
    attrGet = getWebContextWebsiteDataManager
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo WebKit2.WebsiteDataManager.WebsiteDataManager v
    attrConstruct = constructWebContextWebsiteDataManager
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList WebContext
type instance O.AttributeList WebContext = WebContextAttributeList
type WebContextAttributeList = ('[ '("localStorageDirectory", WebContextLocalStorageDirectoryPropertyInfo), '("processSwapOnCrossSiteNavigationEnabled", WebContextProcessSwapOnCrossSiteNavigationEnabledPropertyInfo), '("websiteDataManager", WebContextWebsiteDataManagerPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
webContextLocalStorageDirectory :: AttrLabelProxy "localStorageDirectory"
webContextLocalStorageDirectory = AttrLabelProxy

webContextProcessSwapOnCrossSiteNavigationEnabled :: AttrLabelProxy "processSwapOnCrossSiteNavigationEnabled"
webContextProcessSwapOnCrossSiteNavigationEnabled = AttrLabelProxy

webContextWebsiteDataManager :: AttrLabelProxy "websiteDataManager"
webContextWebsiteDataManager = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList WebContext = WebContextSignalList
type WebContextSignalList = ('[ '("automationStarted", WebContextAutomationStartedSignalInfo), '("downloadStarted", WebContextDownloadStartedSignalInfo), '("initializeNotificationPermissions", WebContextInitializeNotificationPermissionsSignalInfo), '("initializeWebExtensions", WebContextInitializeWebExtensionsSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("userMessageReceived", WebContextUserMessageReceivedSignalInfo)] :: [(Symbol, *)])

#endif

-- method WebContext::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit2" , name = "WebContext" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_new" webkit_web_context_new :: 
    IO (Ptr WebContext)

-- | Create a new t'GI.WebKit2.Objects.WebContext.WebContext'
-- 
-- /Since: 2.8/
webContextNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m WebContext
    -- ^ __Returns:__ a newly created t'GI.WebKit2.Objects.WebContext.WebContext'
webContextNew :: m WebContext
webContextNew  = IO WebContext -> m WebContext
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WebContext -> m WebContext) -> IO WebContext -> m WebContext
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
result <- IO (Ptr WebContext)
webkit_web_context_new
    Text -> Ptr WebContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"webContextNew" Ptr WebContext
result
    WebContext
result' <- ((ManagedPtr WebContext -> WebContext)
-> Ptr WebContext -> IO WebContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr WebContext -> WebContext
WebContext) Ptr WebContext
result
    WebContext -> IO WebContext
forall (m :: * -> *) a. Monad m => a -> m a
return WebContext
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method WebContext::new_ephemeral
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit2" , name = "WebContext" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_new_ephemeral" webkit_web_context_new_ephemeral :: 
    IO (Ptr WebContext)

-- | Create a new ephemeral t'GI.WebKit2.Objects.WebContext.WebContext'. An ephemeral t'GI.WebKit2.Objects.WebContext.WebContext' is a context
-- created with an ephemeral t'GI.WebKit2.Objects.WebsiteDataManager.WebsiteDataManager'. This is just a convenient method
-- to create ephemeral contexts without having to create your own t'GI.WebKit2.Objects.WebsiteDataManager.WebsiteDataManager'.
-- All t'GI.WebKit2.Objects.WebView.WebView's associated with this context will also be ephemeral. Websites will
-- not store any data in the client storage.
-- This is normally used to implement private instances.
-- 
-- /Since: 2.16/
webContextNewEphemeral ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m WebContext
    -- ^ __Returns:__ a new ephemeral t'GI.WebKit2.Objects.WebContext.WebContext'.
webContextNewEphemeral :: m WebContext
webContextNewEphemeral  = IO WebContext -> m WebContext
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WebContext -> m WebContext) -> IO WebContext -> m WebContext
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
result <- IO (Ptr WebContext)
webkit_web_context_new_ephemeral
    Text -> Ptr WebContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"webContextNewEphemeral" Ptr WebContext
result
    WebContext
result' <- ((ManagedPtr WebContext -> WebContext)
-> Ptr WebContext -> IO WebContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr WebContext -> WebContext
WebContext) Ptr WebContext
result
    WebContext -> IO WebContext
forall (m :: * -> *) a. Monad m => a -> m a
return WebContext
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "webkit_web_context_new_with_website_data_manager" webkit_web_context_new_with_website_data_manager :: 
    Ptr WebKit2.WebsiteDataManager.WebsiteDataManager -> -- manager : TInterface (Name {namespace = "WebKit2", name = "WebsiteDataManager"})
    IO (Ptr WebContext)

-- | Create a new t'GI.WebKit2.Objects.WebContext.WebContext' with a t'GI.WebKit2.Objects.WebsiteDataManager.WebsiteDataManager'.
-- 
-- /Since: 2.10/
webContextNewWithWebsiteDataManager ::
    (B.CallStack.HasCallStack, MonadIO m, WebKit2.WebsiteDataManager.IsWebsiteDataManager a) =>
    a
    -- ^ /@manager@/: a t'GI.WebKit2.Objects.WebsiteDataManager.WebsiteDataManager'
    -> m WebContext
    -- ^ __Returns:__ a newly created t'GI.WebKit2.Objects.WebContext.WebContext'
webContextNewWithWebsiteDataManager :: a -> m WebContext
webContextNewWithWebsiteDataManager a
manager = IO WebContext -> m WebContext
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WebContext -> m WebContext) -> IO WebContext -> m WebContext
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebsiteDataManager
manager' <- a -> IO (Ptr WebsiteDataManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr WebContext
result <- Ptr WebsiteDataManager -> IO (Ptr WebContext)
webkit_web_context_new_with_website_data_manager Ptr WebsiteDataManager
manager'
    Text -> Ptr WebContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"webContextNewWithWebsiteDataManager" Ptr WebContext
result
    WebContext
result' <- ((ManagedPtr WebContext -> WebContext)
-> Ptr WebContext -> IO WebContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr WebContext -> WebContext
WebContext) Ptr WebContext
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    WebContext -> IO WebContext
forall (m :: * -> *) a. Monad m => a -> m a
return WebContext
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method WebContext::add_path_to_sandbox
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an absolute path to mount in the sandbox"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "read_only"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "if %TRUE the path will be read-only"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_add_path_to_sandbox" webkit_web_context_add_path_to_sandbox :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    CString ->                              -- path : TBasicType TFileName
    CInt ->                                 -- read_only : TBasicType TBoolean
    IO ()

-- | Adds a path to be mounted in the sandbox. /@path@/ must exist before any web process
-- has been created otherwise it will be silently ignored. It is a fatal error to
-- add paths after a web process has been spawned.
-- 
-- Paths in directories such as @\/sys@, @\/proc@, and @\/dev@ or all of @\/@
-- are not valid.
-- 
-- See also 'GI.WebKit2.Objects.WebContext.webContextSetSandboxEnabled'
-- 
-- /Since: 2.26/
webContextAddPathToSandbox ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> [Char]
    -- ^ /@path@/: an absolute path to mount in the sandbox
    -> Bool
    -- ^ /@readOnly@/: if 'P.True' the path will be read-only
    -> m ()
webContextAddPathToSandbox :: a -> String -> Bool -> m ()
webContextAddPathToSandbox a
context String
path Bool
readOnly = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
path' <- String -> IO CString
stringToCString String
path
    let readOnly' :: CInt
readOnly' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
readOnly
    Ptr WebContext -> CString -> CInt -> IO ()
webkit_web_context_add_path_to_sandbox Ptr WebContext
context' CString
path' CInt
readOnly'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextAddPathToSandboxMethodInfo
instance (signature ~ ([Char] -> Bool -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextAddPathToSandboxMethodInfo a signature where
    overloadedMethod = webContextAddPathToSandbox

#endif

-- method WebContext::allow_tls_certificate_for_host
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "certificate"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsCertificate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsCertificate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "host"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the host for which a certificate is to be allowed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_allow_tls_certificate_for_host" webkit_web_context_allow_tls_certificate_for_host :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    Ptr Gio.TlsCertificate.TlsCertificate -> -- certificate : TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
    CString ->                              -- host : TBasicType TUTF8
    IO ()

-- | Ignore further TLS errors on the /@host@/ for the certificate present in /@info@/.
-- 
-- /Since: 2.6/
webContextAllowTlsCertificateForHost ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a, Gio.TlsCertificate.IsTlsCertificate b) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> b
    -- ^ /@certificate@/: a t'GI.Gio.Objects.TlsCertificate.TlsCertificate'
    -> T.Text
    -- ^ /@host@/: the host for which a certificate is to be allowed
    -> m ()
webContextAllowTlsCertificateForHost :: a -> b -> Text -> m ()
webContextAllowTlsCertificateForHost a
context b
certificate Text
host = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr TlsCertificate
certificate' <- b -> IO (Ptr TlsCertificate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
certificate
    CString
host' <- Text -> IO CString
textToCString Text
host
    Ptr WebContext -> Ptr TlsCertificate -> CString -> IO ()
webkit_web_context_allow_tls_certificate_for_host Ptr WebContext
context' Ptr TlsCertificate
certificate' CString
host'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
certificate
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
host'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextAllowTlsCertificateForHostMethodInfo
instance (signature ~ (b -> T.Text -> m ()), MonadIO m, IsWebContext a, Gio.TlsCertificate.IsTlsCertificate b) => O.MethodInfo WebContextAllowTlsCertificateForHostMethodInfo a signature where
    overloadedMethod = webContextAllowTlsCertificateForHost

#endif

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

foreign import ccall "webkit_web_context_clear_cache" webkit_web_context_clear_cache :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO ()

-- | Clears all resources currently cached.
-- See also 'GI.WebKit2.Objects.WebContext.webContextSetCacheModel'.
webContextClearCache ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m ()
webContextClearCache :: a -> m ()
webContextClearCache a
context = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr WebContext -> IO ()
webkit_web_context_clear_cache Ptr WebContext
context'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextClearCacheMethodInfo
instance (signature ~ (m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextClearCacheMethodInfo a signature where
    overloadedMethod = webContextClearCache

#endif

-- method WebContext::download_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the URI to download"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit2" , name = "Download" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_download_uri" webkit_web_context_download_uri :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    CString ->                              -- uri : TBasicType TUTF8
    IO (Ptr WebKit2.Download.Download)

-- | Requests downloading of the specified URI string. The download operation
-- will not be associated to any t'GI.WebKit2.Objects.WebView.WebView', if you are interested in
-- starting a download from a particular t'GI.WebKit2.Objects.WebView.WebView' use
-- 'GI.WebKit2.Objects.WebView.webViewDownloadUri' instead.
webContextDownloadUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> T.Text
    -- ^ /@uri@/: the URI to download
    -> m WebKit2.Download.Download
    -- ^ __Returns:__ a new t'GI.WebKit2.Objects.Download.Download' representing
    --    the download operation.
webContextDownloadUri :: a -> Text -> m Download
webContextDownloadUri a
context Text
uri = IO Download -> m Download
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Download -> m Download) -> IO Download -> m Download
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    Ptr Download
result <- Ptr WebContext -> CString -> IO (Ptr Download)
webkit_web_context_download_uri Ptr WebContext
context' CString
uri'
    Text -> Ptr Download -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"webContextDownloadUri" Ptr Download
result
    Download
result' <- ((ManagedPtr Download -> Download) -> Ptr Download -> IO Download
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Download -> Download
WebKit2.Download.Download) Ptr Download
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
    Download -> IO Download
forall (m :: * -> *) a. Monad m => a -> m a
return Download
result'

#if defined(ENABLE_OVERLOADING)
data WebContextDownloadUriMethodInfo
instance (signature ~ (T.Text -> m WebKit2.Download.Download), MonadIO m, IsWebContext a) => O.MethodInfo WebContextDownloadUriMethodInfo a signature where
    overloadedMethod = webContextDownloadUri

#endif

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

foreign import ccall "webkit_web_context_get_cache_model" webkit_web_context_get_cache_model :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO CUInt

-- | Returns the current cache model. For more information about this
-- value check the documentation of the function
-- 'GI.WebKit2.Objects.WebContext.webContextSetCacheModel'.
webContextGetCacheModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m WebKit2.Enums.CacheModel
    -- ^ __Returns:__ the current t'GI.WebKit2.Enums.CacheModel'
webContextGetCacheModel :: a -> m CacheModel
webContextGetCacheModel a
context = IO CacheModel -> m CacheModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CacheModel -> m CacheModel) -> IO CacheModel -> m CacheModel
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CUInt
result <- Ptr WebContext -> IO CUInt
webkit_web_context_get_cache_model Ptr WebContext
context'
    let result' :: CacheModel
result' = (Int -> CacheModel
forall a. Enum a => Int -> a
toEnum (Int -> CacheModel) -> (CUInt -> Int) -> CUInt -> CacheModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CacheModel -> IO CacheModel
forall (m :: * -> *) a. Monad m => a -> m a
return CacheModel
result'

#if defined(ENABLE_OVERLOADING)
data WebContextGetCacheModelMethodInfo
instance (signature ~ (m WebKit2.Enums.CacheModel), MonadIO m, IsWebContext a) => O.MethodInfo WebContextGetCacheModelMethodInfo a signature where
    overloadedMethod = webContextGetCacheModel

#endif

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

foreign import ccall "webkit_web_context_get_cookie_manager" webkit_web_context_get_cookie_manager :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO (Ptr WebKit2.CookieManager.CookieManager)

-- | Get the t'GI.WebKit2.Objects.CookieManager.CookieManager' of the /@context@/\'s t'GI.WebKit2.Objects.WebsiteDataManager.WebsiteDataManager'.
webContextGetCookieManager ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m WebKit2.CookieManager.CookieManager
    -- ^ __Returns:__ the t'GI.WebKit2.Objects.CookieManager.CookieManager' of /@context@/.
webContextGetCookieManager :: a -> m CookieManager
webContextGetCookieManager a
context = IO CookieManager -> m CookieManager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CookieManager -> m CookieManager)
-> IO CookieManager -> m CookieManager
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr CookieManager
result <- Ptr WebContext -> IO (Ptr CookieManager)
webkit_web_context_get_cookie_manager Ptr WebContext
context'
    Text -> Ptr CookieManager -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"webContextGetCookieManager" Ptr CookieManager
result
    CookieManager
result' <- ((ManagedPtr CookieManager -> CookieManager)
-> Ptr CookieManager -> IO CookieManager
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr CookieManager -> CookieManager
WebKit2.CookieManager.CookieManager) Ptr CookieManager
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CookieManager -> IO CookieManager
forall (m :: * -> *) a. Monad m => a -> m a
return CookieManager
result'

#if defined(ENABLE_OVERLOADING)
data WebContextGetCookieManagerMethodInfo
instance (signature ~ (m WebKit2.CookieManager.CookieManager), MonadIO m, IsWebContext a) => O.MethodInfo WebContextGetCookieManagerMethodInfo a signature where
    overloadedMethod = webContextGetCookieManager

#endif

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

foreign import ccall "webkit_web_context_get_favicon_database" webkit_web_context_get_favicon_database :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO (Ptr WebKit2.FaviconDatabase.FaviconDatabase)

-- | Get the t'GI.WebKit2.Objects.FaviconDatabase.FaviconDatabase' associated with /@context@/.
-- 
-- To initialize the database you need to call
-- 'GI.WebKit2.Objects.WebContext.webContextSetFaviconDatabaseDirectory'.
webContextGetFaviconDatabase ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m WebKit2.FaviconDatabase.FaviconDatabase
    -- ^ __Returns:__ the t'GI.WebKit2.Objects.FaviconDatabase.FaviconDatabase' of /@context@/.
webContextGetFaviconDatabase :: a -> m FaviconDatabase
webContextGetFaviconDatabase a
context = IO FaviconDatabase -> m FaviconDatabase
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FaviconDatabase -> m FaviconDatabase)
-> IO FaviconDatabase -> m FaviconDatabase
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr FaviconDatabase
result <- Ptr WebContext -> IO (Ptr FaviconDatabase)
webkit_web_context_get_favicon_database Ptr WebContext
context'
    Text -> Ptr FaviconDatabase -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"webContextGetFaviconDatabase" Ptr FaviconDatabase
result
    FaviconDatabase
result' <- ((ManagedPtr FaviconDatabase -> FaviconDatabase)
-> Ptr FaviconDatabase -> IO FaviconDatabase
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr FaviconDatabase -> FaviconDatabase
WebKit2.FaviconDatabase.FaviconDatabase) Ptr FaviconDatabase
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    FaviconDatabase -> IO FaviconDatabase
forall (m :: * -> *) a. Monad m => a -> m a
return FaviconDatabase
result'

#if defined(ENABLE_OVERLOADING)
data WebContextGetFaviconDatabaseMethodInfo
instance (signature ~ (m WebKit2.FaviconDatabase.FaviconDatabase), MonadIO m, IsWebContext a) => O.MethodInfo WebContextGetFaviconDatabaseMethodInfo a signature where
    overloadedMethod = webContextGetFaviconDatabase

#endif

-- method WebContext::get_favicon_database_directory
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , 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_web_context_get_favicon_database_directory" webkit_web_context_get_favicon_database_directory :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO CString

-- | Get the directory path being used to store the favicons database
-- for /@context@/, or 'P.Nothing' if
-- 'GI.WebKit2.Objects.WebContext.webContextSetFaviconDatabaseDirectory' hasn\'t been
-- called yet.
-- 
-- This function will always return the same path after having called
-- 'GI.WebKit2.Objects.WebContext.webContextSetFaviconDatabaseDirectory' for the first
-- time.
webContextGetFaviconDatabaseDirectory ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the path of the directory of the favicons
    -- database associated with /@context@/, or 'P.Nothing'.
webContextGetFaviconDatabaseDirectory :: a -> m (Maybe Text)
webContextGetFaviconDatabaseDirectory a
context = 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
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
result <- Ptr WebContext -> IO CString
webkit_web_context_get_favicon_database_directory Ptr WebContext
context'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data WebContextGetFaviconDatabaseDirectoryMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsWebContext a) => O.MethodInfo WebContextGetFaviconDatabaseDirectoryMethodInfo a signature where
    overloadedMethod = webContextGetFaviconDatabaseDirectory

#endif

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

foreign import ccall "webkit_web_context_get_geolocation_manager" webkit_web_context_get_geolocation_manager :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO (Ptr WebKit2.GeolocationManager.GeolocationManager)

-- | Get the t'GI.WebKit2.Objects.GeolocationManager.GeolocationManager' of /@context@/.
-- 
-- /Since: 2.26/
webContextGetGeolocationManager ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m WebKit2.GeolocationManager.GeolocationManager
    -- ^ __Returns:__ the t'GI.WebKit2.Objects.GeolocationManager.GeolocationManager' of /@context@/.
webContextGetGeolocationManager :: a -> m GeolocationManager
webContextGetGeolocationManager a
context = IO GeolocationManager -> m GeolocationManager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GeolocationManager -> m GeolocationManager)
-> IO GeolocationManager -> m GeolocationManager
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr GeolocationManager
result <- Ptr WebContext -> IO (Ptr GeolocationManager)
webkit_web_context_get_geolocation_manager Ptr WebContext
context'
    Text -> Ptr GeolocationManager -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"webContextGetGeolocationManager" Ptr GeolocationManager
result
    GeolocationManager
result' <- ((ManagedPtr GeolocationManager -> GeolocationManager)
-> Ptr GeolocationManager -> IO GeolocationManager
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr GeolocationManager -> GeolocationManager
WebKit2.GeolocationManager.GeolocationManager) Ptr GeolocationManager
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    GeolocationManager -> IO GeolocationManager
forall (m :: * -> *) a. Monad m => a -> m a
return GeolocationManager
result'

#if defined(ENABLE_OVERLOADING)
data WebContextGetGeolocationManagerMethodInfo
instance (signature ~ (m WebKit2.GeolocationManager.GeolocationManager), MonadIO m, IsWebContext a) => O.MethodInfo WebContextGetGeolocationManagerMethodInfo a signature where
    overloadedMethod = webContextGetGeolocationManager

#endif

-- method WebContext::get_plugins
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable or %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GAsyncReadyCallback to call when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_get_plugins" webkit_web_context_get_plugins :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously get the list of installed plugins.
-- 
-- When the operation is finished, /@callback@/ will be called. You can then call
-- 'GI.WebKit2.Objects.WebContext.webContextGetPluginsFinish' to get the result of the operation.
webContextGetPlugins ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    -> m ()
webContextGetPlugins :: a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
webContextGetPlugins a
context Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr WebContext
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
webkit_web_context_get_plugins Ptr WebContext
context' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextGetPluginsMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsWebContext a, Gio.Cancellable.IsCancellable b) => O.MethodInfo WebContextGetPluginsMethodInfo a signature where
    overloadedMethod = webContextGetPlugins

#endif

-- method WebContext::get_plugins_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "WebKit2" , name = "Plugin" }))
-- throws : True
-- Skip return : False

foreign import ccall "webkit_web_context_get_plugins_finish" webkit_web_context_get_plugins_finish :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr (GList (Ptr WebKit2.Plugin.Plugin)))

-- | Finish an asynchronous operation started with webkit_web_context_get_plugins.
webContextGetPluginsFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m [WebKit2.Plugin.Plugin]
    -- ^ __Returns:__ a t'GI.GLib.Structs.List.List' of t'GI.WebKit2.Objects.Plugin.Plugin'. You must free the t'GI.GLib.Structs.List.List' with
    --    @/g_list_free()/@ and unref the t'GI.WebKit2.Objects.Plugin.Plugin's with 'GI.GObject.Objects.Object.objectUnref' when you\'re done with them. /(Can throw 'Data.GI.Base.GError.GError')/
webContextGetPluginsFinish :: a -> b -> m [Plugin]
webContextGetPluginsFinish a
context b
result_ = IO [Plugin] -> m [Plugin]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Plugin] -> m [Plugin]) -> IO [Plugin] -> m [Plugin]
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO [Plugin] -> IO () -> IO [Plugin]
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr (GList (Ptr Plugin))
result <- (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr Plugin))))
-> IO (Ptr (GList (Ptr Plugin)))
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr (GList (Ptr Plugin))))
 -> IO (Ptr (GList (Ptr Plugin))))
-> (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr Plugin))))
-> IO (Ptr (GList (Ptr Plugin)))
forall a b. (a -> b) -> a -> b
$ Ptr WebContext
-> Ptr AsyncResult
-> Ptr (Ptr GError)
-> IO (Ptr (GList (Ptr Plugin)))
webkit_web_context_get_plugins_finish Ptr WebContext
context' Ptr AsyncResult
result_'
        [Ptr Plugin]
result' <- Ptr (GList (Ptr Plugin)) -> IO [Ptr Plugin]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Plugin))
result
        [Plugin]
result'' <- (Ptr Plugin -> IO Plugin) -> [Ptr Plugin] -> IO [Plugin]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Plugin -> Plugin) -> Ptr Plugin -> IO Plugin
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Plugin -> Plugin
WebKit2.Plugin.Plugin) [Ptr Plugin]
result'
        Ptr (GList (Ptr Plugin)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Plugin))
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        [Plugin] -> IO [Plugin]
forall (m :: * -> *) a. Monad m => a -> m a
return [Plugin]
result''
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data WebContextGetPluginsFinishMethodInfo
instance (signature ~ (b -> m [WebKit2.Plugin.Plugin]), MonadIO m, IsWebContext a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo WebContextGetPluginsFinishMethodInfo a signature where
    overloadedMethod = webContextGetPluginsFinish

#endif

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

foreign import ccall "webkit_web_context_get_process_model" webkit_web_context_get_process_model :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO CUInt

-- | Returns the current process model. For more information about this value
-- see 'GI.WebKit2.Objects.WebContext.webContextSetProcessModel'.
-- 
-- /Since: 2.4/
webContextGetProcessModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m WebKit2.Enums.ProcessModel
    -- ^ __Returns:__ the current t'GI.WebKit2.Enums.ProcessModel'
webContextGetProcessModel :: a -> m ProcessModel
webContextGetProcessModel a
context = IO ProcessModel -> m ProcessModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessModel -> m ProcessModel)
-> IO ProcessModel -> m ProcessModel
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CUInt
result <- Ptr WebContext -> IO CUInt
webkit_web_context_get_process_model Ptr WebContext
context'
    let result' :: ProcessModel
result' = (Int -> ProcessModel
forall a. Enum a => Int -> a
toEnum (Int -> ProcessModel) -> (CUInt -> Int) -> CUInt -> ProcessModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    ProcessModel -> IO ProcessModel
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessModel
result'

#if defined(ENABLE_OVERLOADING)
data WebContextGetProcessModelMethodInfo
instance (signature ~ (m WebKit2.Enums.ProcessModel), MonadIO m, IsWebContext a) => O.MethodInfo WebContextGetProcessModelMethodInfo a signature where
    overloadedMethod = webContextGetProcessModel

#endif

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

foreign import ccall "webkit_web_context_get_sandbox_enabled" webkit_web_context_get_sandbox_enabled :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO CInt

-- | Get whether sandboxing is currently enabled.
-- 
-- /Since: 2.26/
webContextGetSandboxEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if sandboxing is enabled, or 'P.False' otherwise.
webContextGetSandboxEnabled :: a -> m Bool
webContextGetSandboxEnabled a
context = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CInt
result <- Ptr WebContext -> IO CInt
webkit_web_context_get_sandbox_enabled Ptr WebContext
context'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data WebContextGetSandboxEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsWebContext a) => O.MethodInfo WebContextGetSandboxEnabledMethodInfo a signature where
    overloadedMethod = webContextGetSandboxEnabled

#endif

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

foreign import ccall "webkit_web_context_get_security_manager" webkit_web_context_get_security_manager :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO (Ptr WebKit2.SecurityManager.SecurityManager)

-- | Get the t'GI.WebKit2.Objects.SecurityManager.SecurityManager' of /@context@/.
webContextGetSecurityManager ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m WebKit2.SecurityManager.SecurityManager
    -- ^ __Returns:__ the t'GI.WebKit2.Objects.SecurityManager.SecurityManager' of /@context@/.
webContextGetSecurityManager :: a -> m SecurityManager
webContextGetSecurityManager a
context = IO SecurityManager -> m SecurityManager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SecurityManager -> m SecurityManager)
-> IO SecurityManager -> m SecurityManager
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr SecurityManager
result <- Ptr WebContext -> IO (Ptr SecurityManager)
webkit_web_context_get_security_manager Ptr WebContext
context'
    Text -> Ptr SecurityManager -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"webContextGetSecurityManager" Ptr SecurityManager
result
    SecurityManager
result' <- ((ManagedPtr SecurityManager -> SecurityManager)
-> Ptr SecurityManager -> IO SecurityManager
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SecurityManager -> SecurityManager
WebKit2.SecurityManager.SecurityManager) Ptr SecurityManager
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    SecurityManager -> IO SecurityManager
forall (m :: * -> *) a. Monad m => a -> m a
return SecurityManager
result'

#if defined(ENABLE_OVERLOADING)
data WebContextGetSecurityManagerMethodInfo
instance (signature ~ (m WebKit2.SecurityManager.SecurityManager), MonadIO m, IsWebContext a) => O.MethodInfo WebContextGetSecurityManagerMethodInfo a signature where
    overloadedMethod = webContextGetSecurityManager

#endif

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

foreign import ccall "webkit_web_context_get_spell_checking_enabled" webkit_web_context_get_spell_checking_enabled :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO CInt

-- | Get whether spell checking feature is currently enabled.
webContextGetSpellCheckingEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m Bool
    -- ^ __Returns:__ 'P.True' If spell checking is enabled, or 'P.False' otherwise.
webContextGetSpellCheckingEnabled :: a -> m Bool
webContextGetSpellCheckingEnabled a
context = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CInt
result <- Ptr WebContext -> IO CInt
webkit_web_context_get_spell_checking_enabled Ptr WebContext
context'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data WebContextGetSpellCheckingEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsWebContext a) => O.MethodInfo WebContextGetSpellCheckingEnabledMethodInfo a signature where
    overloadedMethod = webContextGetSpellCheckingEnabled

#endif

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

foreign import ccall "webkit_web_context_get_spell_checking_languages" webkit_web_context_get_spell_checking_languages :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO (Ptr CString)

-- | Get the the list of spell checking languages associated with
-- /@context@/, or 'P.Nothing' if no languages have been previously set.
-- 
-- See 'GI.WebKit2.Objects.WebContext.webContextSetSpellCheckingLanguages' for more
-- details on the format of the languages in the list.
webContextGetSpellCheckingLanguages ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m (Maybe [T.Text])
    -- ^ __Returns:__ A 'P.Nothing'-terminated
    --    array of languages if available, or 'P.Nothing' otherwise.
webContextGetSpellCheckingLanguages :: a -> m (Maybe [Text])
webContextGetSpellCheckingLanguages a
context = 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
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr CString
result <- Ptr WebContext -> IO (Ptr CString)
webkit_web_context_get_spell_checking_languages Ptr WebContext
context'
    Maybe [Text]
maybeResult <- Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CString
result ((Ptr CString -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr CString
result' -> do
        [Text]
result'' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result'
        [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Maybe [Text] -> IO (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
maybeResult

#if defined(ENABLE_OVERLOADING)
data WebContextGetSpellCheckingLanguagesMethodInfo
instance (signature ~ (m (Maybe [T.Text])), MonadIO m, IsWebContext a) => O.MethodInfo WebContextGetSpellCheckingLanguagesMethodInfo a signature where
    overloadedMethod = webContextGetSpellCheckingLanguages

#endif

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

foreign import ccall "webkit_web_context_get_tls_errors_policy" webkit_web_context_get_tls_errors_policy :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO CUInt

-- | Get the TLS errors policy of /@context@/
webContextGetTlsErrorsPolicy ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m WebKit2.Enums.TLSErrorsPolicy
    -- ^ __Returns:__ a t'GI.WebKit2.Enums.TLSErrorsPolicy'
webContextGetTlsErrorsPolicy :: a -> m TLSErrorsPolicy
webContextGetTlsErrorsPolicy a
context = IO TLSErrorsPolicy -> m TLSErrorsPolicy
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TLSErrorsPolicy -> m TLSErrorsPolicy)
-> IO TLSErrorsPolicy -> m TLSErrorsPolicy
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CUInt
result <- Ptr WebContext -> IO CUInt
webkit_web_context_get_tls_errors_policy Ptr WebContext
context'
    let result' :: TLSErrorsPolicy
result' = (Int -> TLSErrorsPolicy
forall a. Enum a => Int -> a
toEnum (Int -> TLSErrorsPolicy)
-> (CUInt -> Int) -> CUInt -> TLSErrorsPolicy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    TLSErrorsPolicy -> IO TLSErrorsPolicy
forall (m :: * -> *) a. Monad m => a -> m a
return TLSErrorsPolicy
result'

#if defined(ENABLE_OVERLOADING)
data WebContextGetTlsErrorsPolicyMethodInfo
instance (signature ~ (m WebKit2.Enums.TLSErrorsPolicy), MonadIO m, IsWebContext a) => O.MethodInfo WebContextGetTlsErrorsPolicyMethodInfo a signature where
    overloadedMethod = webContextGetTlsErrorsPolicy

#endif

-- method WebContext::get_web_process_count_limit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #WebKitWebContext"
--                 , 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 "webkit_web_context_get_web_process_count_limit" webkit_web_context_get_web_process_count_limit :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO Word32

{-# DEPRECATED webContextGetWebProcessCountLimit ["(Since version 2.26)"] #-}
-- | Gets the maximum number of web processes that can be created at the same time for the /@context@/.
-- 
-- This function is now deprecated and always returns 0 (no limit). See also 'GI.WebKit2.Objects.WebContext.webContextSetWebProcessCountLimit'.
-- 
-- /Since: 2.10/
webContextGetWebProcessCountLimit ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m Word32
    -- ^ __Returns:__ the maximum limit of web processes, or 0 if there isn\'t a limit.
webContextGetWebProcessCountLimit :: a -> m Word32
webContextGetWebProcessCountLimit a
context = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Word32
result <- Ptr WebContext -> IO Word32
webkit_web_context_get_web_process_count_limit Ptr WebContext
context'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data WebContextGetWebProcessCountLimitMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsWebContext a) => O.MethodInfo WebContextGetWebProcessCountLimitMethodInfo a signature where
    overloadedMethod = webContextGetWebProcessCountLimit

#endif

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

foreign import ccall "webkit_web_context_get_website_data_manager" webkit_web_context_get_website_data_manager :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO (Ptr WebKit2.WebsiteDataManager.WebsiteDataManager)

-- | Get the t'GI.WebKit2.Objects.WebsiteDataManager.WebsiteDataManager' of /@context@/.
-- 
-- /Since: 2.10/
webContextGetWebsiteDataManager ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m WebKit2.WebsiteDataManager.WebsiteDataManager
    -- ^ __Returns:__ a t'GI.WebKit2.Objects.WebsiteDataManager.WebsiteDataManager'
webContextGetWebsiteDataManager :: a -> m WebsiteDataManager
webContextGetWebsiteDataManager a
context = IO WebsiteDataManager -> m WebsiteDataManager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WebsiteDataManager -> m WebsiteDataManager)
-> IO WebsiteDataManager -> m WebsiteDataManager
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr WebsiteDataManager
result <- Ptr WebContext -> IO (Ptr WebsiteDataManager)
webkit_web_context_get_website_data_manager Ptr WebContext
context'
    Text -> Ptr WebsiteDataManager -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"webContextGetWebsiteDataManager" Ptr WebsiteDataManager
result
    WebsiteDataManager
result' <- ((ManagedPtr WebsiteDataManager -> WebsiteDataManager)
-> Ptr WebsiteDataManager -> IO WebsiteDataManager
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr WebsiteDataManager -> WebsiteDataManager
WebKit2.WebsiteDataManager.WebsiteDataManager) Ptr WebsiteDataManager
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    WebsiteDataManager -> IO WebsiteDataManager
forall (m :: * -> *) a. Monad m => a -> m a
return WebsiteDataManager
result'

#if defined(ENABLE_OVERLOADING)
data WebContextGetWebsiteDataManagerMethodInfo
instance (signature ~ (m WebKit2.WebsiteDataManager.WebsiteDataManager), MonadIO m, IsWebContext a) => O.MethodInfo WebContextGetWebsiteDataManagerMethodInfo a signature where
    overloadedMethod = webContextGetWebsiteDataManager

#endif

-- method WebContext::initialize_notification_permissions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allowed_origins"
--           , argType =
--               TGList
--                 (TInterface
--                    Name { namespace = "WebKit2" , name = "SecurityOrigin" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GList of security origins"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "disallowed_origins"
--           , argType =
--               TGList
--                 (TInterface
--                    Name { namespace = "WebKit2" , name = "SecurityOrigin" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GList of security origins"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_initialize_notification_permissions" webkit_web_context_initialize_notification_permissions :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    Ptr (GList (Ptr WebKit2.SecurityOrigin.SecurityOrigin)) -> -- allowed_origins : TGList (TInterface (Name {namespace = "WebKit2", name = "SecurityOrigin"}))
    Ptr (GList (Ptr WebKit2.SecurityOrigin.SecurityOrigin)) -> -- disallowed_origins : TGList (TInterface (Name {namespace = "WebKit2", name = "SecurityOrigin"}))
    IO ()

-- | Sets initial desktop notification permissions for the /@context@/.
-- /@allowedOrigins@/ and /@disallowedOrigins@/ must each be t'GI.GLib.Structs.List.List' of
-- t'GI.WebKit2.Structs.SecurityOrigin.SecurityOrigin' objects representing origins that will,
-- respectively, either always or never have permission to show desktop
-- notifications. No t'GI.WebKit2.Objects.NotificationPermissionRequest.NotificationPermissionRequest' will ever be
-- generated for any of the security origins represented in
-- /@allowedOrigins@/ or /@disallowedOrigins@/. This function is necessary
-- because some webpages proactively check whether they have permission
-- to display notifications without ever creating a permission request.
-- 
-- This function only affects web processes that have not already been
-- created. The best time to call it is when handling
-- [initializeNotificationPermissions]("GI.WebKit2.Objects.WebContext#g:signal:initializeNotificationPermissions") so as to
-- ensure that new web processes receive the most recent set of
-- permissions.
-- 
-- /Since: 2.16/
webContextInitializeNotificationPermissions ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit2.Objects.WebContext.WebContext'
    -> [WebKit2.SecurityOrigin.SecurityOrigin]
    -- ^ /@allowedOrigins@/: a t'GI.GLib.Structs.List.List' of security origins
    -> [WebKit2.SecurityOrigin.SecurityOrigin]
    -- ^ /@disallowedOrigins@/: a t'GI.GLib.Structs.List.List' of security origins
    -> m ()
webContextInitializeNotificationPermissions :: a -> [SecurityOrigin] -> [SecurityOrigin] -> m ()
webContextInitializeNotificationPermissions a
context [SecurityOrigin]
allowedOrigins [SecurityOrigin]
disallowedOrigins = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    [Ptr SecurityOrigin]
allowedOrigins' <- (SecurityOrigin -> IO (Ptr SecurityOrigin))
-> [SecurityOrigin] -> IO [Ptr SecurityOrigin]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SecurityOrigin -> IO (Ptr SecurityOrigin)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [SecurityOrigin]
allowedOrigins
    Ptr (GList (Ptr SecurityOrigin))
allowedOrigins'' <- [Ptr SecurityOrigin] -> IO (Ptr (GList (Ptr SecurityOrigin)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr SecurityOrigin]
allowedOrigins'
    [Ptr SecurityOrigin]
disallowedOrigins' <- (SecurityOrigin -> IO (Ptr SecurityOrigin))
-> [SecurityOrigin] -> IO [Ptr SecurityOrigin]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SecurityOrigin -> IO (Ptr SecurityOrigin)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [SecurityOrigin]
disallowedOrigins
    Ptr (GList (Ptr SecurityOrigin))
disallowedOrigins'' <- [Ptr SecurityOrigin] -> IO (Ptr (GList (Ptr SecurityOrigin)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr SecurityOrigin]
disallowedOrigins'
    Ptr WebContext
-> Ptr (GList (Ptr SecurityOrigin))
-> Ptr (GList (Ptr SecurityOrigin))
-> IO ()
webkit_web_context_initialize_notification_permissions Ptr WebContext
context' Ptr (GList (Ptr SecurityOrigin))
allowedOrigins'' Ptr (GList (Ptr SecurityOrigin))
disallowedOrigins''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    (SecurityOrigin -> IO ()) -> [SecurityOrigin] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SecurityOrigin -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [SecurityOrigin]
allowedOrigins
    (SecurityOrigin -> IO ()) -> [SecurityOrigin] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SecurityOrigin -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [SecurityOrigin]
disallowedOrigins
    Ptr (GList (Ptr SecurityOrigin)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr SecurityOrigin))
allowedOrigins''
    Ptr (GList (Ptr SecurityOrigin)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr SecurityOrigin))
disallowedOrigins''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextInitializeNotificationPermissionsMethodInfo
instance (signature ~ ([WebKit2.SecurityOrigin.SecurityOrigin] -> [WebKit2.SecurityOrigin.SecurityOrigin] -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextInitializeNotificationPermissionsMethodInfo a signature where
    overloadedMethod = webContextInitializeNotificationPermissions

#endif

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

foreign import ccall "webkit_web_context_is_automation_allowed" webkit_web_context_is_automation_allowed :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO CInt

-- | Get whether automation is allowed in /@context@/.
-- See also 'GI.WebKit2.Objects.WebContext.webContextSetAutomationAllowed'.
-- 
-- /Since: 2.18/
webContextIsAutomationAllowed ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if automation is allowed or 'P.False' otherwise.
webContextIsAutomationAllowed :: a -> m Bool
webContextIsAutomationAllowed a
context = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CInt
result <- Ptr WebContext -> IO CInt
webkit_web_context_is_automation_allowed Ptr WebContext
context'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data WebContextIsAutomationAllowedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsWebContext a) => O.MethodInfo WebContextIsAutomationAllowedMethodInfo a signature where
    overloadedMethod = webContextIsAutomationAllowed

#endif

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

foreign import ccall "webkit_web_context_is_ephemeral" webkit_web_context_is_ephemeral :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    IO CInt

-- | Get whether a t'GI.WebKit2.Objects.WebContext.WebContext' is ephemeral.
-- 
-- /Since: 2.16/
webContextIsEphemeral ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit2.Objects.WebContext.WebContext'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@context@/ is ephemeral or 'P.False' otherwise.
webContextIsEphemeral :: a -> m Bool
webContextIsEphemeral a
context = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CInt
result <- Ptr WebContext -> IO CInt
webkit_web_context_is_ephemeral Ptr WebContext
context'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data WebContextIsEphemeralMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsWebContext a) => O.MethodInfo WebContextIsEphemeralMethodInfo a signature where
    overloadedMethod = webContextIsEphemeral

#endif

-- method WebContext::prefetch_dns
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hostname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a hostname to be resolved"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_prefetch_dns" webkit_web_context_prefetch_dns :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    CString ->                              -- hostname : TBasicType TUTF8
    IO ()

-- | Resolve the domain name of the given /@hostname@/ in advance, so that if a URI
-- of /@hostname@/ is requested the load will be performed more quickly.
webContextPrefetchDns ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> T.Text
    -- ^ /@hostname@/: a hostname to be resolved
    -> m ()
webContextPrefetchDns :: a -> Text -> m ()
webContextPrefetchDns a
context Text
hostname = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
hostname' <- Text -> IO CString
textToCString Text
hostname
    Ptr WebContext -> CString -> IO ()
webkit_web_context_prefetch_dns Ptr WebContext
context' CString
hostname'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
hostname'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextPrefetchDnsMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextPrefetchDnsMethodInfo a signature where
    overloadedMethod = webContextPrefetchDns

#endif

-- method WebContext::register_uri_scheme
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the network scheme to register"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "URISchemeRequestCallback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitURISchemeRequestCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 3
--           , argDestroy = 4
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data_destroy_func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notify for @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_register_uri_scheme" webkit_web_context_register_uri_scheme :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    CString ->                              -- scheme : TBasicType TUTF8
    FunPtr WebKit2.Callbacks.C_URISchemeRequestCallback -> -- callback : TInterface (Name {namespace = "WebKit2", name = "URISchemeRequestCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- user_data_destroy_func : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Register /@scheme@/ in /@context@/, so that when an URI request with /@scheme@/ is made in the
-- t'GI.WebKit2.Objects.WebContext.WebContext', the t'GI.WebKit2.Callbacks.URISchemeRequestCallback' registered will be called with a
-- t'GI.WebKit2.Objects.URISchemeRequest.URISchemeRequest'.
-- It is possible to handle URI scheme requests asynchronously, by calling 'GI.GObject.Objects.Object.objectRef' on the
-- t'GI.WebKit2.Objects.URISchemeRequest.URISchemeRequest' and calling 'GI.WebKit2.Objects.URISchemeRequest.uRISchemeRequestFinish' later
-- when the data of the request is available or
-- 'GI.WebKit2.Objects.URISchemeRequest.uRISchemeRequestFinishError' in case of error.
-- 
-- \<informalexample>\<programlisting>
-- static void
-- about_uri_scheme_request_cb (WebKitURISchemeRequest *request,
--                              gpointer                user_data)
-- {
--     GInputStream *stream;
--     gsize         stream_length;
--     const gchar  *path;
-- 
--     path = webkit_uri_scheme_request_get_path (request);
--     if (!g_strcmp0 (path, \"plugins\")) {
--         \/\<!-- -->* Create a GInputStream with the contents of plugins about page, and set its length to stream_length *\<!-- -->\/
--     } else if (!g_strcmp0 (path, \"memory\")) {
--         \/\<!-- -->* Create a GInputStream with the contents of memory about page, and set its length to stream_length *\<!-- -->\/
--     } else if (!g_strcmp0 (path, \"applications\")) {
--         \/\<!-- -->* Create a GInputStream with the contents of applications about page, and set its length to stream_length *\<!-- -->\/
--     } else if (!g_strcmp0 (path, \"example\")) {
--         gchar *contents;
-- 
--         contents = g_strdup_printf (\"&lt;html&gt;&lt;body&gt;&lt;p&gt;Example about page&lt;\/p&gt;&lt;\/body&gt;&lt;\/html&gt;\");
--         stream_length = strlen (contents);
--         stream = g_memory_input_stream_new_from_data (contents, stream_length, g_free);
--     } else {
--         GError *error;
-- 
--         error = g_error_new (ABOUT_HANDLER_ERROR, ABOUT_HANDLER_ERROR_INVALID, \"Invalid about:@/s/@ page.\", path);
--         webkit_uri_scheme_request_finish_error (request, error);
--         g_error_free (error);
--         return;
--     }
--     webkit_uri_scheme_request_finish (request, stream, stream_length, \"text\/html\");
--     g_object_unref (stream);
-- }
-- \<\/programlisting>\<\/informalexample>
webContextRegisterUriScheme ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> T.Text
    -- ^ /@scheme@/: the network scheme to register
    -> WebKit2.Callbacks.URISchemeRequestCallback
    -- ^ /@callback@/: a t'GI.WebKit2.Callbacks.URISchemeRequestCallback'
    -> m ()
webContextRegisterUriScheme :: a -> Text -> URISchemeRequestCallback -> m ()
webContextRegisterUriScheme a
context Text
scheme URISchemeRequestCallback
callback = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
scheme' <- Text -> IO CString
textToCString Text
scheme
    FunPtr C_URISchemeRequestCallback
callback' <- C_URISchemeRequestCallback
-> IO (FunPtr C_URISchemeRequestCallback)
WebKit2.Callbacks.mk_URISchemeRequestCallback (Maybe (Ptr (FunPtr C_URISchemeRequestCallback))
-> URISchemeRequestCallback_WithClosures
-> C_URISchemeRequestCallback
WebKit2.Callbacks.wrap_URISchemeRequestCallback Maybe (Ptr (FunPtr C_URISchemeRequestCallback))
forall a. Maybe a
Nothing (URISchemeRequestCallback -> URISchemeRequestCallback_WithClosures
WebKit2.Callbacks.drop_closures_URISchemeRequestCallback URISchemeRequestCallback
callback))
    let userData :: Ptr ()
userData = FunPtr C_URISchemeRequestCallback -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_URISchemeRequestCallback
callback'
    let userDataDestroyFunc :: FunPtr (Ptr a -> IO ())
userDataDestroyFunc = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr WebContext
-> CString
-> FunPtr C_URISchemeRequestCallback
-> Ptr ()
-> FunPtr (Ptr () -> IO ())
-> IO ()
webkit_web_context_register_uri_scheme Ptr WebContext
context' CString
scheme' FunPtr C_URISchemeRequestCallback
callback' Ptr ()
userData FunPtr (Ptr () -> IO ())
forall a. FunPtr (Ptr a -> IO ())
userDataDestroyFunc
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
scheme'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextRegisterUriSchemeMethodInfo
instance (signature ~ (T.Text -> WebKit2.Callbacks.URISchemeRequestCallback -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextRegisterUriSchemeMethodInfo a signature where
    overloadedMethod = webContextRegisterUriScheme

#endif

-- method WebContext::send_message_to_all_extensions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "UserMessage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserMessage"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_send_message_to_all_extensions" webkit_web_context_send_message_to_all_extensions :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    Ptr WebKit2.UserMessage.UserMessage ->  -- message : TInterface (Name {namespace = "WebKit2", name = "UserMessage"})
    IO ()

-- | Send /@message@/ to all @/WebKitWebExtension/@s associated to /@context@/.
-- If /@message@/ is floating, it\'s consumed.
-- 
-- /Since: 2.28/
webContextSendMessageToAllExtensions ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a, WebKit2.UserMessage.IsUserMessage b) =>
    a
    -- ^ /@context@/: the t'GI.WebKit2.Objects.WebContext.WebContext'
    -> b
    -- ^ /@message@/: a t'GI.WebKit2.Objects.UserMessage.UserMessage'
    -> m ()
webContextSendMessageToAllExtensions :: a -> b -> m ()
webContextSendMessageToAllExtensions a
context b
message = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr UserMessage
message' <- b -> IO (Ptr UserMessage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
message
    Ptr WebContext -> Ptr UserMessage -> IO ()
webkit_web_context_send_message_to_all_extensions Ptr WebContext
context' Ptr UserMessage
message'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
message
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSendMessageToAllExtensionsMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsWebContext a, WebKit2.UserMessage.IsUserMessage b) => O.MethodInfo WebContextSendMessageToAllExtensionsMethodInfo a signature where
    overloadedMethod = webContextSendMessageToAllExtensions

#endif

-- method WebContext::set_additional_plugins_directory
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "directory"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the directory to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_set_additional_plugins_directory" webkit_web_context_set_additional_plugins_directory :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    CString ->                              -- directory : TBasicType TUTF8
    IO ()

-- | Set an additional directory where WebKit will look for plugins.
webContextSetAdditionalPluginsDirectory ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> T.Text
    -- ^ /@directory@/: the directory to add
    -> m ()
webContextSetAdditionalPluginsDirectory :: a -> Text -> m ()
webContextSetAdditionalPluginsDirectory a
context Text
directory = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
directory' <- Text -> IO CString
textToCString Text
directory
    Ptr WebContext -> CString -> IO ()
webkit_web_context_set_additional_plugins_directory Ptr WebContext
context' CString
directory'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
directory'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetAdditionalPluginsDirectoryMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextSetAdditionalPluginsDirectoryMethodInfo a signature where
    overloadedMethod = webContextSetAdditionalPluginsDirectory

#endif

-- method WebContext::set_automation_allowed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allowed"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_set_automation_allowed" webkit_web_context_set_automation_allowed :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    CInt ->                                 -- allowed : TBasicType TBoolean
    IO ()

-- | Set whether automation is allowed in /@context@/. When automation is enabled the browser could
-- be controlled by another process by requesting an automation session. When a new automation
-- session is requested the signal [automationStarted]("GI.WebKit2.Objects.WebContext#g:signal:automationStarted") is emitted.
-- Automation is disabled by default, so you need to explicitly call this method passing 'P.True'
-- to enable it.
-- 
-- Note that only one t'GI.WebKit2.Objects.WebContext.WebContext' can have automation enabled, so this will do nothing
-- if there\'s another t'GI.WebKit2.Objects.WebContext.WebContext' with automation already enabled.
-- 
-- /Since: 2.18/
webContextSetAutomationAllowed ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit2.Objects.WebContext.WebContext'
    -> Bool
    -- ^ /@allowed@/: value to set
    -> m ()
webContextSetAutomationAllowed :: a -> Bool -> m ()
webContextSetAutomationAllowed a
context Bool
allowed = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    let allowed' :: CInt
allowed' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
allowed
    Ptr WebContext -> CInt -> IO ()
webkit_web_context_set_automation_allowed Ptr WebContext
context' CInt
allowed'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetAutomationAllowedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextSetAutomationAllowedMethodInfo a signature where
    overloadedMethod = webContextSetAutomationAllowed

#endif

-- method WebContext::set_cache_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cache_model"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "CacheModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitCacheModel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_set_cache_model" webkit_web_context_set_cache_model :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    CUInt ->                                -- cache_model : TInterface (Name {namespace = "WebKit2", name = "CacheModel"})
    IO ()

-- | Specifies a usage model for WebViews, which WebKit will use to
-- determine its caching behavior. All web views follow the cache
-- model. This cache model determines the RAM and disk space to use
-- for caching previously viewed content .
-- 
-- Research indicates that users tend to browse within clusters of
-- documents that hold resources in common, and to revisit previously
-- visited documents. WebKit and the frameworks below it include
-- built-in caches that take advantage of these patterns,
-- substantially improving document load speed in browsing
-- situations. The WebKit cache model controls the behaviors of all of
-- these caches, including various WebCore caches.
-- 
-- Browsers can improve document load speed substantially by
-- specifying 'GI.WebKit2.Enums.CacheModelWebBrowser'. Applications without a
-- browsing interface can reduce memory usage substantially by
-- specifying 'GI.WebKit2.Enums.CacheModelDocumentViewer'. The default value is
-- 'GI.WebKit2.Enums.CacheModelWebBrowser'.
webContextSetCacheModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit2.Objects.WebContext.WebContext'
    -> WebKit2.Enums.CacheModel
    -- ^ /@cacheModel@/: a t'GI.WebKit2.Enums.CacheModel'
    -> m ()
webContextSetCacheModel :: a -> CacheModel -> m ()
webContextSetCacheModel a
context CacheModel
cacheModel = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    let cacheModel' :: CUInt
cacheModel' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (CacheModel -> Int) -> CacheModel -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CacheModel -> Int
forall a. Enum a => a -> Int
fromEnum) CacheModel
cacheModel
    Ptr WebContext -> CUInt -> IO ()
webkit_web_context_set_cache_model Ptr WebContext
context' CUInt
cacheModel'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetCacheModelMethodInfo
instance (signature ~ (WebKit2.Enums.CacheModel -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextSetCacheModelMethodInfo a signature where
    overloadedMethod = webContextSetCacheModel

#endif

-- method WebContext::set_disk_cache_directory
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "directory"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the directory to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_set_disk_cache_directory" webkit_web_context_set_disk_cache_directory :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    CString ->                              -- directory : TBasicType TUTF8
    IO ()

{-# DEPRECATED webContextSetDiskCacheDirectory ["(Since version 2.10.)","Use 'GI.WebKit2.Objects.WebContext.webContextNewWithWebsiteDataManager' instead."] #-}
-- | Set the directory where disk cache files will be stored
-- This method must be called before loading anything in this context, otherwise
-- it will not have any effect.
-- 
-- Note that this method overrides the directory set in the t'GI.WebKit2.Objects.WebsiteDataManager.WebsiteDataManager',
-- but it doesn\'t change the value returned by 'GI.WebKit2.Objects.WebsiteDataManager.websiteDataManagerGetDiskCacheDirectory'
-- since the t'GI.WebKit2.Objects.WebsiteDataManager.WebsiteDataManager' is immutable.
webContextSetDiskCacheDirectory ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> T.Text
    -- ^ /@directory@/: the directory to set
    -> m ()
webContextSetDiskCacheDirectory :: a -> Text -> m ()
webContextSetDiskCacheDirectory a
context Text
directory = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
directory' <- Text -> IO CString
textToCString Text
directory
    Ptr WebContext -> CString -> IO ()
webkit_web_context_set_disk_cache_directory Ptr WebContext
context' CString
directory'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
directory'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetDiskCacheDirectoryMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextSetDiskCacheDirectoryMethodInfo a signature where
    overloadedMethod = webContextSetDiskCacheDirectory

#endif

-- method WebContext::set_favicon_database_directory
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an absolute path to the icon database\ndirectory or %NULL to use the defaults"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_set_favicon_database_directory" webkit_web_context_set_favicon_database_directory :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    CString ->                              -- path : TBasicType TUTF8
    IO ()

-- | Set the directory path to be used to store the favicons database
-- for /@context@/ on disk. Passing 'P.Nothing' as /@path@/ means using the
-- default directory for the platform (see 'GI.GLib.Functions.getUserCacheDir').
-- 
-- Calling this method also means enabling the favicons database for
-- its use from the applications, so that\'s why it\'s expected to be
-- called only once. Further calls for the same instance of
-- t'GI.WebKit2.Objects.WebContext.WebContext' won\'t cause any effect.
webContextSetFaviconDatabaseDirectory ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> Maybe (T.Text)
    -- ^ /@path@/: an absolute path to the icon database
    -- directory or 'P.Nothing' to use the defaults
    -> m ()
webContextSetFaviconDatabaseDirectory :: a -> Maybe Text -> m ()
webContextSetFaviconDatabaseDirectory a
context Maybe Text
path = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
maybePath <- case Maybe Text
path of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jPath -> do
            CString
jPath' <- Text -> IO CString
textToCString Text
jPath
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jPath'
    Ptr WebContext -> CString -> IO ()
webkit_web_context_set_favicon_database_directory Ptr WebContext
context' CString
maybePath
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePath
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetFaviconDatabaseDirectoryMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextSetFaviconDatabaseDirectoryMethodInfo a signature where
    overloadedMethod = webContextSetFaviconDatabaseDirectory

#endif

-- method WebContext::set_network_proxy_settings
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "proxy_mode"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "NetworkProxyMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkProxyMode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "proxy_settings"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "NetworkProxySettings" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkProxySettings, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_set_network_proxy_settings" webkit_web_context_set_network_proxy_settings :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    CUInt ->                                -- proxy_mode : TInterface (Name {namespace = "WebKit2", name = "NetworkProxyMode"})
    Ptr WebKit2.NetworkProxySettings.NetworkProxySettings -> -- proxy_settings : TInterface (Name {namespace = "WebKit2", name = "NetworkProxySettings"})
    IO ()

-- | Set the network proxy settings to be used by connections started in /@context@/.
-- By default 'GI.WebKit2.Enums.NetworkProxyModeDefault' is used, which means that the
-- system settings will be used ('GI.Gio.Functions.proxyResolverGetDefault').
-- If you want to override the system default settings, you can either use
-- 'GI.WebKit2.Enums.NetworkProxyModeNoProxy' to make sure no proxies are used at all,
-- or 'GI.WebKit2.Enums.NetworkProxyModeCustom' to provide your own proxy settings.
-- When /@proxyMode@/ is 'GI.WebKit2.Enums.NetworkProxyModeCustom' /@proxySettings@/ must be
-- a valid t'GI.WebKit2.Structs.NetworkProxySettings.NetworkProxySettings'; otherwise, /@proxySettings@/ must be 'P.Nothing'.
-- 
-- /Since: 2.16/
webContextSetNetworkProxySettings ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> WebKit2.Enums.NetworkProxyMode
    -- ^ /@proxyMode@/: a t'GI.WebKit2.Enums.NetworkProxyMode'
    -> Maybe (WebKit2.NetworkProxySettings.NetworkProxySettings)
    -- ^ /@proxySettings@/: a t'GI.WebKit2.Structs.NetworkProxySettings.NetworkProxySettings', or 'P.Nothing'
    -> m ()
webContextSetNetworkProxySettings :: a -> NetworkProxyMode -> Maybe NetworkProxySettings -> m ()
webContextSetNetworkProxySettings a
context NetworkProxyMode
proxyMode Maybe NetworkProxySettings
proxySettings = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    let proxyMode' :: CUInt
proxyMode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (NetworkProxyMode -> Int) -> NetworkProxyMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkProxyMode -> Int
forall a. Enum a => a -> Int
fromEnum) NetworkProxyMode
proxyMode
    Ptr NetworkProxySettings
maybeProxySettings <- case Maybe NetworkProxySettings
proxySettings of
        Maybe NetworkProxySettings
Nothing -> Ptr NetworkProxySettings -> IO (Ptr NetworkProxySettings)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr NetworkProxySettings
forall a. Ptr a
nullPtr
        Just NetworkProxySettings
jProxySettings -> do
            Ptr NetworkProxySettings
jProxySettings' <- NetworkProxySettings -> IO (Ptr NetworkProxySettings)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr NetworkProxySettings
jProxySettings
            Ptr NetworkProxySettings -> IO (Ptr NetworkProxySettings)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr NetworkProxySettings
jProxySettings'
    Ptr WebContext -> CUInt -> Ptr NetworkProxySettings -> IO ()
webkit_web_context_set_network_proxy_settings Ptr WebContext
context' CUInt
proxyMode' Ptr NetworkProxySettings
maybeProxySettings
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Maybe NetworkProxySettings
-> (NetworkProxySettings -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe NetworkProxySettings
proxySettings NetworkProxySettings -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetNetworkProxySettingsMethodInfo
instance (signature ~ (WebKit2.Enums.NetworkProxyMode -> Maybe (WebKit2.NetworkProxySettings.NetworkProxySettings) -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextSetNetworkProxySettingsMethodInfo a signature where
    overloadedMethod = webContextSetNetworkProxySettings

#endif

-- method WebContext::set_preferred_languages
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "languages"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a %NULL-terminated list of language identifiers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_set_preferred_languages" webkit_web_context_set_preferred_languages :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    Ptr CString ->                          -- languages : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO ()

-- | Set the list of preferred languages, sorted from most desirable
-- to least desirable. The list will be used to build the \"Accept-Language\"
-- header that will be included in the network requests started by
-- the t'GI.WebKit2.Objects.WebContext.WebContext'.
webContextSetPreferredLanguages ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> Maybe ([T.Text])
    -- ^ /@languages@/: a 'P.Nothing'-terminated list of language identifiers
    -> m ()
webContextSetPreferredLanguages :: a -> Maybe [Text] -> m ()
webContextSetPreferredLanguages a
context Maybe [Text]
languages = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr CString
maybeLanguages <- case Maybe [Text]
languages of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jLanguages -> do
            Ptr CString
jLanguages' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jLanguages
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jLanguages'
    Ptr WebContext -> Ptr CString -> IO ()
webkit_web_context_set_preferred_languages Ptr WebContext
context' Ptr CString
maybeLanguages
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeLanguages
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeLanguages
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetPreferredLanguagesMethodInfo
instance (signature ~ (Maybe ([T.Text]) -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextSetPreferredLanguagesMethodInfo a signature where
    overloadedMethod = webContextSetPreferredLanguages

#endif

-- method WebContext::set_process_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "process_model"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "ProcessModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitProcessModel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_set_process_model" webkit_web_context_set_process_model :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    CUInt ->                                -- process_model : TInterface (Name {namespace = "WebKit2", name = "ProcessModel"})
    IO ()

-- | Specifies a process model for WebViews, which WebKit will use to
-- determine how auxiliary processes are handled.
-- 
-- 'GI.WebKit2.Enums.ProcessModelMultipleSecondaryProcesses' will use
-- one process per view most of the time, while still allowing for web
-- views to share a process when needed (for example when different
-- views interact with each other). Using this model, when a process
-- hangs or crashes, only the WebViews using it stop working, while
-- the rest of the WebViews in the application will still function
-- normally.
-- 
-- 'GI.WebKit2.Enums.ProcessModelSharedSecondaryProcess' is deprecated since 2.26,
-- using it has no effect for security reasons.
-- 
-- This method **must be called before any web process has been created**,
-- as early as possible in your application. Calling it later will make
-- your application crash.
-- 
-- /Since: 2.4/
webContextSetProcessModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit2.Objects.WebContext.WebContext'
    -> WebKit2.Enums.ProcessModel
    -- ^ /@processModel@/: a t'GI.WebKit2.Enums.ProcessModel'
    -> m ()
webContextSetProcessModel :: a -> ProcessModel -> m ()
webContextSetProcessModel a
context ProcessModel
processModel = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    let processModel' :: CUInt
processModel' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ProcessModel -> Int) -> ProcessModel -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessModel -> Int
forall a. Enum a => a -> Int
fromEnum) ProcessModel
processModel
    Ptr WebContext -> CUInt -> IO ()
webkit_web_context_set_process_model Ptr WebContext
context' CUInt
processModel'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetProcessModelMethodInfo
instance (signature ~ (WebKit2.Enums.ProcessModel -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextSetProcessModelMethodInfo a signature where
    overloadedMethod = webContextSetProcessModel

#endif

-- method WebContext::set_sandbox_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "if %TRUE enable sandboxing"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_set_sandbox_enabled" webkit_web_context_set_sandbox_enabled :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Set whether WebKit subprocesses will be sandboxed, limiting access to the system.
-- 
-- This method **must be called before any web process has been created**,
-- as early as possible in your application. Calling it later is a fatal error.
-- 
-- This is only implemented on Linux and is a no-op otherwise.
-- 
-- /Since: 2.26/
webContextSetSandboxEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> Bool
    -- ^ /@enabled@/: if 'P.True' enable sandboxing
    -> m ()
webContextSetSandboxEnabled :: a -> Bool -> m ()
webContextSetSandboxEnabled a
context Bool
enabled = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
enabled
    Ptr WebContext -> CInt -> IO ()
webkit_web_context_set_sandbox_enabled Ptr WebContext
context' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetSandboxEnabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextSetSandboxEnabledMethodInfo a signature where
    overloadedMethod = webContextSetSandboxEnabled

#endif

-- method WebContext::set_spell_checking_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Value to be set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_set_spell_checking_enabled" webkit_web_context_set_spell_checking_enabled :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Enable or disable the spell checking feature.
webContextSetSpellCheckingEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> Bool
    -- ^ /@enabled@/: Value to be set
    -> m ()
webContextSetSpellCheckingEnabled :: a -> Bool -> m ()
webContextSetSpellCheckingEnabled a
context Bool
enabled = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
enabled
    Ptr WebContext -> CInt -> IO ()
webkit_web_context_set_spell_checking_enabled Ptr WebContext
context' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetSpellCheckingEnabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextSetSpellCheckingEnabledMethodInfo a signature where
    overloadedMethod = webContextSetSpellCheckingEnabled

#endif

-- method WebContext::set_spell_checking_languages
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "languages"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a %NULL-terminated list of spell checking languages"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_set_spell_checking_languages" webkit_web_context_set_spell_checking_languages :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    Ptr CString ->                          -- languages : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO ()

-- | Set the list of spell checking languages to be used for spell
-- checking.
-- 
-- The locale string typically is in the form lang_COUNTRY, where lang
-- is an ISO-639 language code, and COUNTRY is an ISO-3166 country code.
-- For instance, sv_FI for Swedish as written in Finland or pt_BR
-- for Portuguese as written in Brazil.
-- 
-- You need to call this function with a valid list of languages at
-- least once in order to properly enable the spell checking feature
-- in WebKit.
webContextSetSpellCheckingLanguages ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> [T.Text]
    -- ^ /@languages@/: a 'P.Nothing'-terminated list of spell checking languages
    -> m ()
webContextSetSpellCheckingLanguages :: a -> [Text] -> m ()
webContextSetSpellCheckingLanguages a
context [Text]
languages = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr CString
languages' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
languages
    Ptr WebContext -> Ptr CString -> IO ()
webkit_web_context_set_spell_checking_languages Ptr WebContext
context' Ptr CString
languages'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
languages'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
languages'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetSpellCheckingLanguagesMethodInfo
instance (signature ~ ([T.Text] -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextSetSpellCheckingLanguagesMethodInfo a signature where
    overloadedMethod = webContextSetSpellCheckingLanguages

#endif

-- method WebContext::set_tls_errors_policy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "policy"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "TLSErrorsPolicy" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitTLSErrorsPolicy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_set_tls_errors_policy" webkit_web_context_set_tls_errors_policy :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    CUInt ->                                -- policy : TInterface (Name {namespace = "WebKit2", name = "TLSErrorsPolicy"})
    IO ()

-- | Set the TLS errors policy of /@context@/ as /@policy@/
webContextSetTlsErrorsPolicy ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> WebKit2.Enums.TLSErrorsPolicy
    -- ^ /@policy@/: a t'GI.WebKit2.Enums.TLSErrorsPolicy'
    -> m ()
webContextSetTlsErrorsPolicy :: a -> TLSErrorsPolicy -> m ()
webContextSetTlsErrorsPolicy a
context TLSErrorsPolicy
policy = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    let policy' :: CUInt
policy' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (TLSErrorsPolicy -> Int) -> TLSErrorsPolicy -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSErrorsPolicy -> Int
forall a. Enum a => a -> Int
fromEnum) TLSErrorsPolicy
policy
    Ptr WebContext -> CUInt -> IO ()
webkit_web_context_set_tls_errors_policy Ptr WebContext
context' CUInt
policy'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetTlsErrorsPolicyMethodInfo
instance (signature ~ (WebKit2.Enums.TLSErrorsPolicy -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextSetTlsErrorsPolicyMethodInfo a signature where
    overloadedMethod = webContextSetTlsErrorsPolicy

#endif

-- method WebContext::set_web_extensions_directory
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "directory"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the directory to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_set_web_extensions_directory" webkit_web_context_set_web_extensions_directory :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    CString ->                              -- directory : TBasicType TUTF8
    IO ()

-- | Set the directory where WebKit will look for Web Extensions.
-- This method must be called before loading anything in this context,
-- otherwise it will not have any effect. You can connect to
-- [initializeWebExtensions]("GI.WebKit2.Objects.WebContext#g:signal:initializeWebExtensions") to call this method
-- before anything is loaded.
webContextSetWebExtensionsDirectory ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> T.Text
    -- ^ /@directory@/: the directory to add
    -> m ()
webContextSetWebExtensionsDirectory :: a -> Text -> m ()
webContextSetWebExtensionsDirectory a
context Text
directory = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
directory' <- Text -> IO CString
textToCString Text
directory
    Ptr WebContext -> CString -> IO ()
webkit_web_context_set_web_extensions_directory Ptr WebContext
context' CString
directory'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
directory'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetWebExtensionsDirectoryMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextSetWebExtensionsDirectoryMethodInfo a signature where
    overloadedMethod = webContextSetWebExtensionsDirectory

#endif

-- method WebContext::set_web_extensions_initialization_user_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GVariant" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_set_web_extensions_initialization_user_data" webkit_web_context_set_web_extensions_initialization_user_data :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    Ptr GVariant ->                         -- user_data : TVariant
    IO ()

-- | Set user data to be passed to Web Extensions on initialization.
-- The data will be passed to the
-- @/WebKitWebExtensionInitializeWithUserDataFunction/@.
-- This method must be called before loading anything in this context,
-- otherwise it will not have any effect. You can connect to
-- [initializeWebExtensions]("GI.WebKit2.Objects.WebContext#g:signal:initializeWebExtensions") to call this method
-- before anything is loaded.
-- 
-- /Since: 2.4/
webContextSetWebExtensionsInitializationUserData ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.WebContext.WebContext'
    -> GVariant
    -- ^ /@userData@/: a t'GVariant'
    -> m ()
webContextSetWebExtensionsInitializationUserData :: a -> GVariant -> m ()
webContextSetWebExtensionsInitializationUserData a
context GVariant
userData = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr GVariant
userData' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
userData
    Ptr WebContext -> Ptr GVariant -> IO ()
webkit_web_context_set_web_extensions_initialization_user_data Ptr WebContext
context' Ptr GVariant
userData'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
userData
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetWebExtensionsInitializationUserDataMethodInfo
instance (signature ~ (GVariant -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextSetWebExtensionsInitializationUserDataMethodInfo a signature where
    overloadedMethod = webContextSetWebExtensionsInitializationUserData

#endif

-- method WebContext::set_web_process_count_limit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #WebKitWebContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "limit"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the maximum number of web processes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_set_web_process_count_limit" webkit_web_context_set_web_process_count_limit :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit2", name = "WebContext"})
    Word32 ->                               -- limit : TBasicType TUInt
    IO ()

{-# DEPRECATED webContextSetWebProcessCountLimit ["(Since version 2.26)"] #-}
-- | Sets the maximum number of web processes that can be created at the same time for the /@context@/.
-- The default value is 0 and means no limit.
-- 
-- This function is now deprecated and does nothing for security reasons.
-- 
-- /Since: 2.10/
webContextSetWebProcessCountLimit ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit2.Objects.WebContext.WebContext'
    -> Word32
    -- ^ /@limit@/: the maximum number of web processes
    -> m ()
webContextSetWebProcessCountLimit :: a -> Word32 -> m ()
webContextSetWebProcessCountLimit a
context Word32
limit = 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 WebContext
context' <- a -> IO (Ptr WebContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr WebContext -> Word32 -> IO ()
webkit_web_context_set_web_process_count_limit Ptr WebContext
context' Word32
limit
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetWebProcessCountLimitMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsWebContext a) => O.MethodInfo WebContextSetWebProcessCountLimitMethodInfo a signature where
    overloadedMethod = webContextSetWebProcessCountLimit

#endif

-- method WebContext::get_default
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit2" , name = "WebContext" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_get_default" webkit_web_context_get_default :: 
    IO (Ptr WebContext)

-- | Gets the default web context
webContextGetDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m WebContext
    -- ^ __Returns:__ a t'GI.WebKit2.Objects.WebContext.WebContext'
webContextGetDefault :: m WebContext
webContextGetDefault  = IO WebContext -> m WebContext
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WebContext -> m WebContext) -> IO WebContext -> m WebContext
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebContext
result <- IO (Ptr WebContext)
webkit_web_context_get_default
    Text -> Ptr WebContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"webContextGetDefault" Ptr WebContext
result
    WebContext
result' <- ((ManagedPtr WebContext -> WebContext)
-> Ptr WebContext -> IO WebContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr WebContext -> WebContext
WebContext) Ptr WebContext
result
    WebContext -> IO WebContext
forall (m :: * -> *) a. Monad m => a -> m a
return WebContext
result'

#if defined(ENABLE_OVERLOADING)
#endif