{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Manages aspects common to all t'GI.WebKit.Objects.WebView.WebView's
-- 
-- The t'GI.WebKit.Objects.WebContext.WebContext' manages all aspects common to all
-- t'GI.WebKit.Objects.WebView.WebView's.
-- 
-- You can define the t'GI.WebKit.Enums.CacheModel' with
-- 'GI.WebKit.Objects.WebContext.webContextSetCacheModel', depending on the needs of
-- your application. You can access the t'GI.WebKit.Objects.SecurityManager.SecurityManager' to specify
-- the behaviour of your application regarding security using
-- 'GI.WebKit.Objects.WebContext.webContextGetSecurityManager'.
-- 
-- It is also possible to change your preferred language or enable
-- spell checking, using 'GI.WebKit.Objects.WebContext.webContextSetPreferredLanguages',
-- 'GI.WebKit.Objects.WebContext.webContextSetSpellCheckingLanguages' and
-- 'GI.WebKit.Objects.WebContext.webContextSetSpellCheckingEnabled'.
-- 
-- You can use 'GI.WebKit.Objects.WebContext.webContextRegisterUriScheme' to register
-- custom URI schemes, and manage several other settings.
-- 
-- TLS certificate validation failure is now treated as a transport
-- error by default. To handle TLS failures differently, you can
-- connect to [WebView::loadFailedWithTlsErrors]("GI.WebKit.Objects.WebView#g:signal:loadFailedWithTlsErrors").
-- Alternatively, you can use @/webkit_web_context_set_tls_errors_policy()/@
-- to set the policy 'GI.WebKit.Enums.TLSErrorsPolicyIgnore'; however, this is
-- not appropriate for Internet applications.

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

module GI.WebKit.Objects.WebContext
    ( 

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


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addPathToSandbox]("GI.WebKit.Objects.WebContext#g:method:addPathToSandbox"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [initializeNotificationPermissions]("GI.WebKit.Objects.WebContext#g:method:initializeNotificationPermissions"), [isAutomationAllowed]("GI.WebKit.Objects.WebContext#g:method:isAutomationAllowed"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [registerUriScheme]("GI.WebKit.Objects.WebContext#g:method:registerUriScheme"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [sendMessageToAllExtensions]("GI.WebKit.Objects.WebContext#g:method:sendMessageToAllExtensions"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCacheModel]("GI.WebKit.Objects.WebContext#g:method:getCacheModel"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getGeolocationManager]("GI.WebKit.Objects.WebContext#g:method:getGeolocationManager"), [getNetworkSessionForAutomation]("GI.WebKit.Objects.WebContext#g:method:getNetworkSessionForAutomation"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSecurityManager]("GI.WebKit.Objects.WebContext#g:method:getSecurityManager"), [getSpellCheckingEnabled]("GI.WebKit.Objects.WebContext#g:method:getSpellCheckingEnabled"), [getSpellCheckingLanguages]("GI.WebKit.Objects.WebContext#g:method:getSpellCheckingLanguages"), [getTimeZoneOverride]("GI.WebKit.Objects.WebContext#g:method:getTimeZoneOverride").
-- 
-- ==== Setters
-- [setAutomationAllowed]("GI.WebKit.Objects.WebContext#g:method:setAutomationAllowed"), [setCacheModel]("GI.WebKit.Objects.WebContext#g:method:setCacheModel"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setPreferredLanguages]("GI.WebKit.Objects.WebContext#g:method:setPreferredLanguages"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSpellCheckingEnabled]("GI.WebKit.Objects.WebContext#g:method:setSpellCheckingEnabled"), [setSpellCheckingLanguages]("GI.WebKit.Objects.WebContext#g:method:setSpellCheckingLanguages"), [setWebProcessExtensionsDirectory]("GI.WebKit.Objects.WebContext#g:method:setWebProcessExtensionsDirectory"), [setWebProcessExtensionsInitializationUserData]("GI.WebKit.Objects.WebContext#g:method:setWebProcessExtensionsInitializationUserData").

#if defined(ENABLE_OVERLOADING)
    ResolveWebContextMethod                 ,
#endif

-- ** addPathToSandbox #method:addPathToSandbox#

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


-- ** getCacheModel #method:getCacheModel#

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


-- ** getDefault #method:getDefault#

    webContextGetDefault                    ,


-- ** getGeolocationManager #method:getGeolocationManager#

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


-- ** getNetworkSessionForAutomation #method:getNetworkSessionForAutomation#

#if defined(ENABLE_OVERLOADING)
    WebContextGetNetworkSessionForAutomationMethodInfo,
#endif
    webContextGetNetworkSessionForAutomation,


-- ** 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     ,


-- ** getTimeZoneOverride #method:getTimeZoneOverride#

#if defined(ENABLE_OVERLOADING)
    WebContextGetTimeZoneOverrideMethodInfo ,
#endif
    webContextGetTimeZoneOverride           ,


-- ** initializeNotificationPermissions #method:initializeNotificationPermissions#

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


-- ** isAutomationAllowed #method:isAutomationAllowed#

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


-- ** new #method:new#

    webContextNew                           ,


-- ** registerUriScheme #method:registerUriScheme#

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


-- ** sendMessageToAllExtensions #method:sendMessageToAllExtensions#

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


-- ** setAutomationAllowed #method:setAutomationAllowed#

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


-- ** setCacheModel #method:setCacheModel#

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


-- ** setPreferredLanguages #method:setPreferredLanguages#

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


-- ** setSpellCheckingEnabled #method:setSpellCheckingEnabled#

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


-- ** setSpellCheckingLanguages #method:setSpellCheckingLanguages#

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


-- ** setWebProcessExtensionsDirectory #method:setWebProcessExtensionsDirectory#

#if defined(ENABLE_OVERLOADING)
    WebContextSetWebProcessExtensionsDirectoryMethodInfo,
#endif
    webContextSetWebProcessExtensionsDirectory,


-- ** setWebProcessExtensionsInitializationUserData #method:setWebProcessExtensionsInitializationUserData#

#if defined(ENABLE_OVERLOADING)
    WebContextSetWebProcessExtensionsInitializationUserDataMethodInfo,
#endif
    webContextSetWebProcessExtensionsInitializationUserData,




 -- * Properties


-- ** memoryPressureSettings #attr:memoryPressureSettings#
-- | The t'GI.WebKit.Structs.MemoryPressureSettings.MemoryPressureSettings' applied to the web processes created by this context.
-- 
-- /Since: 2.34/

#if defined(ENABLE_OVERLOADING)
    WebContextMemoryPressureSettingsPropertyInfo,
#endif
    constructWebContextMemoryPressureSettings,
#if defined(ENABLE_OVERLOADING)
    webContextMemoryPressureSettings        ,
#endif


-- ** timeZoneOverride #attr:timeZoneOverride#
-- | The timezone override for this web context. Setting this property provides a better
-- alternative to configure the timezone information for all webviews managed by the WebContext.
-- The other, less optimal, approach is to globally set the TZ environment variable in the
-- process before creating the context. However this approach might not be very convenient and
-- can have side-effects in your application.
-- 
-- The expected values for this property are defined in the IANA timezone database. See this
-- wikipedia page for instance, https:\/\/en.wikipedia.org\/wiki\/List_of_tz_database_time_zones.
-- 
-- /Since: 2.38/

#if defined(ENABLE_OVERLOADING)
    WebContextTimeZoneOverridePropertyInfo  ,
#endif
    constructWebContextTimeZoneOverride     ,
    getWebContextTimeZoneOverride           ,
#if defined(ENABLE_OVERLOADING)
    webContextTimeZoneOverride              ,
#endif




 -- * Signals


-- ** automationStarted #signal:automationStarted#

    WebContextAutomationStartedCallback     ,
#if defined(ENABLE_OVERLOADING)
    WebContextAutomationStartedSignalInfo   ,
#endif
    afterWebContextAutomationStarted        ,
    onWebContextAutomationStarted           ,


-- ** initializeNotificationPermissions #signal:initializeNotificationPermissions#

    WebContextInitializeNotificationPermissionsCallback,
#if defined(ENABLE_OVERLOADING)
    WebContextInitializeNotificationPermissionsSignalInfo,
#endif
    afterWebContextInitializeNotificationPermissions,
    onWebContextInitializeNotificationPermissions,


-- ** initializeWebProcessExtensions #signal:initializeWebProcessExtensions#

    WebContextInitializeWebProcessExtensionsCallback,
#if defined(ENABLE_OVERLOADING)
    WebContextInitializeWebProcessExtensionsSignalInfo,
#endif
    afterWebContextInitializeWebProcessExtensions,
    onWebContextInitializeWebProcessExtensions,


-- ** userMessageReceived #signal:userMessageReceived#

    WebContextUserMessageReceivedCallback   ,
#if defined(ENABLE_OVERLOADING)
    WebContextUserMessageReceivedSignalInfo ,
#endif
    afterWebContextUserMessageReceived      ,
    onWebContextUserMessageReceived         ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.WebKit.Callbacks as WebKit.Callbacks
import {-# SOURCE #-} qualified GI.WebKit.Enums as WebKit.Enums
import {-# SOURCE #-} qualified GI.WebKit.Objects.AutomationSession as WebKit.AutomationSession
import {-# SOURCE #-} qualified GI.WebKit.Objects.GeolocationManager as WebKit.GeolocationManager
import {-# SOURCE #-} qualified GI.WebKit.Objects.NetworkSession as WebKit.NetworkSession
import {-# SOURCE #-} qualified GI.WebKit.Objects.SecurityManager as WebKit.SecurityManager
import {-# SOURCE #-} qualified GI.WebKit.Objects.UserMessage as WebKit.UserMessage
import {-# SOURCE #-} qualified GI.WebKit.Structs.MemoryPressureSettings as WebKit.MemoryPressureSettings
import {-# SOURCE #-} qualified GI.WebKit.Structs.SecurityOrigin as WebKit.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
$c== :: WebContext -> WebContext -> Bool
== :: WebContext -> WebContext -> Bool
$c/= :: WebContext -> WebContext -> Bool
/= :: 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

-- | 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 :: (MIO.MonadIO m, IsWebContext o) => o -> m WebContext
toWebContext :: forall (m :: * -> *) o.
(MonadIO m, IsWebContext o) =>
o -> m WebContext
toWebContext = IO WebContext -> m WebContext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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'
B.ManagedPtr.unsafeCastTo ManagedPtr WebContext -> WebContext
WebContext

-- | Convert 'WebContext' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe WebContext) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_webkit_web_context_get_type
    gvalueSet_ :: Ptr GValue -> Maybe WebContext -> IO ()
gvalueSet_ Ptr GValue
gv Maybe WebContext
P.Nothing = Ptr GValue -> Ptr WebContext -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr WebContext
forall a. Ptr a
FP.nullPtr :: FP.Ptr WebContext)
    gvalueSet_ Ptr GValue
gv (P.Just WebContext
obj) = WebContext -> (Ptr WebContext -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr WebContext
obj (Ptr GValue -> Ptr WebContext -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe WebContext)
gvalueGet_ Ptr GValue
gv = do
        Ptr WebContext
ptr <- Ptr GValue -> IO (Ptr WebContext)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr WebContext)
        if Ptr WebContext
ptr Ptr WebContext -> Ptr WebContext -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr WebContext
forall a. Ptr a
FP.nullPtr
        then WebContext -> Maybe WebContext
forall a. a -> Maybe a
P.Just (WebContext -> Maybe WebContext)
-> IO WebContext -> IO (Maybe WebContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
        else Maybe WebContext -> IO (Maybe WebContext)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe WebContext
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveWebContextMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveWebContextMethod "addPathToSandbox" o = WebContextAddPathToSandboxMethodInfo
    ResolveWebContextMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveWebContextMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    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 "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveWebContextMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveWebContextMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    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 "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveWebContextMethod "getGeolocationManager" o = WebContextGetGeolocationManagerMethodInfo
    ResolveWebContextMethod "getNetworkSessionForAutomation" o = WebContextGetNetworkSessionForAutomationMethodInfo
    ResolveWebContextMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveWebContextMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveWebContextMethod "getSecurityManager" o = WebContextGetSecurityManagerMethodInfo
    ResolveWebContextMethod "getSpellCheckingEnabled" o = WebContextGetSpellCheckingEnabledMethodInfo
    ResolveWebContextMethod "getSpellCheckingLanguages" o = WebContextGetSpellCheckingLanguagesMethodInfo
    ResolveWebContextMethod "getTimeZoneOverride" o = WebContextGetTimeZoneOverrideMethodInfo
    ResolveWebContextMethod "setAutomationAllowed" o = WebContextSetAutomationAllowedMethodInfo
    ResolveWebContextMethod "setCacheModel" o = WebContextSetCacheModelMethodInfo
    ResolveWebContextMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveWebContextMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveWebContextMethod "setPreferredLanguages" o = WebContextSetPreferredLanguagesMethodInfo
    ResolveWebContextMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveWebContextMethod "setSpellCheckingEnabled" o = WebContextSetSpellCheckingEnabledMethodInfo
    ResolveWebContextMethod "setSpellCheckingLanguages" o = WebContextSetSpellCheckingLanguagesMethodInfo
    ResolveWebContextMethod "setWebProcessExtensionsDirectory" o = WebContextSetWebProcessExtensionsDirectoryMethodInfo
    ResolveWebContextMethod "setWebProcessExtensionsInitializationUserData" o = WebContextSetWebProcessExtensionsInitializationUserDataMethodInfo
    ResolveWebContextMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveWebContextMethod t WebContext, O.OverloadedMethod 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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveWebContextMethod t WebContext, O.OverloadedMethod info WebContext p, R.HasField t WebContext p) => R.HasField t WebContext p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveWebContextMethod t WebContext, O.OverloadedMethodInfo info WebContext) => OL.IsLabel t (O.MethodProxy info WebContext) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#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.WebKit.Objects.WebContext.webContextSetAutomationAllowed' for more details.
-- 
-- /Since: 2.18/
type WebContextAutomationStartedCallback =
    WebKit.AutomationSession.AutomationSession
    -- ^ /@session@/: the t'GI.WebKit.Objects.AutomationSession.AutomationSession' associated with this event
    -> IO ()

type C_WebContextAutomationStartedCallback =
    Ptr WebContext ->                       -- object
    Ptr WebKit.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_WebContextAutomationStartedCallback :: 
    GObject a => (a -> WebContextAutomationStartedCallback) ->
    C_WebContextAutomationStartedCallback
wrap_WebContextAutomationStartedCallback :: forall a.
GObject a =>
(a -> WebContextAutomationStartedCallback)
-> C_WebContextAutomationStartedCallback
wrap_WebContextAutomationStartedCallback a -> WebContextAutomationStartedCallback
gi'cb Ptr WebContext
gi'selfPtr 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
WebKit.AutomationSession.AutomationSession) Ptr AutomationSession
session
    Ptr WebContext -> (WebContext -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebContext
gi'selfPtr ((WebContext -> IO ()) -> IO ()) -> (WebContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebContext
gi'self -> a -> WebContextAutomationStartedCallback
gi'cb (WebContext -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebContext
gi'self)  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 -> ((?self :: a) => WebContextAutomationStartedCallback) -> m SignalHandlerId
onWebContextAutomationStarted :: forall a (m :: * -> *).
(IsWebContext a, MonadIO m) =>
a
-> ((?self::a) => WebContextAutomationStartedCallback)
-> m SignalHandlerId
onWebContextAutomationStarted a
obj (?self::a) => WebContextAutomationStartedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> WebContextAutomationStartedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebContextAutomationStartedCallback
WebContextAutomationStartedCallback
cb
    let wrapped' :: C_WebContextAutomationStartedCallback
wrapped' = (a -> WebContextAutomationStartedCallback)
-> C_WebContextAutomationStartedCallback
forall a.
GObject a =>
(a -> WebContextAutomationStartedCallback)
-> C_WebContextAutomationStartedCallback
wrap_WebContextAutomationStartedCallback a -> WebContextAutomationStartedCallback
wrapped
    FunPtr C_WebContextAutomationStartedCallback
wrapped'' <- C_WebContextAutomationStartedCallback
-> IO (FunPtr C_WebContextAutomationStartedCallback)
mk_WebContextAutomationStartedCallback C_WebContextAutomationStartedCallback
wrapped'
    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
wrapped'' 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
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterWebContextAutomationStarted :: (IsWebContext a, MonadIO m) => a -> ((?self :: a) => WebContextAutomationStartedCallback) -> m SignalHandlerId
afterWebContextAutomationStarted :: forall a (m :: * -> *).
(IsWebContext a, MonadIO m) =>
a
-> ((?self::a) => WebContextAutomationStartedCallback)
-> m SignalHandlerId
afterWebContextAutomationStarted a
obj (?self::a) => WebContextAutomationStartedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> WebContextAutomationStartedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebContextAutomationStartedCallback
WebContextAutomationStartedCallback
cb
    let wrapped' :: C_WebContextAutomationStartedCallback
wrapped' = (a -> WebContextAutomationStartedCallback)
-> C_WebContextAutomationStartedCallback
forall a.
GObject a =>
(a -> WebContextAutomationStartedCallback)
-> C_WebContextAutomationStartedCallback
wrap_WebContextAutomationStartedCallback a -> WebContextAutomationStartedCallback
wrapped
    FunPtr C_WebContextAutomationStartedCallback
wrapped'' <- C_WebContextAutomationStartedCallback
-> IO (FunPtr C_WebContextAutomationStartedCallback)
mk_WebContextAutomationStartedCallback C_WebContextAutomationStartedCallback
wrapped'
    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
wrapped'' 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
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext::automation-started"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#g:signal:automationStarted"})

#endif

-- signal WebContext::initialize-notification-permissions
-- | This signal is emitted when a t'GI.WebKit.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.WebKit.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.WebKit.Objects.WebContext.webContextInitializeNotificationPermissions' again.
-- 
-- /Since: 2.16/
type WebContextInitializeNotificationPermissionsCallback =
    IO ()

type C_WebContextInitializeNotificationPermissionsCallback =
    Ptr WebContext ->                       -- 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_WebContextInitializeNotificationPermissionsCallback :: 
    GObject a => (a -> WebContextInitializeNotificationPermissionsCallback) ->
    C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeNotificationPermissionsCallback :: forall a.
GObject a =>
(a -> IO ())
-> C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeNotificationPermissionsCallback a -> IO ()
gi'cb Ptr WebContext
gi'selfPtr Ptr ()
_ = do
    Ptr WebContext -> (WebContext -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebContext
gi'selfPtr ((WebContext -> IO ()) -> IO ()) -> (WebContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebContext
gi'self -> a -> IO ()
gi'cb (WebContext -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebContext
gi'self) 


-- | 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 -> ((?self :: a) => WebContextInitializeNotificationPermissionsCallback) -> m SignalHandlerId
onWebContextInitializeNotificationPermissions :: forall a (m :: * -> *).
(IsWebContext a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWebContextInitializeNotificationPermissions a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WebContextInitializeNotificationPermissionsCallback
wrapped' = (a -> IO ())
-> C_WebContextInitializeNotificationPermissionsCallback
forall a.
GObject a =>
(a -> IO ())
-> C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeNotificationPermissionsCallback a -> IO ()
wrapped
    FunPtr C_WebContextInitializeNotificationPermissionsCallback
wrapped'' <- C_WebContextInitializeNotificationPermissionsCallback
-> IO
     (FunPtr C_WebContextInitializeNotificationPermissionsCallback)
mk_WebContextInitializeNotificationPermissionsCallback C_WebContextInitializeNotificationPermissionsCallback
wrapped'
    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
wrapped'' 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
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterWebContextInitializeNotificationPermissions :: (IsWebContext a, MonadIO m) => a -> ((?self :: a) => WebContextInitializeNotificationPermissionsCallback) -> m SignalHandlerId
afterWebContextInitializeNotificationPermissions :: forall a (m :: * -> *).
(IsWebContext a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterWebContextInitializeNotificationPermissions a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WebContextInitializeNotificationPermissionsCallback
wrapped' = (a -> IO ())
-> C_WebContextInitializeNotificationPermissionsCallback
forall a.
GObject a =>
(a -> IO ())
-> C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeNotificationPermissionsCallback a -> IO ()
wrapped
    FunPtr C_WebContextInitializeNotificationPermissionsCallback
wrapped'' <- C_WebContextInitializeNotificationPermissionsCallback
-> IO
     (FunPtr C_WebContextInitializeNotificationPermissionsCallback)
mk_WebContextInitializeNotificationPermissionsCallback C_WebContextInitializeNotificationPermissionsCallback
wrapped'
    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
wrapped'' 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
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext::initialize-notification-permissions"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#g:signal:initializeNotificationPermissions"})

#endif

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

type C_WebContextInitializeWebProcessExtensionsCallback =
    Ptr WebContext ->                       -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WebContextInitializeWebProcessExtensionsCallback :: 
    GObject a => (a -> WebContextInitializeWebProcessExtensionsCallback) ->
    C_WebContextInitializeWebProcessExtensionsCallback
wrap_WebContextInitializeWebProcessExtensionsCallback :: forall a.
GObject a =>
(a -> IO ())
-> C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeWebProcessExtensionsCallback a -> IO ()
gi'cb Ptr WebContext
gi'selfPtr Ptr ()
_ = do
    Ptr WebContext -> (WebContext -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebContext
gi'selfPtr ((WebContext -> IO ()) -> IO ()) -> (WebContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebContext
gi'self -> a -> IO ()
gi'cb (WebContext -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebContext
gi'self) 


-- | Connect a signal handler for the [initializeWebProcessExtensions](#signal:initializeWebProcessExtensions) 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 #initializeWebProcessExtensions callback
-- @
-- 
-- 
onWebContextInitializeWebProcessExtensions :: (IsWebContext a, MonadIO m) => a -> ((?self :: a) => WebContextInitializeWebProcessExtensionsCallback) -> m SignalHandlerId
onWebContextInitializeWebProcessExtensions :: forall a (m :: * -> *).
(IsWebContext a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWebContextInitializeWebProcessExtensions a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WebContextInitializeNotificationPermissionsCallback
wrapped' = (a -> IO ())
-> C_WebContextInitializeNotificationPermissionsCallback
forall a.
GObject a =>
(a -> IO ())
-> C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeWebProcessExtensionsCallback a -> IO ()
wrapped
    FunPtr C_WebContextInitializeNotificationPermissionsCallback
wrapped'' <- C_WebContextInitializeNotificationPermissionsCallback
-> IO
     (FunPtr C_WebContextInitializeNotificationPermissionsCallback)
mk_WebContextInitializeWebProcessExtensionsCallback C_WebContextInitializeNotificationPermissionsCallback
wrapped'
    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-process-extensions" FunPtr C_WebContextInitializeNotificationPermissionsCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [initializeWebProcessExtensions](#signal:initializeWebProcessExtensions) 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 #initializeWebProcessExtensions callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterWebContextInitializeWebProcessExtensions :: (IsWebContext a, MonadIO m) => a -> ((?self :: a) => WebContextInitializeWebProcessExtensionsCallback) -> m SignalHandlerId
afterWebContextInitializeWebProcessExtensions :: forall a (m :: * -> *).
(IsWebContext a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterWebContextInitializeWebProcessExtensions a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_WebContextInitializeNotificationPermissionsCallback
wrapped' = (a -> IO ())
-> C_WebContextInitializeNotificationPermissionsCallback
forall a.
GObject a =>
(a -> IO ())
-> C_WebContextInitializeNotificationPermissionsCallback
wrap_WebContextInitializeWebProcessExtensionsCallback a -> IO ()
wrapped
    FunPtr C_WebContextInitializeNotificationPermissionsCallback
wrapped'' <- C_WebContextInitializeNotificationPermissionsCallback
-> IO
     (FunPtr C_WebContextInitializeNotificationPermissionsCallback)
mk_WebContextInitializeWebProcessExtensionsCallback C_WebContextInitializeNotificationPermissionsCallback
wrapped'
    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-process-extensions" FunPtr C_WebContextInitializeNotificationPermissionsCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebContextInitializeWebProcessExtensionsSignalInfo
instance SignalInfo WebContextInitializeWebProcessExtensionsSignalInfo where
    type HaskellCallbackType WebContextInitializeWebProcessExtensionsSignalInfo = WebContextInitializeWebProcessExtensionsCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebContextInitializeWebProcessExtensionsCallback cb
        cb'' <- mk_WebContextInitializeWebProcessExtensionsCallback cb'
        connectSignalFunPtr obj "initialize-web-process-extensions" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext::initialize-web-process-extensions"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#g:signal:initializeWebProcessExtensions"})

#endif

-- signal WebContext::user-message-received
-- | This signal is emitted when a t'GI.WebKit.Objects.UserMessage.UserMessage' is received from a
-- web process extension. You can reply to the message using
-- 'GI.WebKit.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 =
    WebKit.UserMessage.UserMessage
    -- ^ /@message@/: the t'GI.WebKit.Objects.UserMessage.UserMessage' received
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if the message was handled, or 'P.False' otherwise.

type C_WebContextUserMessageReceivedCallback =
    Ptr WebContext ->                       -- object
    Ptr WebKit.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_WebContextUserMessageReceivedCallback :: 
    GObject a => (a -> WebContextUserMessageReceivedCallback) ->
    C_WebContextUserMessageReceivedCallback
wrap_WebContextUserMessageReceivedCallback :: forall a.
GObject a =>
(a -> WebContextUserMessageReceivedCallback)
-> C_WebContextUserMessageReceivedCallback
wrap_WebContextUserMessageReceivedCallback a -> WebContextUserMessageReceivedCallback
gi'cb Ptr WebContext
gi'selfPtr 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
WebKit.UserMessage.UserMessage) Ptr UserMessage
message
    Bool
result <- Ptr WebContext -> (WebContext -> IO Bool) -> IO Bool
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebContext
gi'selfPtr ((WebContext -> IO Bool) -> IO Bool)
-> (WebContext -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \WebContext
gi'self -> a -> WebContextUserMessageReceivedCallback
gi'cb (WebContext -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebContext
gi'self)  UserMessage
message'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
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 -> ((?self :: a) => WebContextUserMessageReceivedCallback) -> m SignalHandlerId
onWebContextUserMessageReceived :: forall a (m :: * -> *).
(IsWebContext a, MonadIO m) =>
a
-> ((?self::a) => WebContextUserMessageReceivedCallback)
-> m SignalHandlerId
onWebContextUserMessageReceived a
obj (?self::a) => WebContextUserMessageReceivedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> WebContextUserMessageReceivedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebContextUserMessageReceivedCallback
WebContextUserMessageReceivedCallback
cb
    let wrapped' :: C_WebContextUserMessageReceivedCallback
wrapped' = (a -> WebContextUserMessageReceivedCallback)
-> C_WebContextUserMessageReceivedCallback
forall a.
GObject a =>
(a -> WebContextUserMessageReceivedCallback)
-> C_WebContextUserMessageReceivedCallback
wrap_WebContextUserMessageReceivedCallback a -> WebContextUserMessageReceivedCallback
wrapped
    FunPtr C_WebContextUserMessageReceivedCallback
wrapped'' <- C_WebContextUserMessageReceivedCallback
-> IO (FunPtr C_WebContextUserMessageReceivedCallback)
mk_WebContextUserMessageReceivedCallback C_WebContextUserMessageReceivedCallback
wrapped'
    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
wrapped'' 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
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterWebContextUserMessageReceived :: (IsWebContext a, MonadIO m) => a -> ((?self :: a) => WebContextUserMessageReceivedCallback) -> m SignalHandlerId
afterWebContextUserMessageReceived :: forall a (m :: * -> *).
(IsWebContext a, MonadIO m) =>
a
-> ((?self::a) => WebContextUserMessageReceivedCallback)
-> m SignalHandlerId
afterWebContextUserMessageReceived a
obj (?self::a) => WebContextUserMessageReceivedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> WebContextUserMessageReceivedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebContextUserMessageReceivedCallback
WebContextUserMessageReceivedCallback
cb
    let wrapped' :: C_WebContextUserMessageReceivedCallback
wrapped' = (a -> WebContextUserMessageReceivedCallback)
-> C_WebContextUserMessageReceivedCallback
forall a.
GObject a =>
(a -> WebContextUserMessageReceivedCallback)
-> C_WebContextUserMessageReceivedCallback
wrap_WebContextUserMessageReceivedCallback a -> WebContextUserMessageReceivedCallback
wrapped
    FunPtr C_WebContextUserMessageReceivedCallback
wrapped'' <- C_WebContextUserMessageReceivedCallback
-> IO (FunPtr C_WebContextUserMessageReceivedCallback)
mk_WebContextUserMessageReceivedCallback C_WebContextUserMessageReceivedCallback
wrapped'
    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
wrapped'' 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
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext::user-message-received"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#g:signal:userMessageReceived"})

#endif

-- VVV Prop "memory-pressure-settings"
   -- Type: TInterface (Name {namespace = "WebKit", name = "MemoryPressureSettings"})
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@memory-pressure-settings@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructWebContextMemoryPressureSettings :: (IsWebContext o, MIO.MonadIO m) => WebKit.MemoryPressureSettings.MemoryPressureSettings -> m (GValueConstruct o)
constructWebContextMemoryPressureSettings :: forall o (m :: * -> *).
(IsWebContext o, MonadIO m) =>
MemoryPressureSettings -> m (GValueConstruct o)
constructWebContextMemoryPressureSettings MemoryPressureSettings
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe MemoryPressureSettings -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"memory-pressure-settings" (MemoryPressureSettings -> Maybe MemoryPressureSettings
forall a. a -> Maybe a
P.Just MemoryPressureSettings
val)

#if defined(ENABLE_OVERLOADING)
data WebContextMemoryPressureSettingsPropertyInfo
instance AttrInfo WebContextMemoryPressureSettingsPropertyInfo where
    type AttrAllowedOps WebContextMemoryPressureSettingsPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
    type AttrBaseTypeConstraint WebContextMemoryPressureSettingsPropertyInfo = IsWebContext
    type AttrSetTypeConstraint WebContextMemoryPressureSettingsPropertyInfo = (~) WebKit.MemoryPressureSettings.MemoryPressureSettings
    type AttrTransferTypeConstraint WebContextMemoryPressureSettingsPropertyInfo = (~) WebKit.MemoryPressureSettings.MemoryPressureSettings
    type AttrTransferType WebContextMemoryPressureSettingsPropertyInfo = WebKit.MemoryPressureSettings.MemoryPressureSettings
    type AttrGetType WebContextMemoryPressureSettingsPropertyInfo = ()
    type AttrLabel WebContextMemoryPressureSettingsPropertyInfo = "memory-pressure-settings"
    type AttrOrigin WebContextMemoryPressureSettingsPropertyInfo = WebContext
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructWebContextMemoryPressureSettings
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.memoryPressureSettings"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#g:attr:memoryPressureSettings"
        })
#endif

-- VVV Prop "time-zone-override"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@time-zone-override@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' webContext #timeZoneOverride
-- @
getWebContextTimeZoneOverride :: (MonadIO m, IsWebContext o) => o -> m T.Text
getWebContextTimeZoneOverride :: forall (m :: * -> *) o. (MonadIO m, IsWebContext o) => o -> m Text
getWebContextTimeZoneOverride o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getWebContextTimeZoneOverride" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO 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
"time-zone-override"

-- | Construct a `GValueConstruct` with valid value for the “@time-zone-override@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructWebContextTimeZoneOverride :: (IsWebContext o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructWebContextTimeZoneOverride :: forall o (m :: * -> *).
(IsWebContext o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructWebContextTimeZoneOverride Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"time-zone-override" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data WebContextTimeZoneOverridePropertyInfo
instance AttrInfo WebContextTimeZoneOverridePropertyInfo where
    type AttrAllowedOps WebContextTimeZoneOverridePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint WebContextTimeZoneOverridePropertyInfo = IsWebContext
    type AttrSetTypeConstraint WebContextTimeZoneOverridePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint WebContextTimeZoneOverridePropertyInfo = (~) T.Text
    type AttrTransferType WebContextTimeZoneOverridePropertyInfo = T.Text
    type AttrGetType WebContextTimeZoneOverridePropertyInfo = T.Text
    type AttrLabel WebContextTimeZoneOverridePropertyInfo = "time-zone-override"
    type AttrOrigin WebContextTimeZoneOverridePropertyInfo = WebContext
    attrGet = getWebContextTimeZoneOverride
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructWebContextTimeZoneOverride
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.timeZoneOverride"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#g:attr:timeZoneOverride"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList WebContext
type instance O.AttributeList WebContext = WebContextAttributeList
type WebContextAttributeList = ('[ '("memoryPressureSettings", WebContextMemoryPressureSettingsPropertyInfo), '("timeZoneOverride", WebContextTimeZoneOverridePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
webContextMemoryPressureSettings :: AttrLabelProxy "memoryPressureSettings"
webContextMemoryPressureSettings = AttrLabelProxy

webContextTimeZoneOverride :: AttrLabelProxy "timeZoneOverride"
webContextTimeZoneOverride = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList WebContext = WebContextSignalList
type WebContextSignalList = ('[ '("automationStarted", WebContextAutomationStartedSignalInfo), '("initializeNotificationPermissions", WebContextInitializeNotificationPermissionsSignalInfo), '("initializeWebProcessExtensions", WebContextInitializeWebProcessExtensionsSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("userMessageReceived", WebContextUserMessageReceivedSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method WebContext::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit" , 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.WebKit.Objects.WebContext.WebContext'.
-- 
-- /Since: 2.8/
webContextNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m WebContext
    -- ^ __Returns:__ a newly created t'GI.WebKit.Objects.WebContext.WebContext'
webContextNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m WebContext
webContextNew  = IO WebContext -> m WebContext
forall a. IO a -> m a
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 a. a -> IO a
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 = "WebKit" , 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 = "WebKit", 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 under @\/sys@, @\/proc@, and @\/dev@ are invalid. Attempting to
-- add all of @\/@ is not valid. Since 2.40, adding the user\'s entire
-- home directory or \/home is also not valid.
-- 
-- See also @/webkit_web_context_set_sandbox_enabled()/@
-- 
-- /Since: 2.26/
webContextAddPathToSandbox ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit.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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> String -> Bool -> m ()
webContextAddPathToSandbox a
context String
path Bool
readOnly = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
P.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
P.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 a. a -> IO a
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.OverloadedMethod WebContextAddPathToSandboxMethodInfo a signature where
    overloadedMethod = webContextAddPathToSandbox

instance O.OverloadedMethodInfo WebContextAddPathToSandboxMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextAddPathToSandbox",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextAddPathToSandbox"
        })


#endif

-- method WebContext::get_cache_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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 = "WebKit" , 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 = "WebKit", name = "WebContext"})
    IO CUInt

-- | Returns the current cache model.
-- 
-- For more information about this
-- value check the documentation of the function
-- 'GI.WebKit.Objects.WebContext.webContextSetCacheModel'.
webContextGetCacheModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit.Objects.WebContext.WebContext'
    -> m WebKit.Enums.CacheModel
    -- ^ __Returns:__ the current t'GI.WebKit.Enums.CacheModel'
webContextGetCacheModel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> m CacheModel
webContextGetCacheModel a
context = IO CacheModel -> m CacheModel
forall a. IO a -> m a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CacheModel
result'

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

instance O.OverloadedMethodInfo WebContextGetCacheModelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextGetCacheModel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextGetCacheModel"
        })


#endif

-- method WebContext::get_geolocation_manager
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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 = "WebKit" , 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 = "WebKit", name = "WebContext"})
    IO (Ptr WebKit.GeolocationManager.GeolocationManager)

-- | Get the t'GI.WebKit.Objects.GeolocationManager.GeolocationManager' of /@context@/.
-- 
-- /Since: 2.26/
webContextGetGeolocationManager ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit.Objects.WebContext.WebContext'
    -> m WebKit.GeolocationManager.GeolocationManager
    -- ^ __Returns:__ the t'GI.WebKit.Objects.GeolocationManager.GeolocationManager' of /@context@/.
webContextGetGeolocationManager :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> m GeolocationManager
webContextGetGeolocationManager a
context = IO GeolocationManager -> m GeolocationManager
forall a. IO a -> m a
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
WebKit.GeolocationManager.GeolocationManager) Ptr GeolocationManager
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    GeolocationManager -> IO GeolocationManager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GeolocationManager
result'

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

instance O.OverloadedMethodInfo WebContextGetGeolocationManagerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextGetGeolocationManager",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextGetGeolocationManager"
        })


#endif

-- method WebContext::get_network_session_for_automation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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 = "WebKit" , name = "NetworkSession" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_context_get_network_session_for_automation" webkit_web_context_get_network_session_for_automation :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit", name = "WebContext"})
    IO (Ptr WebKit.NetworkSession.NetworkSession)

-- | Get the t'GI.WebKit.Objects.NetworkSession.NetworkSession' used for automation sessions started in /@context@/.
-- 
-- /Since: 2.40/
webContextGetNetworkSessionForAutomation ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit.Objects.WebContext.WebContext'
    -> m (Maybe WebKit.NetworkSession.NetworkSession)
    -- ^ __Returns:__ a t'GI.WebKit.Objects.NetworkSession.NetworkSession', or 'P.Nothing' if automation is not enabled
webContextGetNetworkSessionForAutomation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> m (Maybe NetworkSession)
webContextGetNetworkSessionForAutomation a
context = IO (Maybe NetworkSession) -> m (Maybe NetworkSession)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe NetworkSession) -> m (Maybe NetworkSession))
-> IO (Maybe NetworkSession) -> m (Maybe NetworkSession)
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 NetworkSession
result <- Ptr WebContext -> IO (Ptr NetworkSession)
webkit_web_context_get_network_session_for_automation Ptr WebContext
context'
    Maybe NetworkSession
maybeResult <- Ptr NetworkSession
-> (Ptr NetworkSession -> IO NetworkSession)
-> IO (Maybe NetworkSession)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr NetworkSession
result ((Ptr NetworkSession -> IO NetworkSession)
 -> IO (Maybe NetworkSession))
-> (Ptr NetworkSession -> IO NetworkSession)
-> IO (Maybe NetworkSession)
forall a b. (a -> b) -> a -> b
$ \Ptr NetworkSession
result' -> do
        NetworkSession
result'' <- ((ManagedPtr NetworkSession -> NetworkSession)
-> Ptr NetworkSession -> IO NetworkSession
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr NetworkSession -> NetworkSession
WebKit.NetworkSession.NetworkSession) Ptr NetworkSession
result'
        NetworkSession -> IO NetworkSession
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NetworkSession
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Maybe NetworkSession -> IO (Maybe NetworkSession)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe NetworkSession
maybeResult

#if defined(ENABLE_OVERLOADING)
data WebContextGetNetworkSessionForAutomationMethodInfo
instance (signature ~ (m (Maybe WebKit.NetworkSession.NetworkSession)), MonadIO m, IsWebContext a) => O.OverloadedMethod WebContextGetNetworkSessionForAutomationMethodInfo a signature where
    overloadedMethod = webContextGetNetworkSessionForAutomation

instance O.OverloadedMethodInfo WebContextGetNetworkSessionForAutomationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextGetNetworkSessionForAutomation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextGetNetworkSessionForAutomation"
        })


#endif

-- method WebContext::get_security_manager
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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 = "WebKit" , 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 = "WebKit", name = "WebContext"})
    IO (Ptr WebKit.SecurityManager.SecurityManager)

-- | Get the t'GI.WebKit.Objects.SecurityManager.SecurityManager' of /@context@/.
webContextGetSecurityManager ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit.Objects.WebContext.WebContext'
    -> m WebKit.SecurityManager.SecurityManager
    -- ^ __Returns:__ the t'GI.WebKit.Objects.SecurityManager.SecurityManager' of /@context@/.
webContextGetSecurityManager :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> m SecurityManager
webContextGetSecurityManager a
context = IO SecurityManager -> m SecurityManager
forall a. IO a -> m a
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
WebKit.SecurityManager.SecurityManager) Ptr SecurityManager
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    SecurityManager -> IO SecurityManager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecurityManager
result'

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

instance O.OverloadedMethodInfo WebContextGetSecurityManagerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextGetSecurityManager",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextGetSecurityManager"
        })


#endif

-- method WebContext::get_spell_checking_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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 = "WebKit", 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.WebKit.Objects.WebContext.WebContext'
    -> m Bool
    -- ^ __Returns:__ 'P.True' If spell checking is enabled, or 'P.False' otherwise.
webContextGetSpellCheckingEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> m Bool
webContextGetSpellCheckingEnabled a
context = IO Bool -> m Bool
forall a. IO a -> m a
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 a. a -> IO a
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.OverloadedMethod WebContextGetSpellCheckingEnabledMethodInfo a signature where
    overloadedMethod = webContextGetSpellCheckingEnabled

instance O.OverloadedMethodInfo WebContextGetSpellCheckingEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextGetSpellCheckingEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextGetSpellCheckingEnabled"
        })


#endif

-- method WebContext::get_spell_checking_languages
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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 = "WebKit", name = "WebContext"})
    IO (Ptr CString)

-- | Get the the list of spell checking languages.
-- 
-- Get the the list of spell checking languages associated with
-- /@context@/, or 'P.Nothing' if no languages have been previously set.
-- 
-- See 'GI.WebKit.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.WebKit.Objects.WebContext.WebContext'
    -> m [T.Text]
    -- ^ __Returns:__ A 'P.Nothing'-terminated
    --    array of languages if available, or 'P.Nothing' otherwise.
webContextGetSpellCheckingLanguages :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> m [Text]
webContextGetSpellCheckingLanguages a
context = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"webContextGetSpellCheckingLanguages" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

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

instance O.OverloadedMethodInfo WebContextGetSpellCheckingLanguagesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextGetSpellCheckingLanguages",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextGetSpellCheckingLanguages"
        })


#endif

-- method WebContext::get_time_zone_override
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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_time_zone_override" webkit_web_context_get_time_zone_override :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit", name = "WebContext"})
    IO CString

-- | Get the [WebContext:timeZoneOverride]("GI.WebKit.Objects.WebContext#g:attr:timeZoneOverride") property.
-- 
-- /Since: 2.38/
webContextGetTimeZoneOverride ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit.Objects.WebContext.WebContext'
    -> m T.Text
webContextGetTimeZoneOverride :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> m Text
webContextGetTimeZoneOverride a
context = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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_time_zone_override Ptr WebContext
context'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"webContextGetTimeZoneOverride" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data WebContextGetTimeZoneOverrideMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsWebContext a) => O.OverloadedMethod WebContextGetTimeZoneOverrideMethodInfo a signature where
    overloadedMethod = webContextGetTimeZoneOverride

instance O.OverloadedMethodInfo WebContextGetTimeZoneOverrideMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextGetTimeZoneOverride",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextGetTimeZoneOverride"
        })


#endif

-- method WebContext::initialize_notification_permissions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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 = "WebKit" , 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 = "WebKit" , 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 = "WebKit", name = "WebContext"})
    Ptr (GList (Ptr WebKit.SecurityOrigin.SecurityOrigin)) -> -- allowed_origins : TGList (TInterface (Name {namespace = "WebKit", name = "SecurityOrigin"}))
    Ptr (GList (Ptr WebKit.SecurityOrigin.SecurityOrigin)) -> -- disallowed_origins : TGList (TInterface (Name {namespace = "WebKit", 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.WebKit.Structs.SecurityOrigin.SecurityOrigin' objects representing origins that will,
-- respectively, either always or never have permission to show desktop
-- notifications. No t'GI.WebKit.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
-- [WebContext::initializeNotificationPermissions]("GI.WebKit.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.WebKit.Objects.WebContext.WebContext'
    -> [WebKit.SecurityOrigin.SecurityOrigin]
    -- ^ /@allowedOrigins@/: a t'GI.GLib.Structs.List.List' of security origins
    -> [WebKit.SecurityOrigin.SecurityOrigin]
    -- ^ /@disallowedOrigins@/: a t'GI.GLib.Structs.List.List' of security origins
    -> m ()
webContextInitializeNotificationPermissions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> [SecurityOrigin] -> [SecurityOrigin] -> m ()
webContextInitializeNotificationPermissions a
context [SecurityOrigin]
allowedOrigins [SecurityOrigin]
disallowedOrigins = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo WebContextInitializeNotificationPermissionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextInitializeNotificationPermissions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextInitializeNotificationPermissions"
        })


#endif

-- method WebContext::is_automation_allowed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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 = "WebKit", name = "WebContext"})
    IO CInt

-- | Get whether automation is allowed in /@context@/.
-- 
-- See also 'GI.WebKit.Objects.WebContext.webContextSetAutomationAllowed'.
-- 
-- /Since: 2.18/
webContextIsAutomationAllowed ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit.Objects.WebContext.WebContext'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if automation is allowed or 'P.False' otherwise.
webContextIsAutomationAllowed :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> m Bool
webContextIsAutomationAllowed a
context = IO Bool -> m Bool
forall a. IO a -> m a
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 a. a -> IO a
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.OverloadedMethod WebContextIsAutomationAllowedMethodInfo a signature where
    overloadedMethod = webContextIsAutomationAllowed

instance O.OverloadedMethodInfo WebContextIsAutomationAllowedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextIsAutomationAllowed",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextIsAutomationAllowed"
        })


#endif

-- method WebContext::register_uri_scheme
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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 = "WebKit" , 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 = "WebKit", name = "WebContext"})
    CString ->                              -- scheme : TBasicType TUTF8
    FunPtr WebKit.Callbacks.C_URISchemeRequestCallback -> -- callback : TInterface (Name {namespace = "WebKit", 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@/.
-- 
-- Register /@scheme@/ in /@context@/, so that when an URI request with /@scheme@/ is made in the
-- t'GI.WebKit.Objects.WebContext.WebContext', the t'GI.WebKit.Callbacks.URISchemeRequestCallback' registered will be called with a
-- t'GI.WebKit.Objects.URISchemeRequest.URISchemeRequest'.
-- It is possible to handle URI scheme requests asynchronously, by calling 'GI.GObject.Objects.Object.objectRef' on the
-- t'GI.WebKit.Objects.URISchemeRequest.URISchemeRequest' and calling 'GI.WebKit.Objects.URISchemeRequest.uRISchemeRequestFinish' later
-- when the data of the request is available or
-- 'GI.WebKit.Objects.URISchemeRequest.uRISchemeRequestFinishError' in case of error.
-- 
-- 
-- === /c code/
-- >static void
-- >about_uri_scheme_request_cb (WebKitURISchemeRequest *request,
-- >                             gpointer                user_data)
-- >{
-- >    GInputStream *stream;
-- >    gsize         stream_length;
-- >    const gchar  *path = webkit_uri_scheme_request_get_path (request);
-- >
-- >    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 = g_strdup_printf ("<html><body><p>Example about page</p></body></html>");
-- >        stream_length = strlen (contents);
-- >        stream = g_memory_input_stream_new_from_data (contents, stream_length, g_free);
-- >    } else {
-- >        GError *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);
-- >}
webContextRegisterUriScheme ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit.Objects.WebContext.WebContext'
    -> T.Text
    -- ^ /@scheme@/: the network scheme to register
    -> WebKit.Callbacks.URISchemeRequestCallback
    -- ^ /@callback@/: a t'GI.WebKit.Callbacks.URISchemeRequestCallback'
    -> m ()
webContextRegisterUriScheme :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> Text -> URISchemeRequestCallback -> m ()
webContextRegisterUriScheme a
context Text
scheme URISchemeRequestCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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)
WebKit.Callbacks.mk_URISchemeRequestCallback (Maybe (Ptr (FunPtr C_URISchemeRequestCallback))
-> URISchemeRequestCallback_WithClosures
-> C_URISchemeRequestCallback
WebKit.Callbacks.wrap_URISchemeRequestCallback Maybe (Ptr (FunPtr C_URISchemeRequestCallback))
forall a. Maybe a
Nothing (URISchemeRequestCallback -> URISchemeRequestCallback_WithClosures
WebKit.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 ())
SP.safeFreeFunPtrPtr
    Ptr WebContext
-> CString
-> FunPtr C_URISchemeRequestCallback
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
webkit_web_context_register_uri_scheme Ptr WebContext
context' CString
scheme' FunPtr C_URISchemeRequestCallback
callback' Ptr ()
userData FunPtr C_DestroyNotify
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo WebContextRegisterUriSchemeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextRegisterUriScheme",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextRegisterUriScheme"
        })


#endif

-- method WebContext::send_message_to_all_extensions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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 = "WebKit" , 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 = "WebKit", name = "WebContext"})
    Ptr WebKit.UserMessage.UserMessage ->   -- message : TInterface (Name {namespace = "WebKit", name = "UserMessage"})
    IO ()

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

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

instance O.OverloadedMethodInfo WebContextSendMessageToAllExtensionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextSendMessageToAllExtensions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextSendMessageToAllExtensions"
        })


#endif

-- method WebContext::set_automation_allowed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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 = "WebKit", 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 [WebContext::automationStarted]("GI.WebKit.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.WebKit.Objects.WebContext.WebContext' can have automation enabled, so this will do nothing
-- if there\'s another t'GI.WebKit.Objects.WebContext.WebContext' with automation already enabled.
-- 
-- /Since: 2.18/
webContextSetAutomationAllowed ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit.Objects.WebContext.WebContext'
    -> Bool
    -- ^ /@allowed@/: value to set
    -> m ()
webContextSetAutomationAllowed :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> Bool -> m ()
webContextSetAutomationAllowed a
context Bool
allowed = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
P.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
P.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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo WebContextSetAutomationAllowedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextSetAutomationAllowed",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextSetAutomationAllowed"
        })


#endif

-- method WebContext::set_cache_model
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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 = "WebKit" , 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 = "WebKit", name = "WebContext"})
    CUInt ->                                -- cache_model : TInterface (Name {namespace = "WebKit", name = "CacheModel"})
    IO ()

-- | Specifies a usage model for WebViews.
-- 
-- 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.WebKit.Enums.CacheModelWebBrowser'. Applications without a
-- browsing interface can reduce memory usage substantially by
-- specifying 'GI.WebKit.Enums.CacheModelDocumentViewer'. The default value is
-- 'GI.WebKit.Enums.CacheModelWebBrowser'.
webContextSetCacheModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: the t'GI.WebKit.Objects.WebContext.WebContext'
    -> WebKit.Enums.CacheModel
    -- ^ /@cacheModel@/: a t'GI.WebKit.Enums.CacheModel'
    -> m ()
webContextSetCacheModel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> CacheModel -> m ()
webContextSetCacheModel a
context CacheModel
cacheModel = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo WebContextSetCacheModelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextSetCacheModel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextSetCacheModel"
        })


#endif

-- method WebContext::set_preferred_languages
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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 = "WebKit", name = "WebContext"})
    Ptr CString ->                          -- languages : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO ()

-- | Set the list of preferred languages.
-- 
-- Set the list of preferred languages, sorted from most desirable
-- to least desirable. The list will be used in the following ways:
-- 
-- * Determining how to build the @Accept-Language@ HTTP header that will be
-- included in the network requests started by the t'GI.WebKit.Objects.WebContext.WebContext'.
-- * Setting the values of @navigator.language@ and @navigator.languages@.
-- * The first item in the list sets the default locale for JavaScript
-- @Intl@ functions.
webContextSetPreferredLanguages ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit.Objects.WebContext.WebContext'
    -> Maybe ([T.Text])
    -- ^ /@languages@/: a 'P.Nothing'-terminated list of language identifiers
    -> m ()
webContextSetPreferredLanguages :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> Maybe [Text] -> m ()
webContextSetPreferredLanguages a
context Maybe [Text]
languages = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
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.OverloadedMethod WebContextSetPreferredLanguagesMethodInfo a signature where
    overloadedMethod = webContextSetPreferredLanguages

instance O.OverloadedMethodInfo WebContextSetPreferredLanguagesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextSetPreferredLanguages",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextSetPreferredLanguages"
        })


#endif

-- method WebContext::set_spell_checking_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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 = "WebKit", 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.WebKit.Objects.WebContext.WebContext'
    -> Bool
    -- ^ /@enabled@/: Value to be set
    -> m ()
webContextSetSpellCheckingEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> Bool -> m ()
webContextSetSpellCheckingEnabled a
context Bool
enabled = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
P.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
P.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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo WebContextSetSpellCheckingEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextSetSpellCheckingEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextSetSpellCheckingEnabled"
        })


#endif

-- method WebContext::set_spell_checking_languages
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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 = "WebKit", 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.WebKit.Objects.WebContext.WebContext'
    -> [T.Text]
    -- ^ /@languages@/: a 'P.Nothing'-terminated list of spell checking languages
    -> m ()
webContextSetSpellCheckingLanguages :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> [Text] -> m ()
webContextSetSpellCheckingLanguages a
context [Text]
languages = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 a. a -> IO a
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.OverloadedMethod WebContextSetSpellCheckingLanguagesMethodInfo a signature where
    overloadedMethod = webContextSetSpellCheckingLanguages

instance O.OverloadedMethodInfo WebContextSetSpellCheckingLanguagesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextSetSpellCheckingLanguages",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextSetSpellCheckingLanguages"
        })


#endif

-- method WebContext::set_web_process_extensions_directory
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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_process_extensions_directory" webkit_web_context_set_web_process_extensions_directory :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit", name = "WebContext"})
    CString ->                              -- directory : TBasicType TUTF8
    IO ()

-- | Set the directory where WebKit will look for web process extensions.
-- 
-- This method must be called before loading anything in this context,
-- otherwise it will not have any effect. You can connect to
-- [WebContext::initializeWebProcessExtensions]("GI.WebKit.Objects.WebContext#g:signal:initializeWebProcessExtensions") to call this method
-- before anything is loaded.
webContextSetWebProcessExtensionsDirectory ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit.Objects.WebContext.WebContext'
    -> T.Text
    -- ^ /@directory@/: the directory to add
    -> m ()
webContextSetWebProcessExtensionsDirectory :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> Text -> m ()
webContextSetWebProcessExtensionsDirectory a
context Text
directory = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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_process_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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo WebContextSetWebProcessExtensionsDirectoryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextSetWebProcessExtensionsDirectory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextSetWebProcessExtensionsDirectory"
        })


#endif

-- method WebContext::set_web_process_extensions_initialization_user_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "WebKit" , 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_process_extensions_initialization_user_data" webkit_web_context_set_web_process_extensions_initialization_user_data :: 
    Ptr WebContext ->                       -- context : TInterface (Name {namespace = "WebKit", 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
-- @/WebKitWebProcessExtensionInitializeWithUserDataFunction/@.
-- This method must be called before loading anything in this context,
-- otherwise it will not have any effect. You can connect to
-- [WebContext::initializeWebProcessExtensions]("GI.WebKit.Objects.WebContext#g:signal:initializeWebProcessExtensions") to call this method
-- before anything is loaded.
-- 
-- /Since: 2.4/
webContextSetWebProcessExtensionsInitializationUserData ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit.Objects.WebContext.WebContext'
    -> GVariant
    -- ^ /@userData@/: a t'GVariant'
    -> m ()
webContextSetWebProcessExtensionsInitializationUserData :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebContext a) =>
a -> GVariant -> m ()
webContextSetWebProcessExtensionsInitializationUserData a
context GVariant
userData = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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_process_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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebContextSetWebProcessExtensionsInitializationUserDataMethodInfo
instance (signature ~ (GVariant -> m ()), MonadIO m, IsWebContext a) => O.OverloadedMethod WebContextSetWebProcessExtensionsInitializationUserDataMethodInfo a signature where
    overloadedMethod = webContextSetWebProcessExtensionsInitializationUserData

instance O.OverloadedMethodInfo WebContextSetWebProcessExtensionsInitializationUserDataMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.WebContext.webContextSetWebProcessExtensionsInitializationUserData",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.2/docs/GI-WebKit-Objects-WebContext.html#v:webContextSetWebProcessExtensionsInitializationUserData"
        })


#endif

-- method WebContext::get_default
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit" , 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.WebKit.Objects.WebContext.WebContext'
webContextGetDefault :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m WebContext
webContextGetDefault  = IO WebContext -> m WebContext
forall a. IO a -> m a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WebContext
result'

#if defined(ENABLE_OVERLOADING)
#endif