{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.WebKit2WebExtension.Objects.WebExtension
    ( 

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


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

#if defined(ENABLE_OVERLOADING)
    ResolveWebExtensionMethod               ,
#endif


-- ** getPage #method:getPage#

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




 -- * Signals
-- ** pageCreated #signal:pageCreated#

    C_WebExtensionPageCreatedCallback       ,
    WebExtensionPageCreatedCallback         ,
#if defined(ENABLE_OVERLOADING)
    WebExtensionPageCreatedSignalInfo       ,
#endif
    afterWebExtensionPageCreated            ,
    genClosure_WebExtensionPageCreated      ,
    mk_WebExtensionPageCreatedCallback      ,
    noWebExtensionPageCreatedCallback       ,
    onWebExtensionPageCreated               ,
    wrap_WebExtensionPageCreatedCallback    ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.WebKit2WebExtension.Objects.WebPage as WebKit2WebExtension.WebPage

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

instance GObject WebExtension where
    gobjectType :: IO GType
gobjectType = IO GType
c_webkit_web_extension_get_type
    

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

-- | Type class for types which can be safely cast to `WebExtension`, for instance with `toWebExtension`.
class (GObject o, O.IsDescendantOf WebExtension o) => IsWebExtension o
instance (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 :: (MonadIO m, IsWebExtension o) => o -> m WebExtension
toWebExtension :: o -> m WebExtension
toWebExtension = IO WebExtension -> m WebExtension
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr WebExtension -> WebExtension
WebExtension

-- | A convenience alias for `Nothing` :: `Maybe` `WebExtension`.
noWebExtension :: Maybe WebExtension
noWebExtension :: Maybe WebExtension
noWebExtension = Maybe WebExtension
forall a. Maybe a
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 "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.MethodInfo 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

#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 ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `WebExtensionPageCreatedCallback`@.
noWebExtensionPageCreatedCallback :: Maybe WebExtensionPageCreatedCallback
noWebExtensionPageCreatedCallback :: Maybe WebExtensionPageCreatedCallback
noWebExtensionPageCreatedCallback = Maybe WebExtensionPageCreatedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_WebExtensionPageCreatedCallback =
    Ptr () ->                               -- 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 the callback into a `GClosure`.
genClosure_WebExtensionPageCreated :: MonadIO m => WebExtensionPageCreatedCallback -> m (GClosure C_WebExtensionPageCreatedCallback)
genClosure_WebExtensionPageCreated :: WebExtensionPageCreatedCallback
-> m (GClosure C_WebExtensionPageCreatedCallback)
genClosure_WebExtensionPageCreated cb :: WebExtensionPageCreatedCallback
cb = IO (GClosure C_WebExtensionPageCreatedCallback)
-> m (GClosure C_WebExtensionPageCreatedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_WebExtensionPageCreatedCallback)
 -> m (GClosure C_WebExtensionPageCreatedCallback))
-> IO (GClosure C_WebExtensionPageCreatedCallback)
-> m (GClosure C_WebExtensionPageCreatedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebExtensionPageCreatedCallback
cb' = WebExtensionPageCreatedCallback
-> C_WebExtensionPageCreatedCallback
wrap_WebExtensionPageCreatedCallback WebExtensionPageCreatedCallback
cb
    C_WebExtensionPageCreatedCallback
-> IO (FunPtr C_WebExtensionPageCreatedCallback)
mk_WebExtensionPageCreatedCallback C_WebExtensionPageCreatedCallback
cb' IO (FunPtr C_WebExtensionPageCreatedCallback)
-> (FunPtr C_WebExtensionPageCreatedCallback
    -> IO (GClosure C_WebExtensionPageCreatedCallback))
-> IO (GClosure C_WebExtensionPageCreatedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_WebExtensionPageCreatedCallback
-> IO (GClosure C_WebExtensionPageCreatedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `WebExtensionPageCreatedCallback` into a `C_WebExtensionPageCreatedCallback`.
wrap_WebExtensionPageCreatedCallback ::
    WebExtensionPageCreatedCallback ->
    C_WebExtensionPageCreatedCallback
wrap_WebExtensionPageCreatedCallback :: WebExtensionPageCreatedCallback
-> C_WebExtensionPageCreatedCallback
wrap_WebExtensionPageCreatedCallback _cb :: WebExtensionPageCreatedCallback
_cb _ webPage :: Ptr WebPage
webPage _ = 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
    WebExtensionPageCreatedCallback
_cb  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 -> WebExtensionPageCreatedCallback -> m SignalHandlerId
onWebExtensionPageCreated :: a -> WebExtensionPageCreatedCallback -> m SignalHandlerId
onWebExtensionPageCreated obj :: a
obj cb :: WebExtensionPageCreatedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebExtensionPageCreatedCallback
cb' = WebExtensionPageCreatedCallback
-> C_WebExtensionPageCreatedCallback
wrap_WebExtensionPageCreatedCallback WebExtensionPageCreatedCallback
cb
    FunPtr C_WebExtensionPageCreatedCallback
cb'' <- C_WebExtensionPageCreatedCallback
-> IO (FunPtr C_WebExtensionPageCreatedCallback)
mk_WebExtensionPageCreatedCallback C_WebExtensionPageCreatedCallback
cb'
    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 "page-created" FunPtr C_WebExtensionPageCreatedCallback
cb'' 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
-- @
-- 
-- 
afterWebExtensionPageCreated :: (IsWebExtension a, MonadIO m) => a -> WebExtensionPageCreatedCallback -> m SignalHandlerId
afterWebExtensionPageCreated :: a -> WebExtensionPageCreatedCallback -> m SignalHandlerId
afterWebExtensionPageCreated obj :: a
obj cb :: WebExtensionPageCreatedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_WebExtensionPageCreatedCallback
cb' = WebExtensionPageCreatedCallback
-> C_WebExtensionPageCreatedCallback
wrap_WebExtensionPageCreatedCallback WebExtensionPageCreatedCallback
cb
    FunPtr C_WebExtensionPageCreatedCallback
cb'' <- C_WebExtensionPageCreatedCallback
-> IO (FunPtr C_WebExtensionPageCreatedCallback)
mk_WebExtensionPageCreatedCallback C_WebExtensionPageCreatedCallback
cb'
    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 "page-created" FunPtr C_WebExtensionPageCreatedCallback
cb'' 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

#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)] :: [(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 :: a -> Word64 -> m (Maybe WebPage)
webExtensionGetPage extension :: a
extension pageId :: Word64
pageId = IO (Maybe WebPage) -> m (Maybe WebPage)
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
$ \result' :: 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 (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 (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.MethodInfo WebExtensionGetPageMethodInfo a signature where
    overloadedMethod = webExtensionGetPage

#endif