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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents a resource at the end of a URI.
-- 
-- A t'GI.WebKit2.Objects.WebResource.WebResource' encapsulates content for each resource at the
-- end of a particular URI. For example, one t'GI.WebKit2.Objects.WebResource.WebResource' will
-- be created for each separate image and stylesheet when a page is
-- loaded.
-- 
-- You can access the response and the URI for a given
-- t'GI.WebKit2.Objects.WebResource.WebResource', using 'GI.WebKit2.Objects.WebResource.webResourceGetUri' and
-- 'GI.WebKit2.Objects.WebResource.webResourceGetResponse', as well as the raw data, using
-- 'GI.WebKit2.Objects.WebResource.webResourceGetData'.

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

module GI.WebKit2.Objects.WebResource
    ( 

-- * Exported types
    WebResource(..)                         ,
    IsWebResource                           ,
    toWebResource                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [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"), [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"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.WebKit2.Objects.WebResource#g:method:getData"), [getDataFinish]("GI.WebKit2.Objects.WebResource#g:method:getDataFinish"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getResponse]("GI.WebKit2.Objects.WebResource#g:method:getResponse"), [getUri]("GI.WebKit2.Objects.WebResource#g:method:getUri").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveWebResourceMethod                ,
#endif

-- ** getData #method:getData#

#if defined(ENABLE_OVERLOADING)
    WebResourceGetDataMethodInfo            ,
#endif
    webResourceGetData                      ,


-- ** getDataFinish #method:getDataFinish#

#if defined(ENABLE_OVERLOADING)
    WebResourceGetDataFinishMethodInfo      ,
#endif
    webResourceGetDataFinish                ,


-- ** getResponse #method:getResponse#

#if defined(ENABLE_OVERLOADING)
    WebResourceGetResponseMethodInfo        ,
#endif
    webResourceGetResponse                  ,


-- ** getUri #method:getUri#

#if defined(ENABLE_OVERLOADING)
    WebResourceGetUriMethodInfo             ,
#endif
    webResourceGetUri                       ,




 -- * Properties


-- ** response #attr:response#
-- | The t'GI.WebKit2.Objects.URIResponse.URIResponse' associated with this resource.

#if defined(ENABLE_OVERLOADING)
    WebResourceResponsePropertyInfo         ,
#endif
    getWebResourceResponse                  ,
#if defined(ENABLE_OVERLOADING)
    webResourceResponse                     ,
#endif


-- ** uri #attr:uri#
-- | The current active URI of the t'GI.WebKit2.Objects.WebResource.WebResource'.
-- See 'GI.WebKit2.Objects.WebResource.webResourceGetUri' for more details.

#if defined(ENABLE_OVERLOADING)
    WebResourceUriPropertyInfo              ,
#endif
    getWebResourceUri                       ,
#if defined(ENABLE_OVERLOADING)
    webResourceUri                          ,
#endif




 -- * Signals


-- ** failed #signal:failed#

    WebResourceFailedCallback               ,
#if defined(ENABLE_OVERLOADING)
    WebResourceFailedSignalInfo             ,
#endif
    afterWebResourceFailed                  ,
    onWebResourceFailed                     ,


-- ** failedWithTlsErrors #signal:failedWithTlsErrors#

    WebResourceFailedWithTlsErrorsCallback  ,
#if defined(ENABLE_OVERLOADING)
    WebResourceFailedWithTlsErrorsSignalInfo,
#endif
    afterWebResourceFailedWithTlsErrors     ,
    onWebResourceFailedWithTlsErrors        ,


-- ** finished #signal:finished#

    WebResourceFinishedCallback             ,
#if defined(ENABLE_OVERLOADING)
    WebResourceFinishedSignalInfo           ,
#endif
    afterWebResourceFinished                ,
    onWebResourceFinished                   ,


-- ** receivedData #signal:receivedData#

    WebResourceReceivedDataCallback         ,
#if defined(ENABLE_OVERLOADING)
    WebResourceReceivedDataSignalInfo       ,
#endif
    afterWebResourceReceivedData            ,
    onWebResourceReceivedData               ,


-- ** sentRequest #signal:sentRequest#

    WebResourceSentRequestCallback          ,
#if defined(ENABLE_OVERLOADING)
    WebResourceSentRequestSignalInfo        ,
#endif
    afterWebResourceSentRequest             ,
    onWebResourceSentRequest                ,




    ) 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.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Flags as Gio.Flags
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.TlsCertificate as Gio.TlsCertificate
import {-# SOURCE #-} qualified GI.WebKit2.Objects.URIRequest as WebKit2.URIRequest
import {-# SOURCE #-} qualified GI.WebKit2.Objects.URIResponse as WebKit2.URIResponse

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

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

foreign import ccall "webkit_web_resource_get_type"
    c_webkit_web_resource_get_type :: IO B.Types.GType

instance B.Types.TypedObject WebResource where
    glibType :: IO GType
glibType = IO GType
c_webkit_web_resource_get_type

instance B.Types.GObject WebResource

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveWebResourceMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveWebResourceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveWebResourceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveWebResourceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveWebResourceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveWebResourceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveWebResourceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveWebResourceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveWebResourceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveWebResourceMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveWebResourceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveWebResourceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveWebResourceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveWebResourceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveWebResourceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveWebResourceMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveWebResourceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveWebResourceMethod "getData" o = WebResourceGetDataMethodInfo
    ResolveWebResourceMethod "getDataFinish" o = WebResourceGetDataFinishMethodInfo
    ResolveWebResourceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveWebResourceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveWebResourceMethod "getResponse" o = WebResourceGetResponseMethodInfo
    ResolveWebResourceMethod "getUri" o = WebResourceGetUriMethodInfo
    ResolveWebResourceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveWebResourceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveWebResourceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveWebResourceMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveWebResourceMethod t WebResource, O.OverloadedMethod info WebResource p) => OL.IsLabel t (WebResource -> 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 ~ ResolveWebResourceMethod t WebResource, O.OverloadedMethod info WebResource p, R.HasField t WebResource p) => R.HasField t WebResource p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveWebResourceMethod t WebResource, O.OverloadedMethodInfo info WebResource) => OL.IsLabel t (O.MethodProxy info WebResource) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- signal WebResource::failed
-- | This signal is emitted when an error occurs during the resource
-- load operation.
type WebResourceFailedCallback =
    GError
    -- ^ /@error@/: the t'GError' that was triggered
    -> IO ()

type C_WebResourceFailedCallback =
    Ptr WebResource ->                      -- object
    Ptr GError ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WebResourceFailedCallback :: 
    GObject a => (a -> WebResourceFailedCallback) ->
    C_WebResourceFailedCallback
wrap_WebResourceFailedCallback :: forall a.
GObject a =>
(a -> WebResourceFailedCallback) -> C_WebResourceFailedCallback
wrap_WebResourceFailedCallback a -> WebResourceFailedCallback
gi'cb Ptr WebResource
gi'selfPtr Ptr GError
error_ Ptr ()
_ = do
    GError
error_' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GError -> GError
GError) Ptr GError
error_
    Ptr WebResource -> (WebResource -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebResource
gi'selfPtr ((WebResource -> IO ()) -> IO ())
-> (WebResource -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebResource
gi'self -> a -> WebResourceFailedCallback
gi'cb (WebResource -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebResource
gi'self)  GError
error_'


-- | Connect a signal handler for the [failed](#signal:failed) 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' webResource #failed callback
-- @
-- 
-- 
onWebResourceFailed :: (IsWebResource a, MonadIO m) => a -> ((?self :: a) => WebResourceFailedCallback) -> m SignalHandlerId
onWebResourceFailed :: forall a (m :: * -> *).
(IsWebResource a, MonadIO m) =>
a -> ((?self::a) => WebResourceFailedCallback) -> m SignalHandlerId
onWebResourceFailed a
obj (?self::a) => WebResourceFailedCallback
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 -> WebResourceFailedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebResourceFailedCallback
WebResourceFailedCallback
cb
    let wrapped' :: C_WebResourceFailedCallback
wrapped' = (a -> WebResourceFailedCallback) -> C_WebResourceFailedCallback
forall a.
GObject a =>
(a -> WebResourceFailedCallback) -> C_WebResourceFailedCallback
wrap_WebResourceFailedCallback a -> WebResourceFailedCallback
wrapped
    FunPtr C_WebResourceFailedCallback
wrapped'' <- C_WebResourceFailedCallback
-> IO (FunPtr C_WebResourceFailedCallback)
mk_WebResourceFailedCallback C_WebResourceFailedCallback
wrapped'
    a
-> Text
-> FunPtr C_WebResourceFailedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"failed" FunPtr C_WebResourceFailedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [failed](#signal:failed) 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' webResource #failed 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.
-- 
afterWebResourceFailed :: (IsWebResource a, MonadIO m) => a -> ((?self :: a) => WebResourceFailedCallback) -> m SignalHandlerId
afterWebResourceFailed :: forall a (m :: * -> *).
(IsWebResource a, MonadIO m) =>
a -> ((?self::a) => WebResourceFailedCallback) -> m SignalHandlerId
afterWebResourceFailed a
obj (?self::a) => WebResourceFailedCallback
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 -> WebResourceFailedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebResourceFailedCallback
WebResourceFailedCallback
cb
    let wrapped' :: C_WebResourceFailedCallback
wrapped' = (a -> WebResourceFailedCallback) -> C_WebResourceFailedCallback
forall a.
GObject a =>
(a -> WebResourceFailedCallback) -> C_WebResourceFailedCallback
wrap_WebResourceFailedCallback a -> WebResourceFailedCallback
wrapped
    FunPtr C_WebResourceFailedCallback
wrapped'' <- C_WebResourceFailedCallback
-> IO (FunPtr C_WebResourceFailedCallback)
mk_WebResourceFailedCallback C_WebResourceFailedCallback
wrapped'
    a
-> Text
-> FunPtr C_WebResourceFailedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"failed" FunPtr C_WebResourceFailedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebResourceFailedSignalInfo
instance SignalInfo WebResourceFailedSignalInfo where
    type HaskellCallbackType WebResourceFailedSignalInfo = WebResourceFailedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebResourceFailedCallback cb
        cb'' <- mk_WebResourceFailedCallback cb'
        connectSignalFunPtr obj "failed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebResource::failed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Objects-WebResource.html#g:signal:failed"})

#endif

-- signal WebResource::failed-with-tls-errors
-- | This signal is emitted when a TLS error occurs during the resource load operation.
-- 
-- /Since: 2.8/
type WebResourceFailedWithTlsErrorsCallback =
    Gio.TlsCertificate.TlsCertificate
    -- ^ /@certificate@/: a t'GI.Gio.Objects.TlsCertificate.TlsCertificate'
    -> [Gio.Flags.TlsCertificateFlags]
    -- ^ /@errors@/: a t'GI.Gio.Flags.TlsCertificateFlags' with the verification status of /@certificate@/
    -> IO ()

type C_WebResourceFailedWithTlsErrorsCallback =
    Ptr WebResource ->                      -- object
    Ptr Gio.TlsCertificate.TlsCertificate ->
    CUInt ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WebResourceFailedWithTlsErrorsCallback :: 
    GObject a => (a -> WebResourceFailedWithTlsErrorsCallback) ->
    C_WebResourceFailedWithTlsErrorsCallback
wrap_WebResourceFailedWithTlsErrorsCallback :: forall a.
GObject a =>
(a -> WebResourceFailedWithTlsErrorsCallback)
-> C_WebResourceFailedWithTlsErrorsCallback
wrap_WebResourceFailedWithTlsErrorsCallback a -> WebResourceFailedWithTlsErrorsCallback
gi'cb Ptr WebResource
gi'selfPtr Ptr TlsCertificate
certificate CUInt
errors Ptr ()
_ = do
    TlsCertificate
certificate' <- ((ManagedPtr TlsCertificate -> TlsCertificate)
-> Ptr TlsCertificate -> IO TlsCertificate
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TlsCertificate -> TlsCertificate
Gio.TlsCertificate.TlsCertificate) Ptr TlsCertificate
certificate
    let errors' :: [TlsCertificateFlags]
errors' = CUInt -> [TlsCertificateFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
errors
    Ptr WebResource -> (WebResource -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebResource
gi'selfPtr ((WebResource -> IO ()) -> IO ())
-> (WebResource -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebResource
gi'self -> a -> WebResourceFailedWithTlsErrorsCallback
gi'cb (WebResource -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebResource
gi'self)  TlsCertificate
certificate' [TlsCertificateFlags]
errors'


-- | Connect a signal handler for the [failedWithTlsErrors](#signal:failedWithTlsErrors) 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' webResource #failedWithTlsErrors callback
-- @
-- 
-- 
onWebResourceFailedWithTlsErrors :: (IsWebResource a, MonadIO m) => a -> ((?self :: a) => WebResourceFailedWithTlsErrorsCallback) -> m SignalHandlerId
onWebResourceFailedWithTlsErrors :: forall a (m :: * -> *).
(IsWebResource a, MonadIO m) =>
a
-> ((?self::a) => WebResourceFailedWithTlsErrorsCallback)
-> m SignalHandlerId
onWebResourceFailedWithTlsErrors a
obj (?self::a) => WebResourceFailedWithTlsErrorsCallback
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 -> WebResourceFailedWithTlsErrorsCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebResourceFailedWithTlsErrorsCallback
WebResourceFailedWithTlsErrorsCallback
cb
    let wrapped' :: C_WebResourceFailedWithTlsErrorsCallback
wrapped' = (a -> WebResourceFailedWithTlsErrorsCallback)
-> C_WebResourceFailedWithTlsErrorsCallback
forall a.
GObject a =>
(a -> WebResourceFailedWithTlsErrorsCallback)
-> C_WebResourceFailedWithTlsErrorsCallback
wrap_WebResourceFailedWithTlsErrorsCallback a -> WebResourceFailedWithTlsErrorsCallback
wrapped
    FunPtr C_WebResourceFailedWithTlsErrorsCallback
wrapped'' <- C_WebResourceFailedWithTlsErrorsCallback
-> IO (FunPtr C_WebResourceFailedWithTlsErrorsCallback)
mk_WebResourceFailedWithTlsErrorsCallback C_WebResourceFailedWithTlsErrorsCallback
wrapped'
    a
-> Text
-> FunPtr C_WebResourceFailedWithTlsErrorsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"failed-with-tls-errors" FunPtr C_WebResourceFailedWithTlsErrorsCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [failedWithTlsErrors](#signal:failedWithTlsErrors) 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' webResource #failedWithTlsErrors 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.
-- 
afterWebResourceFailedWithTlsErrors :: (IsWebResource a, MonadIO m) => a -> ((?self :: a) => WebResourceFailedWithTlsErrorsCallback) -> m SignalHandlerId
afterWebResourceFailedWithTlsErrors :: forall a (m :: * -> *).
(IsWebResource a, MonadIO m) =>
a
-> ((?self::a) => WebResourceFailedWithTlsErrorsCallback)
-> m SignalHandlerId
afterWebResourceFailedWithTlsErrors a
obj (?self::a) => WebResourceFailedWithTlsErrorsCallback
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 -> WebResourceFailedWithTlsErrorsCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebResourceFailedWithTlsErrorsCallback
WebResourceFailedWithTlsErrorsCallback
cb
    let wrapped' :: C_WebResourceFailedWithTlsErrorsCallback
wrapped' = (a -> WebResourceFailedWithTlsErrorsCallback)
-> C_WebResourceFailedWithTlsErrorsCallback
forall a.
GObject a =>
(a -> WebResourceFailedWithTlsErrorsCallback)
-> C_WebResourceFailedWithTlsErrorsCallback
wrap_WebResourceFailedWithTlsErrorsCallback a -> WebResourceFailedWithTlsErrorsCallback
wrapped
    FunPtr C_WebResourceFailedWithTlsErrorsCallback
wrapped'' <- C_WebResourceFailedWithTlsErrorsCallback
-> IO (FunPtr C_WebResourceFailedWithTlsErrorsCallback)
mk_WebResourceFailedWithTlsErrorsCallback C_WebResourceFailedWithTlsErrorsCallback
wrapped'
    a
-> Text
-> FunPtr C_WebResourceFailedWithTlsErrorsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"failed-with-tls-errors" FunPtr C_WebResourceFailedWithTlsErrorsCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebResourceFailedWithTlsErrorsSignalInfo
instance SignalInfo WebResourceFailedWithTlsErrorsSignalInfo where
    type HaskellCallbackType WebResourceFailedWithTlsErrorsSignalInfo = WebResourceFailedWithTlsErrorsCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebResourceFailedWithTlsErrorsCallback cb
        cb'' <- mk_WebResourceFailedWithTlsErrorsCallback cb'
        connectSignalFunPtr obj "failed-with-tls-errors" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebResource::failed-with-tls-errors"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Objects-WebResource.html#g:signal:failedWithTlsErrors"})

#endif

-- signal WebResource::finished
-- | This signal is emitted when the resource load finishes successfully
-- or due to an error. In case of errors [WebResource::failed]("GI.WebKit2.Objects.WebResource#g:signal:failed") signal
-- is emitted before this one.
type WebResourceFinishedCallback =
    IO ()

type C_WebResourceFinishedCallback =
    Ptr WebResource ->                      -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WebResourceFinishedCallback :: 
    GObject a => (a -> WebResourceFinishedCallback) ->
    C_WebResourceFinishedCallback
wrap_WebResourceFinishedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_WebResourceFinishedCallback
wrap_WebResourceFinishedCallback a -> IO ()
gi'cb Ptr WebResource
gi'selfPtr Ptr ()
_ = do
    Ptr WebResource -> (WebResource -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebResource
gi'selfPtr ((WebResource -> IO ()) -> IO ())
-> (WebResource -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebResource
gi'self -> a -> IO ()
gi'cb (WebResource -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebResource
gi'self) 


-- | Connect a signal handler for the [finished](#signal:finished) 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' webResource #finished callback
-- @
-- 
-- 
onWebResourceFinished :: (IsWebResource a, MonadIO m) => a -> ((?self :: a) => WebResourceFinishedCallback) -> m SignalHandlerId
onWebResourceFinished :: forall a (m :: * -> *).
(IsWebResource a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWebResourceFinished 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_WebResourceFinishedCallback
wrapped' = (a -> IO ()) -> C_WebResourceFinishedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_WebResourceFinishedCallback
wrap_WebResourceFinishedCallback a -> IO ()
wrapped
    FunPtr C_WebResourceFinishedCallback
wrapped'' <- C_WebResourceFinishedCallback
-> IO (FunPtr C_WebResourceFinishedCallback)
mk_WebResourceFinishedCallback C_WebResourceFinishedCallback
wrapped'
    a
-> Text
-> FunPtr C_WebResourceFinishedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"finished" FunPtr C_WebResourceFinishedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [finished](#signal:finished) 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' webResource #finished 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.
-- 
afterWebResourceFinished :: (IsWebResource a, MonadIO m) => a -> ((?self :: a) => WebResourceFinishedCallback) -> m SignalHandlerId
afterWebResourceFinished :: forall a (m :: * -> *).
(IsWebResource a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterWebResourceFinished 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_WebResourceFinishedCallback
wrapped' = (a -> IO ()) -> C_WebResourceFinishedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_WebResourceFinishedCallback
wrap_WebResourceFinishedCallback a -> IO ()
wrapped
    FunPtr C_WebResourceFinishedCallback
wrapped'' <- C_WebResourceFinishedCallback
-> IO (FunPtr C_WebResourceFinishedCallback)
mk_WebResourceFinishedCallback C_WebResourceFinishedCallback
wrapped'
    a
-> Text
-> FunPtr C_WebResourceFinishedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"finished" FunPtr C_WebResourceFinishedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebResourceFinishedSignalInfo
instance SignalInfo WebResourceFinishedSignalInfo where
    type HaskellCallbackType WebResourceFinishedSignalInfo = WebResourceFinishedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebResourceFinishedCallback cb
        cb'' <- mk_WebResourceFinishedCallback cb'
        connectSignalFunPtr obj "finished" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebResource::finished"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Objects-WebResource.html#g:signal:finished"})

#endif

-- signal WebResource::received-data
{-# DEPRECATED WebResourceReceivedDataCallback ["(Since version 2.40)"] #-}
-- | This signal is emitted after response is received,
-- every time new data has been received. It\'s
-- useful to know the progress of the resource load operation.
-- 
-- This is signal is deprecated since version 2.40 and it\'s never emitted.
type WebResourceReceivedDataCallback =
    Word64
    -- ^ /@dataLength@/: the length of data received in bytes
    -> IO ()

type C_WebResourceReceivedDataCallback =
    Ptr WebResource ->                      -- object
    Word64 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WebResourceReceivedDataCallback :: 
    GObject a => (a -> WebResourceReceivedDataCallback) ->
    C_WebResourceReceivedDataCallback
wrap_WebResourceReceivedDataCallback :: forall a.
GObject a =>
(a -> WebResourceReceivedDataCallback)
-> C_WebResourceReceivedDataCallback
wrap_WebResourceReceivedDataCallback a -> WebResourceReceivedDataCallback
gi'cb Ptr WebResource
gi'selfPtr Word64
dataLength Ptr ()
_ = do
    Ptr WebResource -> (WebResource -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebResource
gi'selfPtr ((WebResource -> IO ()) -> IO ())
-> (WebResource -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebResource
gi'self -> a -> WebResourceReceivedDataCallback
gi'cb (WebResource -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebResource
gi'self)  Word64
dataLength


-- | Connect a signal handler for the [receivedData](#signal:receivedData) 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' webResource #receivedData callback
-- @
-- 
-- 
onWebResourceReceivedData :: (IsWebResource a, MonadIO m) => a -> ((?self :: a) => WebResourceReceivedDataCallback) -> m SignalHandlerId
onWebResourceReceivedData :: forall a (m :: * -> *).
(IsWebResource a, MonadIO m) =>
a
-> ((?self::a) => WebResourceReceivedDataCallback)
-> m SignalHandlerId
onWebResourceReceivedData a
obj (?self::a) => WebResourceReceivedDataCallback
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 -> WebResourceReceivedDataCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebResourceReceivedDataCallback
WebResourceReceivedDataCallback
cb
    let wrapped' :: C_WebResourceReceivedDataCallback
wrapped' = (a -> WebResourceReceivedDataCallback)
-> C_WebResourceReceivedDataCallback
forall a.
GObject a =>
(a -> WebResourceReceivedDataCallback)
-> C_WebResourceReceivedDataCallback
wrap_WebResourceReceivedDataCallback a -> WebResourceReceivedDataCallback
wrapped
    FunPtr C_WebResourceReceivedDataCallback
wrapped'' <- C_WebResourceReceivedDataCallback
-> IO (FunPtr C_WebResourceReceivedDataCallback)
mk_WebResourceReceivedDataCallback C_WebResourceReceivedDataCallback
wrapped'
    a
-> Text
-> FunPtr C_WebResourceReceivedDataCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"received-data" FunPtr C_WebResourceReceivedDataCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [receivedData](#signal:receivedData) 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' webResource #receivedData 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.
-- 
afterWebResourceReceivedData :: (IsWebResource a, MonadIO m) => a -> ((?self :: a) => WebResourceReceivedDataCallback) -> m SignalHandlerId
afterWebResourceReceivedData :: forall a (m :: * -> *).
(IsWebResource a, MonadIO m) =>
a
-> ((?self::a) => WebResourceReceivedDataCallback)
-> m SignalHandlerId
afterWebResourceReceivedData a
obj (?self::a) => WebResourceReceivedDataCallback
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 -> WebResourceReceivedDataCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebResourceReceivedDataCallback
WebResourceReceivedDataCallback
cb
    let wrapped' :: C_WebResourceReceivedDataCallback
wrapped' = (a -> WebResourceReceivedDataCallback)
-> C_WebResourceReceivedDataCallback
forall a.
GObject a =>
(a -> WebResourceReceivedDataCallback)
-> C_WebResourceReceivedDataCallback
wrap_WebResourceReceivedDataCallback a -> WebResourceReceivedDataCallback
wrapped
    FunPtr C_WebResourceReceivedDataCallback
wrapped'' <- C_WebResourceReceivedDataCallback
-> IO (FunPtr C_WebResourceReceivedDataCallback)
mk_WebResourceReceivedDataCallback C_WebResourceReceivedDataCallback
wrapped'
    a
-> Text
-> FunPtr C_WebResourceReceivedDataCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"received-data" FunPtr C_WebResourceReceivedDataCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebResourceReceivedDataSignalInfo
instance SignalInfo WebResourceReceivedDataSignalInfo where
    type HaskellCallbackType WebResourceReceivedDataSignalInfo = WebResourceReceivedDataCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebResourceReceivedDataCallback cb
        cb'' <- mk_WebResourceReceivedDataCallback cb'
        connectSignalFunPtr obj "received-data" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebResource::received-data"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Objects-WebResource.html#g:signal:receivedData"})

#endif

-- signal WebResource::sent-request
-- | This signal is emitted when /@request@/ has been sent to the
-- server. In case of a server redirection this signal is
-- emitted again with the /@request@/ argument containing the new
-- request sent to the server due to the redirection and the
-- /@redirectedResponse@/ parameter containing the response
-- received by the server for the initial request.
type WebResourceSentRequestCallback =
    WebKit2.URIRequest.URIRequest
    -- ^ /@request@/: a t'GI.WebKit2.Objects.URIRequest.URIRequest'
    -> WebKit2.URIResponse.URIResponse
    -- ^ /@redirectedResponse@/: a t'GI.WebKit2.Objects.URIResponse.URIResponse', or 'P.Nothing'
    -> IO ()

type C_WebResourceSentRequestCallback =
    Ptr WebResource ->                      -- object
    Ptr WebKit2.URIRequest.URIRequest ->
    Ptr WebKit2.URIResponse.URIResponse ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WebResourceSentRequestCallback :: 
    GObject a => (a -> WebResourceSentRequestCallback) ->
    C_WebResourceSentRequestCallback
wrap_WebResourceSentRequestCallback :: forall a.
GObject a =>
(a -> WebResourceSentRequestCallback)
-> C_WebResourceSentRequestCallback
wrap_WebResourceSentRequestCallback a -> WebResourceSentRequestCallback
gi'cb Ptr WebResource
gi'selfPtr Ptr URIRequest
request Ptr URIResponse
redirectedResponse Ptr ()
_ = do
    URIRequest
request' <- ((ManagedPtr URIRequest -> URIRequest)
-> Ptr URIRequest -> IO URIRequest
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr URIRequest -> URIRequest
WebKit2.URIRequest.URIRequest) Ptr URIRequest
request
    URIResponse
redirectedResponse' <- ((ManagedPtr URIResponse -> URIResponse)
-> Ptr URIResponse -> IO URIResponse
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr URIResponse -> URIResponse
WebKit2.URIResponse.URIResponse) Ptr URIResponse
redirectedResponse
    Ptr WebResource -> (WebResource -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebResource
gi'selfPtr ((WebResource -> IO ()) -> IO ())
-> (WebResource -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebResource
gi'self -> a -> WebResourceSentRequestCallback
gi'cb (WebResource -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebResource
gi'self)  URIRequest
request' URIResponse
redirectedResponse'


-- | Connect a signal handler for the [sentRequest](#signal:sentRequest) 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' webResource #sentRequest callback
-- @
-- 
-- 
onWebResourceSentRequest :: (IsWebResource a, MonadIO m) => a -> ((?self :: a) => WebResourceSentRequestCallback) -> m SignalHandlerId
onWebResourceSentRequest :: forall a (m :: * -> *).
(IsWebResource a, MonadIO m) =>
a
-> ((?self::a) => WebResourceSentRequestCallback)
-> m SignalHandlerId
onWebResourceSentRequest a
obj (?self::a) => WebResourceSentRequestCallback
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 -> WebResourceSentRequestCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebResourceSentRequestCallback
WebResourceSentRequestCallback
cb
    let wrapped' :: C_WebResourceSentRequestCallback
wrapped' = (a -> WebResourceSentRequestCallback)
-> C_WebResourceSentRequestCallback
forall a.
GObject a =>
(a -> WebResourceSentRequestCallback)
-> C_WebResourceSentRequestCallback
wrap_WebResourceSentRequestCallback a -> WebResourceSentRequestCallback
wrapped
    FunPtr C_WebResourceSentRequestCallback
wrapped'' <- C_WebResourceSentRequestCallback
-> IO (FunPtr C_WebResourceSentRequestCallback)
mk_WebResourceSentRequestCallback C_WebResourceSentRequestCallback
wrapped'
    a
-> Text
-> FunPtr C_WebResourceSentRequestCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"sent-request" FunPtr C_WebResourceSentRequestCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [sentRequest](#signal:sentRequest) 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' webResource #sentRequest 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.
-- 
afterWebResourceSentRequest :: (IsWebResource a, MonadIO m) => a -> ((?self :: a) => WebResourceSentRequestCallback) -> m SignalHandlerId
afterWebResourceSentRequest :: forall a (m :: * -> *).
(IsWebResource a, MonadIO m) =>
a
-> ((?self::a) => WebResourceSentRequestCallback)
-> m SignalHandlerId
afterWebResourceSentRequest a
obj (?self::a) => WebResourceSentRequestCallback
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 -> WebResourceSentRequestCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebResourceSentRequestCallback
WebResourceSentRequestCallback
cb
    let wrapped' :: C_WebResourceSentRequestCallback
wrapped' = (a -> WebResourceSentRequestCallback)
-> C_WebResourceSentRequestCallback
forall a.
GObject a =>
(a -> WebResourceSentRequestCallback)
-> C_WebResourceSentRequestCallback
wrap_WebResourceSentRequestCallback a -> WebResourceSentRequestCallback
wrapped
    FunPtr C_WebResourceSentRequestCallback
wrapped'' <- C_WebResourceSentRequestCallback
-> IO (FunPtr C_WebResourceSentRequestCallback)
mk_WebResourceSentRequestCallback C_WebResourceSentRequestCallback
wrapped'
    a
-> Text
-> FunPtr C_WebResourceSentRequestCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"sent-request" FunPtr C_WebResourceSentRequestCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebResourceSentRequestSignalInfo
instance SignalInfo WebResourceSentRequestSignalInfo where
    type HaskellCallbackType WebResourceSentRequestSignalInfo = WebResourceSentRequestCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebResourceSentRequestCallback cb
        cb'' <- mk_WebResourceSentRequestCallback cb'
        connectSignalFunPtr obj "sent-request" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebResource::sent-request"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Objects-WebResource.html#g:signal:sentRequest"})

#endif

-- VVV Prop "response"
   -- Type: TInterface (Name {namespace = "WebKit2", name = "URIResponse"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@response@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' webResource #response
-- @
getWebResourceResponse :: (MonadIO m, IsWebResource o) => o -> m (Maybe WebKit2.URIResponse.URIResponse)
getWebResourceResponse :: forall (m :: * -> *) o.
(MonadIO m, IsWebResource o) =>
o -> m (Maybe URIResponse)
getWebResourceResponse o
obj = IO (Maybe URIResponse) -> m (Maybe URIResponse)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe URIResponse) -> m (Maybe URIResponse))
-> IO (Maybe URIResponse) -> m (Maybe URIResponse)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr URIResponse -> URIResponse)
-> IO (Maybe URIResponse)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"response" ManagedPtr URIResponse -> URIResponse
WebKit2.URIResponse.URIResponse

#if defined(ENABLE_OVERLOADING)
data WebResourceResponsePropertyInfo
instance AttrInfo WebResourceResponsePropertyInfo where
    type AttrAllowedOps WebResourceResponsePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint WebResourceResponsePropertyInfo = IsWebResource
    type AttrSetTypeConstraint WebResourceResponsePropertyInfo = (~) ()
    type AttrTransferTypeConstraint WebResourceResponsePropertyInfo = (~) ()
    type AttrTransferType WebResourceResponsePropertyInfo = ()
    type AttrGetType WebResourceResponsePropertyInfo = (Maybe WebKit2.URIResponse.URIResponse)
    type AttrLabel WebResourceResponsePropertyInfo = "response"
    type AttrOrigin WebResourceResponsePropertyInfo = WebResource
    attrGet = getWebResourceResponse
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebResource.response"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Objects-WebResource.html#g:attr:response"
        })
#endif

-- VVV Prop "uri"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@uri@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' webResource #uri
-- @
getWebResourceUri :: (MonadIO m, IsWebResource o) => o -> m T.Text
getWebResourceUri :: forall (m :: * -> *) o. (MonadIO m, IsWebResource o) => o -> m Text
getWebResourceUri 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
"getWebResourceUri" (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
"uri"

#if defined(ENABLE_OVERLOADING)
data WebResourceUriPropertyInfo
instance AttrInfo WebResourceUriPropertyInfo where
    type AttrAllowedOps WebResourceUriPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint WebResourceUriPropertyInfo = IsWebResource
    type AttrSetTypeConstraint WebResourceUriPropertyInfo = (~) ()
    type AttrTransferTypeConstraint WebResourceUriPropertyInfo = (~) ()
    type AttrTransferType WebResourceUriPropertyInfo = ()
    type AttrGetType WebResourceUriPropertyInfo = T.Text
    type AttrLabel WebResourceUriPropertyInfo = "uri"
    type AttrOrigin WebResourceUriPropertyInfo = WebResource
    attrGet = getWebResourceUri
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebResource.uri"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Objects-WebResource.html#g:attr:uri"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList WebResource
type instance O.AttributeList WebResource = WebResourceAttributeList
type WebResourceAttributeList = ('[ '("response", WebResourceResponsePropertyInfo), '("uri", WebResourceUriPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
webResourceResponse :: AttrLabelProxy "response"
webResourceResponse = AttrLabelProxy

webResourceUri :: AttrLabelProxy "uri"
webResourceUri = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList WebResource = WebResourceSignalList
type WebResourceSignalList = ('[ '("failed", WebResourceFailedSignalInfo), '("failedWithTlsErrors", WebResourceFailedWithTlsErrorsSignalInfo), '("finished", WebResourceFinishedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("receivedData", WebResourceReceivedDataSignalInfo), '("sentRequest", WebResourceSentRequestSignalInfo)] :: [(Symbol, DK.Type)])

#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data WebResourceGetDataMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsWebResource a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod WebResourceGetDataMethodInfo a signature where
    overloadedMethod = webResourceGetData

instance O.OverloadedMethodInfo WebResourceGetDataMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebResource.webResourceGetData",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Objects-WebResource.html#v:webResourceGetData"
        })


#endif

-- method WebResource::get_data_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "resource"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebResource" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebResource"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the length of the resource data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just "return location for the length of the resource data"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 2 (TBasicType TUInt8))
-- throws : True
-- Skip return : False

foreign import ccall "webkit_web_resource_get_data_finish" webkit_web_resource_get_data_finish :: 
    Ptr WebResource ->                      -- resource : TInterface (Name {namespace = "WebKit2", name = "WebResource"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Word8)

-- | Finish an asynchronous operation started with 'GI.WebKit2.Objects.WebResource.webResourceGetData'.
webResourceGetDataFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebResource a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@resource@/: a t'GI.WebKit2.Objects.WebResource.WebResource'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ByteString
    -- ^ __Returns:__ a
    --    string with the data of /@resource@/, or 'P.Nothing' in case of error. if /@length@/
    --    is not 'P.Nothing', the size of the data will be assigned to it. /(Can throw 'Data.GI.Base.GError.GError')/
webResourceGetDataFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsWebResource a, IsAsyncResult b) =>
a -> b -> m ByteString
webResourceGetDataFinish a
resource b
result_ = IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebResource
resource' <- a -> IO (Ptr WebResource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
resource
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    IO ByteString -> IO () -> IO ByteString
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Word8
result <- (Ptr (Ptr GError) -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Word8)) -> IO (Ptr Word8))
-> (Ptr (Ptr GError) -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Ptr WebResource
-> Ptr AsyncResult
-> Ptr Word64
-> Ptr (Ptr GError)
-> IO (Ptr Word8)
webkit_web_resource_get_data_finish Ptr WebResource
resource' Ptr AsyncResult
result_' Ptr Word64
length_
        Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
        Text -> Ptr Word8 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"webResourceGetDataFinish" Ptr Word8
result
        ByteString
result' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
length_') Ptr Word8
result
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
resource
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result'
     ) (do
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
     )

#if defined(ENABLE_OVERLOADING)
data WebResourceGetDataFinishMethodInfo
instance (signature ~ (b -> m ByteString), MonadIO m, IsWebResource a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod WebResourceGetDataFinishMethodInfo a signature where
    overloadedMethod = webResourceGetDataFinish

instance O.OverloadedMethodInfo WebResourceGetDataFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebResource.webResourceGetDataFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Objects-WebResource.html#v:webResourceGetDataFinish"
        })


#endif

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

foreign import ccall "webkit_web_resource_get_response" webkit_web_resource_get_response :: 
    Ptr WebResource ->                      -- resource : TInterface (Name {namespace = "WebKit2", name = "WebResource"})
    IO (Ptr WebKit2.URIResponse.URIResponse)

-- | Retrieves the t'GI.WebKit2.Objects.URIResponse.URIResponse' of the resource load operation.
-- 
-- This method returns 'P.Nothing' if called before the response
-- is received from the server. You can connect to notify[response](#g:signal:response)
-- signal to be notified when the response is received.
webResourceGetResponse ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebResource a) =>
    a
    -- ^ /@resource@/: a t'GI.WebKit2.Objects.WebResource.WebResource'
    -> m (Maybe WebKit2.URIResponse.URIResponse)
    -- ^ __Returns:__ the t'GI.WebKit2.Objects.URIResponse.URIResponse', or 'P.Nothing' if
    --     the response hasn\'t been received yet.
webResourceGetResponse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebResource a) =>
a -> m (Maybe URIResponse)
webResourceGetResponse a
resource = IO (Maybe URIResponse) -> m (Maybe URIResponse)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe URIResponse) -> m (Maybe URIResponse))
-> IO (Maybe URIResponse) -> m (Maybe URIResponse)
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebResource
resource' <- a -> IO (Ptr WebResource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
resource
    Ptr URIResponse
result <- Ptr WebResource -> IO (Ptr URIResponse)
webkit_web_resource_get_response Ptr WebResource
resource'
    Maybe URIResponse
maybeResult <- Ptr URIResponse
-> (Ptr URIResponse -> IO URIResponse) -> IO (Maybe URIResponse)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr URIResponse
result ((Ptr URIResponse -> IO URIResponse) -> IO (Maybe URIResponse))
-> (Ptr URIResponse -> IO URIResponse) -> IO (Maybe URIResponse)
forall a b. (a -> b) -> a -> b
$ \Ptr URIResponse
result' -> do
        URIResponse
result'' <- ((ManagedPtr URIResponse -> URIResponse)
-> Ptr URIResponse -> IO URIResponse
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr URIResponse -> URIResponse
WebKit2.URIResponse.URIResponse) Ptr URIResponse
result'
        URIResponse -> IO URIResponse
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return URIResponse
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
resource
    Maybe URIResponse -> IO (Maybe URIResponse)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe URIResponse
maybeResult

#if defined(ENABLE_OVERLOADING)
data WebResourceGetResponseMethodInfo
instance (signature ~ (m (Maybe WebKit2.URIResponse.URIResponse)), MonadIO m, IsWebResource a) => O.OverloadedMethod WebResourceGetResponseMethodInfo a signature where
    overloadedMethod = webResourceGetResponse

instance O.OverloadedMethodInfo WebResourceGetResponseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebResource.webResourceGetResponse",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Objects-WebResource.html#v:webResourceGetResponse"
        })


#endif

-- method WebResource::get_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "resource"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebResource" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebResource"
--                 , 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_resource_get_uri" webkit_web_resource_get_uri :: 
    Ptr WebResource ->                      -- resource : TInterface (Name {namespace = "WebKit2", name = "WebResource"})
    IO CString

-- | Returns the current active URI of /@resource@/.
-- 
-- The active URI might change during
-- a load operation:
-- 
-- \<orderedlist>
-- \<listitem>\<para>
--   When the resource load starts, the active URI is the requested URI
-- \<\/para>\<\/listitem>
-- \<listitem>\<para>
--   When the initial request is sent to the server, [WebResource::sentRequest]("GI.WebKit2.Objects.WebResource#g:signal:sentRequest")
--   signal is emitted without a redirected response, the active URI is the URI of
--   the request sent to the server.
-- \<\/para>\<\/listitem>
-- \<listitem>\<para>
--   In case of a server redirection, [WebResource::sentRequest]("GI.WebKit2.Objects.WebResource#g:signal:sentRequest") signal
--   is emitted again with a redirected response, the active URI is the URI the request
--   was redirected to.
-- \<\/para>\<\/listitem>
-- \<listitem>\<para>
--   When the response is received from the server, the active URI is the final
--   one and it will not change again.
-- \<\/para>\<\/listitem>
-- \<\/orderedlist>
-- 
-- You can monitor the active URI by connecting to the notify[uri](#g:signal:uri)
-- signal of /@resource@/.
webResourceGetUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebResource a) =>
    a
    -- ^ /@resource@/: a t'GI.WebKit2.Objects.WebResource.WebResource'
    -> m T.Text
    -- ^ __Returns:__ the current active URI of /@resource@/
webResourceGetUri :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebResource a) =>
a -> m Text
webResourceGetUri a
resource = 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 WebResource
resource' <- a -> IO (Ptr WebResource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
resource
    CString
result <- Ptr WebResource -> IO CString
webkit_web_resource_get_uri Ptr WebResource
resource'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"webResourceGetUri" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
resource
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data WebResourceGetUriMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsWebResource a) => O.OverloadedMethod WebResourceGetUriMethodInfo a signature where
    overloadedMethod = webResourceGetUri

instance O.OverloadedMethodInfo WebResourceGetUriMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebResource.webResourceGetUri",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Objects-WebResource.html#v:webResourceGetUri"
        })


#endif