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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents an extension of the WebProcess.
-- 
-- WebKitWebExtension is a loadable module for the WebProcess. It allows you to execute code in the
-- WebProcess and being able to use the DOM API, to change any request or to inject custom
-- JavaScript code, for example.
-- 
-- To create a WebKitWebExtension you should write a module with an initialization function that could
-- be either @/webkit_web_extension_initialize()/@ with prototype t'GI.WebKit2WebExtension.Callbacks.WebExtensionInitializeFunction' or
-- @/webkit_web_extension_initialize_with_user_data()/@ with prototype t'GI.WebKit2WebExtension.Callbacks.WebExtensionInitializeWithUserDataFunction'.
-- This function has to be public and it has to use the @/G_MODULE_EXPORT/@ macro. It is called when the
-- web process is initialized.
-- 
-- 
-- === /c code/
-- >static void
-- >web_page_created_callback (WebKitWebExtension *extension,
-- >                           WebKitWebPage      *web_page,
-- >                           gpointer            user_data)
-- >{
-- >    g_print ("Page %d created for %s\n",
-- >             webkit_web_page_get_id (web_page),
-- >             webkit_web_page_get_uri (web_page));
-- >}
-- >
-- >G_MODULE_EXPORT void
-- >webkit_web_extension_initialize (WebKitWebExtension *extension)
-- >{
-- >    g_signal_connect (extension, "page-created",
-- >                      G_CALLBACK (web_page_created_callback),
-- >                      NULL);
-- >}
-- 
-- 
-- The previous piece of code shows a trivial example of an extension that notifies when
-- a t'GI.WebKit2WebExtension.Objects.WebPage.WebPage' is created.
-- 
-- WebKit has to know where it can find the created WebKitWebExtension. To do so you
-- should use the @/webkit_web_context_set_web_extensions_directory()/@ function. The signal
-- @/WebKitWebContext::initialize-web-extensions/@ is the recommended place to call it.
-- 
-- To provide the initialization data used by the @/webkit_web_extension_initialize_with_user_data()/@
-- function, you have to call @/webkit_web_context_set_web_extensions_initialization_user_data()/@ with
-- the desired data as parameter. You can see an example of this in the following piece of code:
-- 
-- 
-- === /c code/
-- >#define WEB_EXTENSIONS_DIRECTORY // ...
-- >
-- >static void
-- >initialize_web_extensions (WebKitWebContext *context,
-- >                           gpointer          user_data)
-- >{
-- >  // Web Extensions get a different ID for each Web Process
-- >  static guint32 unique_id = 0;
-- >
-- >  webkit_web_context_set_web_extensions_directory (
-- >     context, WEB_EXTENSIONS_DIRECTORY);
-- >  webkit_web_context_set_web_extensions_initialization_user_data (
-- >     context, g_variant_new_uint32 (unique_id++));
-- >}
-- >
-- >int main (int argc, char **argv)
-- >{
-- >  g_signal_connect (webkit_web_context_get_default (),
-- >                   "initialize-web-extensions",
-- >                    G_CALLBACK (initialize_web_extensions),
-- >                    NULL);
-- >
-- >  GtkWidget *view = webkit_web_view_new ();
-- >
-- >  // ...
-- >}
-- 

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

module GI.WebKit2WebExtension.Objects.WebExtension
    ( 

-- * Exported types
    WebExtension(..)                        ,
    IsWebExtension                          ,
    toWebExtension                          ,


 -- * 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"), [sendMessageToContext]("GI.WebKit2WebExtension.Objects.WebExtension#g:method:sendMessageToContext"), [sendMessageToContextFinish]("GI.WebKit2WebExtension.Objects.WebExtension#g:method:sendMessageToContextFinish"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getPage]("GI.WebKit2WebExtension.Objects.WebExtension#g:method:getPage"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveWebExtensionMethod               ,
#endif

-- ** getPage #method:getPage#

#if defined(ENABLE_OVERLOADING)
    WebExtensionGetPageMethodInfo           ,
#endif
    webExtensionGetPage                     ,


-- ** sendMessageToContext #method:sendMessageToContext#

#if defined(ENABLE_OVERLOADING)
    WebExtensionSendMessageToContextMethodInfo,
#endif
    webExtensionSendMessageToContext        ,


-- ** sendMessageToContextFinish #method:sendMessageToContextFinish#

#if defined(ENABLE_OVERLOADING)
    WebExtensionSendMessageToContextFinishMethodInfo,
#endif
    webExtensionSendMessageToContextFinish  ,




 -- * Signals


-- ** pageCreated #signal:pageCreated#

    WebExtensionPageCreatedCallback         ,
#if defined(ENABLE_OVERLOADING)
    WebExtensionPageCreatedSignalInfo       ,
#endif
    afterWebExtensionPageCreated            ,
    onWebExtensionPageCreated               ,


-- ** userMessageReceived #signal:userMessageReceived#

    WebExtensionUserMessageReceivedCallback ,
#if defined(ENABLE_OVERLOADING)
    WebExtensionUserMessageReceivedSignalInfo,
#endif
    afterWebExtensionUserMessageReceived    ,
    onWebExtensionUserMessageReceived       ,




    ) 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.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.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.WebKit2WebExtension.Objects.UserMessage as WebKit2WebExtension.UserMessage
import {-# SOURCE #-} qualified GI.WebKit2WebExtension.Objects.WebPage as WebKit2WebExtension.WebPage

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

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

foreign import ccall "webkit_web_extension_get_type"
    c_webkit_web_extension_get_type :: IO B.Types.GType

instance B.Types.TypedObject WebExtension where
    glibType :: IO GType
glibType = IO GType
c_webkit_web_extension_get_type

instance B.Types.GObject WebExtension

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveWebExtensionMethod (t :: Symbol) (o :: *) :: * where
    ResolveWebExtensionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveWebExtensionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveWebExtensionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveWebExtensionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveWebExtensionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveWebExtensionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveWebExtensionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveWebExtensionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveWebExtensionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveWebExtensionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveWebExtensionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveWebExtensionMethod "sendMessageToContext" o = WebExtensionSendMessageToContextMethodInfo
    ResolveWebExtensionMethod "sendMessageToContextFinish" o = WebExtensionSendMessageToContextFinishMethodInfo
    ResolveWebExtensionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveWebExtensionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveWebExtensionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveWebExtensionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveWebExtensionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveWebExtensionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveWebExtensionMethod "getPage" o = WebExtensionGetPageMethodInfo
    ResolveWebExtensionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveWebExtensionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveWebExtensionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveWebExtensionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveWebExtensionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveWebExtensionMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal WebExtension::page-created
-- | This signal is emitted when a new t'GI.WebKit2WebExtension.Objects.WebPage.WebPage' is created in
-- the Web Process.
type WebExtensionPageCreatedCallback =
    WebKit2WebExtension.WebPage.WebPage
    -- ^ /@webPage@/: the t'GI.WebKit2WebExtension.Objects.WebPage.WebPage' created
    -> IO ()

type C_WebExtensionPageCreatedCallback =
    Ptr WebExtension ->                     -- object
    Ptr WebKit2WebExtension.WebPage.WebPage ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WebExtensionPageCreatedCallback :: 
    GObject a => (a -> WebExtensionPageCreatedCallback) ->
    C_WebExtensionPageCreatedCallback
wrap_WebExtensionPageCreatedCallback :: forall a.
GObject a =>
(a -> WebExtensionPageCreatedCallback)
-> C_WebExtensionPageCreatedCallback
wrap_WebExtensionPageCreatedCallback a -> WebExtensionPageCreatedCallback
gi'cb Ptr WebExtension
gi'selfPtr Ptr WebPage
webPage Ptr ()
_ = do
    WebPage
webPage' <- ((ManagedPtr WebPage -> WebPage) -> Ptr WebPage -> IO WebPage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr WebPage -> WebPage
WebKit2WebExtension.WebPage.WebPage) Ptr WebPage
webPage
    Ptr WebExtension -> (WebExtension -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebExtension
gi'selfPtr ((WebExtension -> IO ()) -> IO ())
-> (WebExtension -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebExtension
gi'self -> a -> WebExtensionPageCreatedCallback
gi'cb (WebExtension -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebExtension
gi'self)  WebPage
webPage'


-- | Connect a signal handler for the [pageCreated](#signal:pageCreated) 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' webExtension #pageCreated callback
-- @
-- 
-- 
onWebExtensionPageCreated :: (IsWebExtension a, MonadIO m) => a -> ((?self :: a) => WebExtensionPageCreatedCallback) -> m SignalHandlerId
onWebExtensionPageCreated :: forall a (m :: * -> *).
(IsWebExtension a, MonadIO m) =>
a
-> ((?self::a) => WebExtensionPageCreatedCallback)
-> m SignalHandlerId
onWebExtensionPageCreated a
obj (?self::a) => WebExtensionPageCreatedCallback
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 -> WebExtensionPageCreatedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebExtensionPageCreatedCallback
WebExtensionPageCreatedCallback
cb
    let wrapped' :: C_WebExtensionPageCreatedCallback
wrapped' = (a -> WebExtensionPageCreatedCallback)
-> C_WebExtensionPageCreatedCallback
forall a.
GObject a =>
(a -> WebExtensionPageCreatedCallback)
-> C_WebExtensionPageCreatedCallback
wrap_WebExtensionPageCreatedCallback a -> WebExtensionPageCreatedCallback
wrapped
    FunPtr C_WebExtensionPageCreatedCallback
wrapped'' <- C_WebExtensionPageCreatedCallback
-> IO (FunPtr C_WebExtensionPageCreatedCallback)
mk_WebExtensionPageCreatedCallback C_WebExtensionPageCreatedCallback
wrapped'
    a
-> Text
-> FunPtr C_WebExtensionPageCreatedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"page-created" FunPtr C_WebExtensionPageCreatedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [pageCreated](#signal:pageCreated) 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' webExtension #pageCreated 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.
-- 
afterWebExtensionPageCreated :: (IsWebExtension a, MonadIO m) => a -> ((?self :: a) => WebExtensionPageCreatedCallback) -> m SignalHandlerId
afterWebExtensionPageCreated :: forall a (m :: * -> *).
(IsWebExtension a, MonadIO m) =>
a
-> ((?self::a) => WebExtensionPageCreatedCallback)
-> m SignalHandlerId
afterWebExtensionPageCreated a
obj (?self::a) => WebExtensionPageCreatedCallback
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 -> WebExtensionPageCreatedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebExtensionPageCreatedCallback
WebExtensionPageCreatedCallback
cb
    let wrapped' :: C_WebExtensionPageCreatedCallback
wrapped' = (a -> WebExtensionPageCreatedCallback)
-> C_WebExtensionPageCreatedCallback
forall a.
GObject a =>
(a -> WebExtensionPageCreatedCallback)
-> C_WebExtensionPageCreatedCallback
wrap_WebExtensionPageCreatedCallback a -> WebExtensionPageCreatedCallback
wrapped
    FunPtr C_WebExtensionPageCreatedCallback
wrapped'' <- C_WebExtensionPageCreatedCallback
-> IO (FunPtr C_WebExtensionPageCreatedCallback)
mk_WebExtensionPageCreatedCallback C_WebExtensionPageCreatedCallback
wrapped'
    a
-> Text
-> FunPtr C_WebExtensionPageCreatedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"page-created" FunPtr C_WebExtensionPageCreatedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebExtensionPageCreatedSignalInfo
instance SignalInfo WebExtensionPageCreatedSignalInfo where
    type HaskellCallbackType WebExtensionPageCreatedSignalInfo = WebExtensionPageCreatedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebExtensionPageCreatedCallback cb
        cb'' <- mk_WebExtensionPageCreatedCallback cb'
        connectSignalFunPtr obj "page-created" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2WebExtension.Objects.WebExtension::page-created"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2webextension-4.0.28/docs/GI-WebKit2WebExtension-Objects-WebExtension.html#g:signal:pageCreated"})

#endif

-- signal WebExtension::user-message-received
-- | This signal is emitted when a t'GI.WebKit2WebExtension.Objects.UserMessage.UserMessage' is received from the
-- @/WebKitWebContext/@ corresponding to /@extension@/. Messages sent by @/WebKitWebContext/@
-- are always broadcasted to all t'GI.WebKit2WebExtension.Objects.WebExtension.WebExtension's and they can\'t be
-- replied to. Calling 'GI.WebKit2WebExtension.Objects.UserMessage.userMessageSendReply' will do nothing.
-- 
-- /Since: 2.28/
type WebExtensionUserMessageReceivedCallback =
    WebKit2WebExtension.UserMessage.UserMessage
    -- ^ /@message@/: the t'GI.WebKit2WebExtension.Objects.UserMessage.UserMessage' received
    -> IO ()

type C_WebExtensionUserMessageReceivedCallback =
    Ptr WebExtension ->                     -- object
    Ptr WebKit2WebExtension.UserMessage.UserMessage ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WebExtensionUserMessageReceivedCallback :: 
    GObject a => (a -> WebExtensionUserMessageReceivedCallback) ->
    C_WebExtensionUserMessageReceivedCallback
wrap_WebExtensionUserMessageReceivedCallback :: forall a.
GObject a =>
(a -> WebExtensionUserMessageReceivedCallback)
-> C_WebExtensionUserMessageReceivedCallback
wrap_WebExtensionUserMessageReceivedCallback a -> WebExtensionUserMessageReceivedCallback
gi'cb Ptr WebExtension
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
WebKit2WebExtension.UserMessage.UserMessage) Ptr UserMessage
message
    Ptr WebExtension -> (WebExtension -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebExtension
gi'selfPtr ((WebExtension -> IO ()) -> IO ())
-> (WebExtension -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebExtension
gi'self -> a -> WebExtensionUserMessageReceivedCallback
gi'cb (WebExtension -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebExtension
gi'self)  UserMessage
message'


-- | 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' webExtension #userMessageReceived callback
-- @
-- 
-- 
onWebExtensionUserMessageReceived :: (IsWebExtension a, MonadIO m) => a -> ((?self :: a) => WebExtensionUserMessageReceivedCallback) -> m SignalHandlerId
onWebExtensionUserMessageReceived :: forall a (m :: * -> *).
(IsWebExtension a, MonadIO m) =>
a
-> ((?self::a) => WebExtensionUserMessageReceivedCallback)
-> m SignalHandlerId
onWebExtensionUserMessageReceived a
obj (?self::a) => WebExtensionUserMessageReceivedCallback
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 -> WebExtensionUserMessageReceivedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebExtensionUserMessageReceivedCallback
WebExtensionUserMessageReceivedCallback
cb
    let wrapped' :: C_WebExtensionUserMessageReceivedCallback
wrapped' = (a -> WebExtensionUserMessageReceivedCallback)
-> C_WebExtensionUserMessageReceivedCallback
forall a.
GObject a =>
(a -> WebExtensionUserMessageReceivedCallback)
-> C_WebExtensionUserMessageReceivedCallback
wrap_WebExtensionUserMessageReceivedCallback a -> WebExtensionUserMessageReceivedCallback
wrapped
    FunPtr C_WebExtensionUserMessageReceivedCallback
wrapped'' <- C_WebExtensionUserMessageReceivedCallback
-> IO (FunPtr C_WebExtensionUserMessageReceivedCallback)
mk_WebExtensionUserMessageReceivedCallback C_WebExtensionUserMessageReceivedCallback
wrapped'
    a
-> Text
-> FunPtr C_WebExtensionUserMessageReceivedCallback
-> 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_WebExtensionUserMessageReceivedCallback
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' webExtension #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.
-- 
afterWebExtensionUserMessageReceived :: (IsWebExtension a, MonadIO m) => a -> ((?self :: a) => WebExtensionUserMessageReceivedCallback) -> m SignalHandlerId
afterWebExtensionUserMessageReceived :: forall a (m :: * -> *).
(IsWebExtension a, MonadIO m) =>
a
-> ((?self::a) => WebExtensionUserMessageReceivedCallback)
-> m SignalHandlerId
afterWebExtensionUserMessageReceived a
obj (?self::a) => WebExtensionUserMessageReceivedCallback
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 -> WebExtensionUserMessageReceivedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => WebExtensionUserMessageReceivedCallback
WebExtensionUserMessageReceivedCallback
cb
    let wrapped' :: C_WebExtensionUserMessageReceivedCallback
wrapped' = (a -> WebExtensionUserMessageReceivedCallback)
-> C_WebExtensionUserMessageReceivedCallback
forall a.
GObject a =>
(a -> WebExtensionUserMessageReceivedCallback)
-> C_WebExtensionUserMessageReceivedCallback
wrap_WebExtensionUserMessageReceivedCallback a -> WebExtensionUserMessageReceivedCallback
wrapped
    FunPtr C_WebExtensionUserMessageReceivedCallback
wrapped'' <- C_WebExtensionUserMessageReceivedCallback
-> IO (FunPtr C_WebExtensionUserMessageReceivedCallback)
mk_WebExtensionUserMessageReceivedCallback C_WebExtensionUserMessageReceivedCallback
wrapped'
    a
-> Text
-> FunPtr C_WebExtensionUserMessageReceivedCallback
-> 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_WebExtensionUserMessageReceivedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebExtensionUserMessageReceivedSignalInfo
instance SignalInfo WebExtensionUserMessageReceivedSignalInfo where
    type HaskellCallbackType WebExtensionUserMessageReceivedSignalInfo = WebExtensionUserMessageReceivedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebExtensionUserMessageReceivedCallback cb
        cb'' <- mk_WebExtensionUserMessageReceivedCallback cb'
        connectSignalFunPtr obj "user-message-received" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2WebExtension.Objects.WebExtension::user-message-received"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2webextension-4.0.28/docs/GI-WebKit2WebExtension-Objects-WebExtension.html#g:signal:userMessageReceived"})

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList WebExtension = WebExtensionSignalList
type WebExtensionSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo), '("pageCreated", WebExtensionPageCreatedSignalInfo), '("userMessageReceived", WebExtensionUserMessageReceivedSignalInfo)] :: [(Symbol, *)])

#endif

-- method WebExtension::get_page
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "extension"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "WebExtension" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebExtension"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_id"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the identifier of the #WebKitWebPage to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2WebExtension" , name = "WebPage" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_extension_get_page" webkit_web_extension_get_page :: 
    Ptr WebExtension ->                     -- extension : TInterface (Name {namespace = "WebKit2WebExtension", name = "WebExtension"})
    Word64 ->                               -- page_id : TBasicType TUInt64
    IO (Ptr WebKit2WebExtension.WebPage.WebPage)

-- | Get the web page of the given /@pageId@/.
webExtensionGetPage ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebExtension a) =>
    a
    -- ^ /@extension@/: a t'GI.WebKit2WebExtension.Objects.WebExtension.WebExtension'
    -> Word64
    -- ^ /@pageId@/: the identifier of the t'GI.WebKit2WebExtension.Objects.WebPage.WebPage' to get
    -> m (Maybe WebKit2WebExtension.WebPage.WebPage)
    -- ^ __Returns:__ the t'GI.WebKit2WebExtension.Objects.WebPage.WebPage' for the given /@pageId@/, or 'P.Nothing' if the
    --    identifier doesn\'t correspond to an existing web page.
webExtensionGetPage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebExtension a) =>
a -> Word64 -> m (Maybe WebPage)
webExtensionGetPage a
extension Word64
pageId = IO (Maybe WebPage) -> m (Maybe WebPage)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe WebPage) -> m (Maybe WebPage))
-> IO (Maybe WebPage) -> m (Maybe WebPage)
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebExtension
extension' <- a -> IO (Ptr WebExtension)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
extension
    Ptr WebPage
result <- Ptr WebExtension -> Word64 -> IO (Ptr WebPage)
webkit_web_extension_get_page Ptr WebExtension
extension' Word64
pageId
    Maybe WebPage
maybeResult <- Ptr WebPage -> (Ptr WebPage -> IO WebPage) -> IO (Maybe WebPage)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr WebPage
result ((Ptr WebPage -> IO WebPage) -> IO (Maybe WebPage))
-> (Ptr WebPage -> IO WebPage) -> IO (Maybe WebPage)
forall a b. (a -> b) -> a -> b
$ \Ptr WebPage
result' -> do
        WebPage
result'' <- ((ManagedPtr WebPage -> WebPage) -> Ptr WebPage -> IO WebPage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr WebPage -> WebPage
WebKit2WebExtension.WebPage.WebPage) Ptr WebPage
result'
        WebPage -> IO WebPage
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WebPage
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
extension
    Maybe WebPage -> IO (Maybe WebPage)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe WebPage
maybeResult

#if defined(ENABLE_OVERLOADING)
data WebExtensionGetPageMethodInfo
instance (signature ~ (Word64 -> m (Maybe WebKit2WebExtension.WebPage.WebPage)), MonadIO m, IsWebExtension a) => O.OverloadedMethod WebExtensionGetPageMethodInfo a signature where
    overloadedMethod = webExtensionGetPage

instance O.OverloadedMethodInfo WebExtensionGetPageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2WebExtension.Objects.WebExtension.webExtensionGetPage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2webextension-4.0.28/docs/GI-WebKit2WebExtension-Objects-WebExtension.html#v:webExtensionGetPage"
        })


#endif

-- method WebExtension::send_message_to_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "extension"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "WebExtension" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebExtension"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "message"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "UserMessage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserMessage"
--                 , 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
--                       "(nullable): A #GAsyncReadyCallback to call when the request is satisfied or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , 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_extension_send_message_to_context" webkit_web_extension_send_message_to_context :: 
    Ptr WebExtension ->                     -- extension : TInterface (Name {namespace = "WebKit2WebExtension", name = "WebExtension"})
    Ptr WebKit2WebExtension.UserMessage.UserMessage -> -- message : TInterface (Name {namespace = "WebKit2WebExtension", name = "UserMessage"})
    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 ()

-- | Send /@message@/ to the @/WebKitWebContext/@ corresponding to /@extension@/. If /@message@/ is floating, it\'s consumed.
-- 
-- If you don\'t expect any reply, or you simply want to ignore it, you can pass 'P.Nothing' as /@calback@/.
-- When the operation is finished, /@callback@/ will be called. You can then call
-- 'GI.WebKit2WebExtension.Objects.WebExtension.webExtensionSendMessageToContextFinish' to get the message reply.
-- 
-- /Since: 2.28/
webExtensionSendMessageToContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebExtension a, WebKit2WebExtension.UserMessage.IsUserMessage b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@extension@/: a t'GI.WebKit2WebExtension.Objects.WebExtension.WebExtension'
    -> b
    -- ^ /@message@/: a t'GI.WebKit2WebExtension.Objects.UserMessage.UserMessage'
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: (nullable): A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied or 'P.Nothing'
    -> m ()
webExtensionSendMessageToContext :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsWebExtension a, IsUserMessage b,
 IsCancellable c) =>
a -> b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
webExtensionSendMessageToContext a
extension b
message Maybe c
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 WebExtension
extension' <- a -> IO (Ptr WebExtension)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
extension
    Ptr UserMessage
message' <- b -> IO (Ptr UserMessage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
message
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
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 c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
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_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall 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 WebExtension
-> Ptr UserMessage
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
webkit_web_extension_send_message_to_context Ptr WebExtension
extension' Ptr UserMessage
message' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
extension
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
message
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> 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 WebExtensionSendMessageToContextMethodInfo
instance (signature ~ (b -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsWebExtension a, WebKit2WebExtension.UserMessage.IsUserMessage b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod WebExtensionSendMessageToContextMethodInfo a signature where
    overloadedMethod = webExtensionSendMessageToContext

instance O.OverloadedMethodInfo WebExtensionSendMessageToContextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2WebExtension.Objects.WebExtension.webExtensionSendMessageToContext",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2webextension-4.0.28/docs/GI-WebKit2WebExtension-Objects-WebExtension.html#v:webExtensionSendMessageToContext"
        })


#endif

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

foreign import ccall "webkit_web_extension_send_message_to_context_finish" webkit_web_extension_send_message_to_context_finish :: 
    Ptr WebExtension ->                     -- extension : TInterface (Name {namespace = "WebKit2WebExtension", name = "WebExtension"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr WebKit2WebExtension.UserMessage.UserMessage)

-- | Finish an asynchronous operation started with 'GI.WebKit2WebExtension.Objects.WebExtension.webExtensionSendMessageToContext'.
-- 
-- /Since: 2.28/
webExtensionSendMessageToContextFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebExtension a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@extension@/: a t'GI.WebKit2WebExtension.Objects.WebExtension.WebExtension'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m WebKit2WebExtension.UserMessage.UserMessage
    -- ^ __Returns:__ a t'GI.WebKit2WebExtension.Objects.UserMessage.UserMessage' with the reply or 'P.Nothing' in case of error. /(Can throw 'Data.GI.Base.GError.GError')/
webExtensionSendMessageToContextFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsWebExtension a, IsAsyncResult b) =>
a -> b -> m UserMessage
webExtensionSendMessageToContextFinish a
extension b
result_ = IO UserMessage -> m UserMessage
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserMessage -> m UserMessage)
-> IO UserMessage -> m UserMessage
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebExtension
extension' <- a -> IO (Ptr WebExtension)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
extension
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO UserMessage -> IO () -> IO UserMessage
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr UserMessage
result <- (Ptr (Ptr GError) -> IO (Ptr UserMessage)) -> IO (Ptr UserMessage)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr UserMessage))
 -> IO (Ptr UserMessage))
-> (Ptr (Ptr GError) -> IO (Ptr UserMessage))
-> IO (Ptr UserMessage)
forall a b. (a -> b) -> a -> b
$ Ptr WebExtension
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr UserMessage)
webkit_web_extension_send_message_to_context_finish Ptr WebExtension
extension' Ptr AsyncResult
result_'
        Text -> Ptr UserMessage -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"webExtensionSendMessageToContextFinish" Ptr UserMessage
result
        UserMessage
result' <- ((ManagedPtr UserMessage -> UserMessage)
-> Ptr UserMessage -> IO UserMessage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr UserMessage -> UserMessage
WebKit2WebExtension.UserMessage.UserMessage) Ptr UserMessage
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
extension
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        UserMessage -> IO UserMessage
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UserMessage
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data WebExtensionSendMessageToContextFinishMethodInfo
instance (signature ~ (b -> m WebKit2WebExtension.UserMessage.UserMessage), MonadIO m, IsWebExtension a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod WebExtensionSendMessageToContextFinishMethodInfo a signature where
    overloadedMethod = webExtensionSendMessageToContextFinish

instance O.OverloadedMethodInfo WebExtensionSendMessageToContextFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2WebExtension.Objects.WebExtension.webExtensionSendMessageToContextFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2webextension-4.0.28/docs/GI-WebKit2WebExtension-Objects-WebExtension.html#v:webExtensionSendMessageToContextFinish"
        })


#endif