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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Access to the WebKit inspector.
-- 
-- The WebKit Inspector is a graphical tool to inspect and change the
-- content of a t'GI.WebKit2.Objects.WebView.WebView'. It also includes an interactive
-- JavaScript debugger. Using this class one can get a t'GI.Gtk.Objects.Widget.Widget'
-- which can be embedded into an application to show the inspector.
-- 
-- The inspector is available when the t'GI.WebKit2.Objects.Settings.Settings' of the
-- t'GI.WebKit2.Objects.WebView.WebView' has set the [Settings:enableDeveloperExtras]("GI.WebKit2.Objects.Settings#g:attr:enableDeveloperExtras")
-- to true, otherwise no inspector is available.
-- 
-- 
-- === /c code/
-- >// Enable the developer extras
-- >WebKitSettings *settings = webkit_web_view_get_settings (WEBKIT_WEB_VIEW(my_webview));
-- >g_object_set (G_OBJECT(settings), "enable-developer-extras", TRUE, NULL);
-- >
-- >// Load some data or reload to be able to inspect the page
-- >webkit_web_view_load_uri (WEBKIT_WEB_VIEW(my_webview), "http://www.gnome.org");
-- >
-- >// Show the inspector
-- >WebKitWebInspector *inspector = webkit_web_view_get_inspector (WEBKIT_WEB_VIEW(my_webview));
-- >webkit_web_inspector_show (WEBKIT_WEB_INSPECTOR(inspector));
-- 

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

module GI.WebKit2.Objects.WebInspector
    ( 

-- * Exported types
    WebInspector(..)                        ,
    IsWebInspector                          ,
    toWebInspector                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [attach]("GI.WebKit2.Objects.WebInspector#g:method:attach"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [close]("GI.WebKit2.Objects.WebInspector#g:method:close"), [detach]("GI.WebKit2.Objects.WebInspector#g:method:detach"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isAttached]("GI.WebKit2.Objects.WebInspector#g:method:isAttached"), [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"), [show]("GI.WebKit2.Objects.WebInspector#g:method:show"), [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
-- [getAttachedHeight]("GI.WebKit2.Objects.WebInspector#g:method:getAttachedHeight"), [getCanAttach]("GI.WebKit2.Objects.WebInspector#g:method:getCanAttach"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getInspectedUri]("GI.WebKit2.Objects.WebInspector#g:method:getInspectedUri"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getWebView]("GI.WebKit2.Objects.WebInspector#g:method:getWebView").
-- 
-- ==== 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)
    ResolveWebInspectorMethod               ,
#endif

-- ** attach #method:attach#

#if defined(ENABLE_OVERLOADING)
    WebInspectorAttachMethodInfo            ,
#endif
    webInspectorAttach                      ,


-- ** close #method:close#

#if defined(ENABLE_OVERLOADING)
    WebInspectorCloseMethodInfo             ,
#endif
    webInspectorClose                       ,


-- ** detach #method:detach#

#if defined(ENABLE_OVERLOADING)
    WebInspectorDetachMethodInfo            ,
#endif
    webInspectorDetach                      ,


-- ** getAttachedHeight #method:getAttachedHeight#

#if defined(ENABLE_OVERLOADING)
    WebInspectorGetAttachedHeightMethodInfo ,
#endif
    webInspectorGetAttachedHeight           ,


-- ** getCanAttach #method:getCanAttach#

#if defined(ENABLE_OVERLOADING)
    WebInspectorGetCanAttachMethodInfo      ,
#endif
    webInspectorGetCanAttach                ,


-- ** getInspectedUri #method:getInspectedUri#

#if defined(ENABLE_OVERLOADING)
    WebInspectorGetInspectedUriMethodInfo   ,
#endif
    webInspectorGetInspectedUri             ,


-- ** getWebView #method:getWebView#

#if defined(ENABLE_OVERLOADING)
    WebInspectorGetWebViewMethodInfo        ,
#endif
    webInspectorGetWebView                  ,


-- ** isAttached #method:isAttached#

#if defined(ENABLE_OVERLOADING)
    WebInspectorIsAttachedMethodInfo        ,
#endif
    webInspectorIsAttached                  ,


-- ** show #method:show#

#if defined(ENABLE_OVERLOADING)
    WebInspectorShowMethodInfo              ,
#endif
    webInspectorShow                        ,




 -- * Properties


-- ** attachedHeight #attr:attachedHeight#
-- | The height that the inspector view should have when it is attached.

#if defined(ENABLE_OVERLOADING)
    WebInspectorAttachedHeightPropertyInfo  ,
#endif
    getWebInspectorAttachedHeight           ,
#if defined(ENABLE_OVERLOADING)
    webInspectorAttachedHeight              ,
#endif


-- ** canAttach #attr:canAttach#
-- | Whether the /@inspector@/ can be attached to the same window that contains
-- the inspected view.
-- 
-- /Since: 2.8/

#if defined(ENABLE_OVERLOADING)
    WebInspectorCanAttachPropertyInfo       ,
#endif
    getWebInspectorCanAttach                ,
#if defined(ENABLE_OVERLOADING)
    webInspectorCanAttach                   ,
#endif


-- ** inspectedUri #attr:inspectedUri#
-- | The URI that is currently being inspected.

#if defined(ENABLE_OVERLOADING)
    WebInspectorInspectedUriPropertyInfo    ,
#endif
    getWebInspectorInspectedUri             ,
#if defined(ENABLE_OVERLOADING)
    webInspectorInspectedUri                ,
#endif




 -- * Signals


-- ** attach #signal:attach#

    WebInspectorAttachCallback              ,
#if defined(ENABLE_OVERLOADING)
    WebInspectorAttachSignalInfo            ,
#endif
    afterWebInspectorAttach                 ,
    onWebInspectorAttach                    ,


-- ** bringToFront #signal:bringToFront#

    WebInspectorBringToFrontCallback        ,
#if defined(ENABLE_OVERLOADING)
    WebInspectorBringToFrontSignalInfo      ,
#endif
    afterWebInspectorBringToFront           ,
    onWebInspectorBringToFront              ,


-- ** closed #signal:closed#

    WebInspectorClosedCallback              ,
#if defined(ENABLE_OVERLOADING)
    WebInspectorClosedSignalInfo            ,
#endif
    afterWebInspectorClosed                 ,
    onWebInspectorClosed                    ,


-- ** detach #signal:detach#

    WebInspectorDetachCallback              ,
#if defined(ENABLE_OVERLOADING)
    WebInspectorDetachSignalInfo            ,
#endif
    afterWebInspectorDetach                 ,
    onWebInspectorDetach                    ,


-- ** openWindow #signal:openWindow#

    WebInspectorOpenWindowCallback          ,
#if defined(ENABLE_OVERLOADING)
    WebInspectorOpenWindowSignalInfo        ,
#endif
    afterWebInspectorOpenWindow             ,
    onWebInspectorOpenWindow                ,




    ) 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 {-# SOURCE #-} qualified GI.WebKit2.Objects.WebViewBase as WebKit2.WebViewBase

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

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

foreign import ccall "webkit_web_inspector_get_type"
    c_webkit_web_inspector_get_type :: IO B.Types.GType

instance B.Types.TypedObject WebInspector where
    glibType :: IO GType
glibType = IO GType
c_webkit_web_inspector_get_type

instance B.Types.GObject WebInspector

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveWebInspectorMethod (t :: Symbol) (o :: *) :: * where
    ResolveWebInspectorMethod "attach" o = WebInspectorAttachMethodInfo
    ResolveWebInspectorMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveWebInspectorMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveWebInspectorMethod "close" o = WebInspectorCloseMethodInfo
    ResolveWebInspectorMethod "detach" o = WebInspectorDetachMethodInfo
    ResolveWebInspectorMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveWebInspectorMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveWebInspectorMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveWebInspectorMethod "isAttached" o = WebInspectorIsAttachedMethodInfo
    ResolveWebInspectorMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveWebInspectorMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveWebInspectorMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveWebInspectorMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveWebInspectorMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveWebInspectorMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveWebInspectorMethod "show" o = WebInspectorShowMethodInfo
    ResolveWebInspectorMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveWebInspectorMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveWebInspectorMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveWebInspectorMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveWebInspectorMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveWebInspectorMethod "getAttachedHeight" o = WebInspectorGetAttachedHeightMethodInfo
    ResolveWebInspectorMethod "getCanAttach" o = WebInspectorGetCanAttachMethodInfo
    ResolveWebInspectorMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveWebInspectorMethod "getInspectedUri" o = WebInspectorGetInspectedUriMethodInfo
    ResolveWebInspectorMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveWebInspectorMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveWebInspectorMethod "getWebView" o = WebInspectorGetWebViewMethodInfo
    ResolveWebInspectorMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveWebInspectorMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveWebInspectorMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveWebInspectorMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal WebInspector::attach
-- | Emitted when the inspector is requested to be attached to the window
-- where the inspected web view is.
-- If this signal is not handled the inspector view will be automatically
-- attached to the inspected view, so you only need to handle this signal
-- if you want to attach the inspector view yourself (for example, to add
-- the inspector view to a browser tab).
-- 
-- To prevent the inspector view from being attached you can connect to this
-- signal and simply return 'P.True'.
type WebInspectorAttachCallback =
    IO Bool
    -- ^ __Returns:__ 'P.True' to stop other handlers from being invoked for the event.
    --    'P.False' to propagate the event further.

type C_WebInspectorAttachCallback =
    Ptr WebInspector ->                     -- object
    Ptr () ->                               -- user_data
    IO CInt

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

wrap_WebInspectorAttachCallback :: 
    GObject a => (a -> WebInspectorAttachCallback) ->
    C_WebInspectorAttachCallback
wrap_WebInspectorAttachCallback :: forall a.
GObject a =>
(a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
wrap_WebInspectorAttachCallback a -> WebInspectorAttachCallback
gi'cb Ptr WebInspector
gi'selfPtr Ptr ()
_ = do
    Bool
result <- Ptr WebInspector
-> (WebInspector -> WebInspectorAttachCallback)
-> WebInspectorAttachCallback
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebInspector
gi'selfPtr ((WebInspector -> WebInspectorAttachCallback)
 -> WebInspectorAttachCallback)
-> (WebInspector -> WebInspectorAttachCallback)
-> WebInspectorAttachCallback
forall a b. (a -> b) -> a -> b
$ \WebInspector
gi'self -> a -> WebInspectorAttachCallback
gi'cb (WebInspector -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebInspector
gi'self) 
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [attach](#signal:attach) 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' webInspector #attach callback
-- @
-- 
-- 
onWebInspectorAttach :: (IsWebInspector a, MonadIO m) => a -> ((?self :: a) => WebInspectorAttachCallback) -> m SignalHandlerId
onWebInspectorAttach :: forall a (m :: * -> *).
(IsWebInspector a, MonadIO m) =>
a
-> ((?self::a) => WebInspectorAttachCallback) -> m SignalHandlerId
onWebInspectorAttach a
obj (?self::a) => WebInspectorAttachCallback
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 -> WebInspectorAttachCallback
wrapped a
self = let ?self = a
?self::a
self in WebInspectorAttachCallback
(?self::a) => WebInspectorAttachCallback
cb
    let wrapped' :: C_WebInspectorAttachCallback
wrapped' = (a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
forall a.
GObject a =>
(a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
wrap_WebInspectorAttachCallback a -> WebInspectorAttachCallback
wrapped
    FunPtr C_WebInspectorAttachCallback
wrapped'' <- C_WebInspectorAttachCallback
-> IO (FunPtr C_WebInspectorAttachCallback)
mk_WebInspectorAttachCallback C_WebInspectorAttachCallback
wrapped'
    a
-> Text
-> FunPtr C_WebInspectorAttachCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"attach" FunPtr C_WebInspectorAttachCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [attach](#signal:attach) 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' webInspector #attach 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.
-- 
afterWebInspectorAttach :: (IsWebInspector a, MonadIO m) => a -> ((?self :: a) => WebInspectorAttachCallback) -> m SignalHandlerId
afterWebInspectorAttach :: forall a (m :: * -> *).
(IsWebInspector a, MonadIO m) =>
a
-> ((?self::a) => WebInspectorAttachCallback) -> m SignalHandlerId
afterWebInspectorAttach a
obj (?self::a) => WebInspectorAttachCallback
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 -> WebInspectorAttachCallback
wrapped a
self = let ?self = a
?self::a
self in WebInspectorAttachCallback
(?self::a) => WebInspectorAttachCallback
cb
    let wrapped' :: C_WebInspectorAttachCallback
wrapped' = (a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
forall a.
GObject a =>
(a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
wrap_WebInspectorAttachCallback a -> WebInspectorAttachCallback
wrapped
    FunPtr C_WebInspectorAttachCallback
wrapped'' <- C_WebInspectorAttachCallback
-> IO (FunPtr C_WebInspectorAttachCallback)
mk_WebInspectorAttachCallback C_WebInspectorAttachCallback
wrapped'
    a
-> Text
-> FunPtr C_WebInspectorAttachCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"attach" FunPtr C_WebInspectorAttachCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebInspectorAttachSignalInfo
instance SignalInfo WebInspectorAttachSignalInfo where
    type HaskellCallbackType WebInspectorAttachSignalInfo = WebInspectorAttachCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebInspectorAttachCallback cb
        cb'' <- mk_WebInspectorAttachCallback cb'
        connectSignalFunPtr obj "attach" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebInspector::attach"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.29/docs/GI-WebKit2-Objects-WebInspector.html#g:signal:attach"})

#endif

-- signal WebInspector::bring-to-front
-- | Emitted when the inspector should be shown.
-- 
-- If the inspector is not attached the inspector window should be shown
-- on top of any other windows.
-- If the inspector is attached the inspector view should be made visible.
-- For example, if the inspector view is attached using a tab in a browser
-- window, the browser window should be raised and the tab containing the
-- inspector view should be the active one.
-- In both cases, if this signal is not handled, the default implementation
-- calls 'GI.Gtk.Objects.Window.windowPresent' on the current toplevel t'GI.Gtk.Objects.Window.Window' of the
-- inspector view.
type WebInspectorBringToFrontCallback =
    IO Bool
    -- ^ __Returns:__ 'P.True' to stop other handlers from being invoked for the event.
    --    'P.False' to propagate the event further.

type C_WebInspectorBringToFrontCallback =
    Ptr WebInspector ->                     -- object
    Ptr () ->                               -- user_data
    IO CInt

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

wrap_WebInspectorBringToFrontCallback :: 
    GObject a => (a -> WebInspectorBringToFrontCallback) ->
    C_WebInspectorBringToFrontCallback
wrap_WebInspectorBringToFrontCallback :: forall a.
GObject a =>
(a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
wrap_WebInspectorBringToFrontCallback a -> WebInspectorAttachCallback
gi'cb Ptr WebInspector
gi'selfPtr Ptr ()
_ = do
    Bool
result <- Ptr WebInspector
-> (WebInspector -> WebInspectorAttachCallback)
-> WebInspectorAttachCallback
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebInspector
gi'selfPtr ((WebInspector -> WebInspectorAttachCallback)
 -> WebInspectorAttachCallback)
-> (WebInspector -> WebInspectorAttachCallback)
-> WebInspectorAttachCallback
forall a b. (a -> b) -> a -> b
$ \WebInspector
gi'self -> a -> WebInspectorAttachCallback
gi'cb (WebInspector -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebInspector
gi'self) 
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [bringToFront](#signal:bringToFront) 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' webInspector #bringToFront callback
-- @
-- 
-- 
onWebInspectorBringToFront :: (IsWebInspector a, MonadIO m) => a -> ((?self :: a) => WebInspectorBringToFrontCallback) -> m SignalHandlerId
onWebInspectorBringToFront :: forall a (m :: * -> *).
(IsWebInspector a, MonadIO m) =>
a
-> ((?self::a) => WebInspectorAttachCallback) -> m SignalHandlerId
onWebInspectorBringToFront a
obj (?self::a) => WebInspectorAttachCallback
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 -> WebInspectorAttachCallback
wrapped a
self = let ?self = a
?self::a
self in WebInspectorAttachCallback
(?self::a) => WebInspectorAttachCallback
cb
    let wrapped' :: C_WebInspectorAttachCallback
wrapped' = (a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
forall a.
GObject a =>
(a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
wrap_WebInspectorBringToFrontCallback a -> WebInspectorAttachCallback
wrapped
    FunPtr C_WebInspectorAttachCallback
wrapped'' <- C_WebInspectorAttachCallback
-> IO (FunPtr C_WebInspectorAttachCallback)
mk_WebInspectorBringToFrontCallback C_WebInspectorAttachCallback
wrapped'
    a
-> Text
-> FunPtr C_WebInspectorAttachCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"bring-to-front" FunPtr C_WebInspectorAttachCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [bringToFront](#signal:bringToFront) 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' webInspector #bringToFront 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.
-- 
afterWebInspectorBringToFront :: (IsWebInspector a, MonadIO m) => a -> ((?self :: a) => WebInspectorBringToFrontCallback) -> m SignalHandlerId
afterWebInspectorBringToFront :: forall a (m :: * -> *).
(IsWebInspector a, MonadIO m) =>
a
-> ((?self::a) => WebInspectorAttachCallback) -> m SignalHandlerId
afterWebInspectorBringToFront a
obj (?self::a) => WebInspectorAttachCallback
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 -> WebInspectorAttachCallback
wrapped a
self = let ?self = a
?self::a
self in WebInspectorAttachCallback
(?self::a) => WebInspectorAttachCallback
cb
    let wrapped' :: C_WebInspectorAttachCallback
wrapped' = (a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
forall a.
GObject a =>
(a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
wrap_WebInspectorBringToFrontCallback a -> WebInspectorAttachCallback
wrapped
    FunPtr C_WebInspectorAttachCallback
wrapped'' <- C_WebInspectorAttachCallback
-> IO (FunPtr C_WebInspectorAttachCallback)
mk_WebInspectorBringToFrontCallback C_WebInspectorAttachCallback
wrapped'
    a
-> Text
-> FunPtr C_WebInspectorAttachCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"bring-to-front" FunPtr C_WebInspectorAttachCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebInspectorBringToFrontSignalInfo
instance SignalInfo WebInspectorBringToFrontSignalInfo where
    type HaskellCallbackType WebInspectorBringToFrontSignalInfo = WebInspectorBringToFrontCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebInspectorBringToFrontCallback cb
        cb'' <- mk_WebInspectorBringToFrontCallback cb'
        connectSignalFunPtr obj "bring-to-front" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebInspector::bring-to-front"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.29/docs/GI-WebKit2-Objects-WebInspector.html#g:signal:bringToFront"})

#endif

-- signal WebInspector::closed
-- | Emitted when the inspector page is closed. If you are using your own
-- inspector window, you should connect to this signal and destroy your
-- window.
type WebInspectorClosedCallback =
    IO ()

type C_WebInspectorClosedCallback =
    Ptr WebInspector ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_WebInspectorClosedCallback :: 
    GObject a => (a -> WebInspectorClosedCallback) ->
    C_WebInspectorClosedCallback
wrap_WebInspectorClosedCallback :: forall a. GObject a => (a -> IO ()) -> C_WebInspectorClosedCallback
wrap_WebInspectorClosedCallback a -> IO ()
gi'cb Ptr WebInspector
gi'selfPtr Ptr ()
_ = do
    Ptr WebInspector -> (WebInspector -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebInspector
gi'selfPtr ((WebInspector -> IO ()) -> IO ())
-> (WebInspector -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebInspector
gi'self -> a -> IO ()
gi'cb (WebInspector -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebInspector
gi'self) 


-- | Connect a signal handler for the [closed](#signal:closed) 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' webInspector #closed callback
-- @
-- 
-- 
onWebInspectorClosed :: (IsWebInspector a, MonadIO m) => a -> ((?self :: a) => WebInspectorClosedCallback) -> m SignalHandlerId
onWebInspectorClosed :: forall a (m :: * -> *).
(IsWebInspector a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWebInspectorClosed 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_WebInspectorClosedCallback
wrapped' = (a -> IO ()) -> C_WebInspectorClosedCallback
forall a. GObject a => (a -> IO ()) -> C_WebInspectorClosedCallback
wrap_WebInspectorClosedCallback a -> IO ()
wrapped
    FunPtr C_WebInspectorClosedCallback
wrapped'' <- C_WebInspectorClosedCallback
-> IO (FunPtr C_WebInspectorClosedCallback)
mk_WebInspectorClosedCallback C_WebInspectorClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_WebInspectorClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"closed" FunPtr C_WebInspectorClosedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [closed](#signal:closed) 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' webInspector #closed 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.
-- 
afterWebInspectorClosed :: (IsWebInspector a, MonadIO m) => a -> ((?self :: a) => WebInspectorClosedCallback) -> m SignalHandlerId
afterWebInspectorClosed :: forall a (m :: * -> *).
(IsWebInspector a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterWebInspectorClosed 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_WebInspectorClosedCallback
wrapped' = (a -> IO ()) -> C_WebInspectorClosedCallback
forall a. GObject a => (a -> IO ()) -> C_WebInspectorClosedCallback
wrap_WebInspectorClosedCallback a -> IO ()
wrapped
    FunPtr C_WebInspectorClosedCallback
wrapped'' <- C_WebInspectorClosedCallback
-> IO (FunPtr C_WebInspectorClosedCallback)
mk_WebInspectorClosedCallback C_WebInspectorClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_WebInspectorClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"closed" FunPtr C_WebInspectorClosedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebInspectorClosedSignalInfo
instance SignalInfo WebInspectorClosedSignalInfo where
    type HaskellCallbackType WebInspectorClosedSignalInfo = WebInspectorClosedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebInspectorClosedCallback cb
        cb'' <- mk_WebInspectorClosedCallback cb'
        connectSignalFunPtr obj "closed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebInspector::closed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.29/docs/GI-WebKit2-Objects-WebInspector.html#g:signal:closed"})

#endif

-- signal WebInspector::detach
-- | Emitted when the inspector is requested to be detached from the window
-- it is currently attached to. The inspector is detached when the inspector page
-- is about to be closed, and this signal is emitted right before
-- [WebInspector::closed]("GI.WebKit2.Objects.WebInspector#g:signal:closed"), or when the user clicks on the detach button
-- in the inspector view to show the inspector in a separate window. In this case
-- the signal [WebInspector::openWindow]("GI.WebKit2.Objects.WebInspector#g:signal:openWindow") is emitted after this one.
-- 
-- To prevent the inspector view from being detached you can connect to this
-- signal and simply return 'P.True'.
type WebInspectorDetachCallback =
    IO Bool
    -- ^ __Returns:__ 'P.True' to stop other handlers from being invoked for the event.
    --    'P.False' to propagate the event further.

type C_WebInspectorDetachCallback =
    Ptr WebInspector ->                     -- object
    Ptr () ->                               -- user_data
    IO CInt

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

wrap_WebInspectorDetachCallback :: 
    GObject a => (a -> WebInspectorDetachCallback) ->
    C_WebInspectorDetachCallback
wrap_WebInspectorDetachCallback :: forall a.
GObject a =>
(a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
wrap_WebInspectorDetachCallback a -> WebInspectorAttachCallback
gi'cb Ptr WebInspector
gi'selfPtr Ptr ()
_ = do
    Bool
result <- Ptr WebInspector
-> (WebInspector -> WebInspectorAttachCallback)
-> WebInspectorAttachCallback
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebInspector
gi'selfPtr ((WebInspector -> WebInspectorAttachCallback)
 -> WebInspectorAttachCallback)
-> (WebInspector -> WebInspectorAttachCallback)
-> WebInspectorAttachCallback
forall a b. (a -> b) -> a -> b
$ \WebInspector
gi'self -> a -> WebInspectorAttachCallback
gi'cb (WebInspector -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebInspector
gi'self) 
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [detach](#signal:detach) 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' webInspector #detach callback
-- @
-- 
-- 
onWebInspectorDetach :: (IsWebInspector a, MonadIO m) => a -> ((?self :: a) => WebInspectorDetachCallback) -> m SignalHandlerId
onWebInspectorDetach :: forall a (m :: * -> *).
(IsWebInspector a, MonadIO m) =>
a
-> ((?self::a) => WebInspectorAttachCallback) -> m SignalHandlerId
onWebInspectorDetach a
obj (?self::a) => WebInspectorAttachCallback
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 -> WebInspectorAttachCallback
wrapped a
self = let ?self = a
?self::a
self in WebInspectorAttachCallback
(?self::a) => WebInspectorAttachCallback
cb
    let wrapped' :: C_WebInspectorAttachCallback
wrapped' = (a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
forall a.
GObject a =>
(a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
wrap_WebInspectorDetachCallback a -> WebInspectorAttachCallback
wrapped
    FunPtr C_WebInspectorAttachCallback
wrapped'' <- C_WebInspectorAttachCallback
-> IO (FunPtr C_WebInspectorAttachCallback)
mk_WebInspectorDetachCallback C_WebInspectorAttachCallback
wrapped'
    a
-> Text
-> FunPtr C_WebInspectorAttachCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"detach" FunPtr C_WebInspectorAttachCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [detach](#signal:detach) 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' webInspector #detach 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.
-- 
afterWebInspectorDetach :: (IsWebInspector a, MonadIO m) => a -> ((?self :: a) => WebInspectorDetachCallback) -> m SignalHandlerId
afterWebInspectorDetach :: forall a (m :: * -> *).
(IsWebInspector a, MonadIO m) =>
a
-> ((?self::a) => WebInspectorAttachCallback) -> m SignalHandlerId
afterWebInspectorDetach a
obj (?self::a) => WebInspectorAttachCallback
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 -> WebInspectorAttachCallback
wrapped a
self = let ?self = a
?self::a
self in WebInspectorAttachCallback
(?self::a) => WebInspectorAttachCallback
cb
    let wrapped' :: C_WebInspectorAttachCallback
wrapped' = (a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
forall a.
GObject a =>
(a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
wrap_WebInspectorDetachCallback a -> WebInspectorAttachCallback
wrapped
    FunPtr C_WebInspectorAttachCallback
wrapped'' <- C_WebInspectorAttachCallback
-> IO (FunPtr C_WebInspectorAttachCallback)
mk_WebInspectorDetachCallback C_WebInspectorAttachCallback
wrapped'
    a
-> Text
-> FunPtr C_WebInspectorAttachCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"detach" FunPtr C_WebInspectorAttachCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebInspectorDetachSignalInfo
instance SignalInfo WebInspectorDetachSignalInfo where
    type HaskellCallbackType WebInspectorDetachSignalInfo = WebInspectorDetachCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebInspectorDetachCallback cb
        cb'' <- mk_WebInspectorDetachCallback cb'
        connectSignalFunPtr obj "detach" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebInspector::detach"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.29/docs/GI-WebKit2-Objects-WebInspector.html#g:signal:detach"})

#endif

-- signal WebInspector::open-window
-- | Emitted when the inspector is requested to open in a separate window.
-- If this signal is not handled, a t'GI.Gtk.Objects.Window.Window' with the inspector will be
-- created and shown, so you only need to handle this signal if you want
-- to use your own window.
-- This signal is emitted after [WebInspector::detach]("GI.WebKit2.Objects.WebInspector#g:signal:detach") to show
-- the inspector in a separate window after being detached.
-- 
-- To prevent the inspector from being shown you can connect to this
-- signal and simply return 'P.True'
type WebInspectorOpenWindowCallback =
    IO Bool
    -- ^ __Returns:__ 'P.True' to stop other handlers from being invoked for the event.
    --    'P.False' to propagate the event further.

type C_WebInspectorOpenWindowCallback =
    Ptr WebInspector ->                     -- object
    Ptr () ->                               -- user_data
    IO CInt

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

wrap_WebInspectorOpenWindowCallback :: 
    GObject a => (a -> WebInspectorOpenWindowCallback) ->
    C_WebInspectorOpenWindowCallback
wrap_WebInspectorOpenWindowCallback :: forall a.
GObject a =>
(a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
wrap_WebInspectorOpenWindowCallback a -> WebInspectorAttachCallback
gi'cb Ptr WebInspector
gi'selfPtr Ptr ()
_ = do
    Bool
result <- Ptr WebInspector
-> (WebInspector -> WebInspectorAttachCallback)
-> WebInspectorAttachCallback
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr WebInspector
gi'selfPtr ((WebInspector -> WebInspectorAttachCallback)
 -> WebInspectorAttachCallback)
-> (WebInspector -> WebInspectorAttachCallback)
-> WebInspectorAttachCallback
forall a b. (a -> b) -> a -> b
$ \WebInspector
gi'self -> a -> WebInspectorAttachCallback
gi'cb (WebInspector -> a
forall a b. Coercible a b => a -> b
Coerce.coerce WebInspector
gi'self) 
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [openWindow](#signal:openWindow) 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' webInspector #openWindow callback
-- @
-- 
-- 
onWebInspectorOpenWindow :: (IsWebInspector a, MonadIO m) => a -> ((?self :: a) => WebInspectorOpenWindowCallback) -> m SignalHandlerId
onWebInspectorOpenWindow :: forall a (m :: * -> *).
(IsWebInspector a, MonadIO m) =>
a
-> ((?self::a) => WebInspectorAttachCallback) -> m SignalHandlerId
onWebInspectorOpenWindow a
obj (?self::a) => WebInspectorAttachCallback
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 -> WebInspectorAttachCallback
wrapped a
self = let ?self = a
?self::a
self in WebInspectorAttachCallback
(?self::a) => WebInspectorAttachCallback
cb
    let wrapped' :: C_WebInspectorAttachCallback
wrapped' = (a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
forall a.
GObject a =>
(a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
wrap_WebInspectorOpenWindowCallback a -> WebInspectorAttachCallback
wrapped
    FunPtr C_WebInspectorAttachCallback
wrapped'' <- C_WebInspectorAttachCallback
-> IO (FunPtr C_WebInspectorAttachCallback)
mk_WebInspectorOpenWindowCallback C_WebInspectorAttachCallback
wrapped'
    a
-> Text
-> FunPtr C_WebInspectorAttachCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"open-window" FunPtr C_WebInspectorAttachCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [openWindow](#signal:openWindow) 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' webInspector #openWindow 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.
-- 
afterWebInspectorOpenWindow :: (IsWebInspector a, MonadIO m) => a -> ((?self :: a) => WebInspectorOpenWindowCallback) -> m SignalHandlerId
afterWebInspectorOpenWindow :: forall a (m :: * -> *).
(IsWebInspector a, MonadIO m) =>
a
-> ((?self::a) => WebInspectorAttachCallback) -> m SignalHandlerId
afterWebInspectorOpenWindow a
obj (?self::a) => WebInspectorAttachCallback
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 -> WebInspectorAttachCallback
wrapped a
self = let ?self = a
?self::a
self in WebInspectorAttachCallback
(?self::a) => WebInspectorAttachCallback
cb
    let wrapped' :: C_WebInspectorAttachCallback
wrapped' = (a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
forall a.
GObject a =>
(a -> WebInspectorAttachCallback) -> C_WebInspectorAttachCallback
wrap_WebInspectorOpenWindowCallback a -> WebInspectorAttachCallback
wrapped
    FunPtr C_WebInspectorAttachCallback
wrapped'' <- C_WebInspectorAttachCallback
-> IO (FunPtr C_WebInspectorAttachCallback)
mk_WebInspectorOpenWindowCallback C_WebInspectorAttachCallback
wrapped'
    a
-> Text
-> FunPtr C_WebInspectorAttachCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"open-window" FunPtr C_WebInspectorAttachCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data WebInspectorOpenWindowSignalInfo
instance SignalInfo WebInspectorOpenWindowSignalInfo where
    type HaskellCallbackType WebInspectorOpenWindowSignalInfo = WebInspectorOpenWindowCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_WebInspectorOpenWindowCallback cb
        cb'' <- mk_WebInspectorOpenWindowCallback cb'
        connectSignalFunPtr obj "open-window" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebInspector::open-window"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.29/docs/GI-WebKit2-Objects-WebInspector.html#g:signal:openWindow"})

#endif

-- VVV Prop "attached-height"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@attached-height@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' webInspector #attachedHeight
-- @
getWebInspectorAttachedHeight :: (MonadIO m, IsWebInspector o) => o -> m Word32
getWebInspectorAttachedHeight :: forall (m :: * -> *) o.
(MonadIO m, IsWebInspector o) =>
o -> m Word32
getWebInspectorAttachedHeight o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"attached-height"

#if defined(ENABLE_OVERLOADING)
data WebInspectorAttachedHeightPropertyInfo
instance AttrInfo WebInspectorAttachedHeightPropertyInfo where
    type AttrAllowedOps WebInspectorAttachedHeightPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint WebInspectorAttachedHeightPropertyInfo = IsWebInspector
    type AttrSetTypeConstraint WebInspectorAttachedHeightPropertyInfo = (~) ()
    type AttrTransferTypeConstraint WebInspectorAttachedHeightPropertyInfo = (~) ()
    type AttrTransferType WebInspectorAttachedHeightPropertyInfo = ()
    type AttrGetType WebInspectorAttachedHeightPropertyInfo = Word32
    type AttrLabel WebInspectorAttachedHeightPropertyInfo = "attached-height"
    type AttrOrigin WebInspectorAttachedHeightPropertyInfo = WebInspector
    attrGet = getWebInspectorAttachedHeight
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebInspector.attachedHeight"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.29/docs/GI-WebKit2-Objects-WebInspector.html#g:attr:attachedHeight"
        })
#endif

-- VVV Prop "can-attach"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@can-attach@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' webInspector #canAttach
-- @
getWebInspectorCanAttach :: (MonadIO m, IsWebInspector o) => o -> m Bool
getWebInspectorCanAttach :: forall (m :: * -> *) o.
(MonadIO m, IsWebInspector o) =>
o -> m Bool
getWebInspectorCanAttach o
obj = WebInspectorAttachCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (WebInspectorAttachCallback -> m Bool)
-> WebInspectorAttachCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> WebInspectorAttachCallback
forall a. GObject a => a -> String -> WebInspectorAttachCallback
B.Properties.getObjectPropertyBool o
obj String
"can-attach"

#if defined(ENABLE_OVERLOADING)
data WebInspectorCanAttachPropertyInfo
instance AttrInfo WebInspectorCanAttachPropertyInfo where
    type AttrAllowedOps WebInspectorCanAttachPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint WebInspectorCanAttachPropertyInfo = IsWebInspector
    type AttrSetTypeConstraint WebInspectorCanAttachPropertyInfo = (~) ()
    type AttrTransferTypeConstraint WebInspectorCanAttachPropertyInfo = (~) ()
    type AttrTransferType WebInspectorCanAttachPropertyInfo = ()
    type AttrGetType WebInspectorCanAttachPropertyInfo = Bool
    type AttrLabel WebInspectorCanAttachPropertyInfo = "can-attach"
    type AttrOrigin WebInspectorCanAttachPropertyInfo = WebInspector
    attrGet = getWebInspectorCanAttach
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.WebInspector.canAttach"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.29/docs/GI-WebKit2-Objects-WebInspector.html#g:attr:canAttach"
        })
#endif

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

-- | Get the value of the “@inspected-uri@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' webInspector #inspectedUri
-- @
getWebInspectorInspectedUri :: (MonadIO m, IsWebInspector o) => o -> m (Maybe T.Text)
getWebInspectorInspectedUri :: forall (m :: * -> *) o.
(MonadIO m, IsWebInspector o) =>
o -> m (Maybe Text)
getWebInspectorInspectedUri o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"inspected-uri"

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList WebInspector
type instance O.AttributeList WebInspector = WebInspectorAttributeList
type WebInspectorAttributeList = ('[ '("attachedHeight", WebInspectorAttachedHeightPropertyInfo), '("canAttach", WebInspectorCanAttachPropertyInfo), '("inspectedUri", WebInspectorInspectedUriPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
webInspectorAttachedHeight :: AttrLabelProxy "attachedHeight"
webInspectorAttachedHeight = AttrLabelProxy

webInspectorCanAttach :: AttrLabelProxy "canAttach"
webInspectorCanAttach = AttrLabelProxy

webInspectorInspectedUri :: AttrLabelProxy "inspectedUri"
webInspectorInspectedUri = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList WebInspector = WebInspectorSignalList
type WebInspectorSignalList = ('[ '("attach", WebInspectorAttachSignalInfo), '("bringToFront", WebInspectorBringToFrontSignalInfo), '("closed", WebInspectorClosedSignalInfo), '("detach", WebInspectorDetachSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("openWindow", WebInspectorOpenWindowSignalInfo)] :: [(Symbol, *)])

#endif

-- method WebInspector::attach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "inspector"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebInspector" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebInspector"
--                 , 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_inspector_attach" webkit_web_inspector_attach :: 
    Ptr WebInspector ->                     -- inspector : TInterface (Name {namespace = "WebKit2", name = "WebInspector"})
    IO ()

-- | Request /@inspector@/ to be attached.
-- 
-- The signal [WebInspector::attach]("GI.WebKit2.Objects.WebInspector#g:signal:attach")
-- will be emitted. If the inspector is already attached it does nothing.
webInspectorAttach ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebInspector a) =>
    a
    -- ^ /@inspector@/: a t'GI.WebKit2.Objects.WebInspector.WebInspector'
    -> m ()
webInspectorAttach :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebInspector a) =>
a -> m ()
webInspectorAttach a
inspector = 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 WebInspector
inspector' <- a -> IO (Ptr WebInspector)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
inspector
    Ptr WebInspector -> IO ()
webkit_web_inspector_attach Ptr WebInspector
inspector'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
inspector
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebInspectorAttachMethodInfo
instance (signature ~ (m ()), MonadIO m, IsWebInspector a) => O.OverloadedMethod WebInspectorAttachMethodInfo a signature where
    overloadedMethod = webInspectorAttach

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


#endif

-- method WebInspector::close
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "inspector"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebInspector" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebInspector"
--                 , 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_inspector_close" webkit_web_inspector_close :: 
    Ptr WebInspector ->                     -- inspector : TInterface (Name {namespace = "WebKit2", name = "WebInspector"})
    IO ()

-- | Request /@inspector@/ to be closed.
webInspectorClose ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebInspector a) =>
    a
    -- ^ /@inspector@/: a t'GI.WebKit2.Objects.WebInspector.WebInspector'
    -> m ()
webInspectorClose :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebInspector a) =>
a -> m ()
webInspectorClose a
inspector = 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 WebInspector
inspector' <- a -> IO (Ptr WebInspector)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
inspector
    Ptr WebInspector -> IO ()
webkit_web_inspector_close Ptr WebInspector
inspector'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
inspector
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebInspectorCloseMethodInfo
instance (signature ~ (m ()), MonadIO m, IsWebInspector a) => O.OverloadedMethod WebInspectorCloseMethodInfo a signature where
    overloadedMethod = webInspectorClose

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


#endif

-- method WebInspector::detach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "inspector"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebInspector" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebInspector"
--                 , 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_inspector_detach" webkit_web_inspector_detach :: 
    Ptr WebInspector ->                     -- inspector : TInterface (Name {namespace = "WebKit2", name = "WebInspector"})
    IO ()

-- | Request /@inspector@/ to be detached.
-- 
-- The signal [WebInspector::detach]("GI.WebKit2.Objects.WebInspector#g:signal:detach")
-- will be emitted. If the inspector is already detached it does nothing.
webInspectorDetach ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebInspector a) =>
    a
    -- ^ /@inspector@/: a t'GI.WebKit2.Objects.WebInspector.WebInspector'
    -> m ()
webInspectorDetach :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebInspector a) =>
a -> m ()
webInspectorDetach a
inspector = 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 WebInspector
inspector' <- a -> IO (Ptr WebInspector)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
inspector
    Ptr WebInspector -> IO ()
webkit_web_inspector_detach Ptr WebInspector
inspector'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
inspector
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebInspectorDetachMethodInfo
instance (signature ~ (m ()), MonadIO m, IsWebInspector a) => O.OverloadedMethod WebInspectorDetachMethodInfo a signature where
    overloadedMethod = webInspectorDetach

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


#endif

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

foreign import ccall "webkit_web_inspector_get_attached_height" webkit_web_inspector_get_attached_height :: 
    Ptr WebInspector ->                     -- inspector : TInterface (Name {namespace = "WebKit2", name = "WebInspector"})
    IO Word32

-- | Get the height that the inspector view when attached.
-- 
-- Get the height that the inspector view should have when
-- it\'s attached. If the inspector view is not attached this
-- returns 0.
webInspectorGetAttachedHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebInspector a) =>
    a
    -- ^ /@inspector@/: a t'GI.WebKit2.Objects.WebInspector.WebInspector'
    -> m Word32
    -- ^ __Returns:__ the height of the inspector view when attached
webInspectorGetAttachedHeight :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebInspector a) =>
a -> m Word32
webInspectorGetAttachedHeight a
inspector = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebInspector
inspector' <- a -> IO (Ptr WebInspector)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
inspector
    Word32
result <- Ptr WebInspector -> IO Word32
webkit_web_inspector_get_attached_height Ptr WebInspector
inspector'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
inspector
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data WebInspectorGetAttachedHeightMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsWebInspector a) => O.OverloadedMethod WebInspectorGetAttachedHeightMethodInfo a signature where
    overloadedMethod = webInspectorGetAttachedHeight

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


#endif

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

foreign import ccall "webkit_web_inspector_get_can_attach" webkit_web_inspector_get_can_attach :: 
    Ptr WebInspector ->                     -- inspector : TInterface (Name {namespace = "WebKit2", name = "WebInspector"})
    IO CInt

-- | Whether the /@inspector@/ can be attached to the same window that contains
-- the inspected view.
-- 
-- /Since: 2.8/
webInspectorGetCanAttach ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebInspector a) =>
    a
    -- ^ /@inspector@/: a t'GI.WebKit2.Objects.WebInspector.WebInspector'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if there is enough room for the inspector view inside the
    --     window that contains the inspected view, or 'P.False' otherwise.
webInspectorGetCanAttach :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebInspector a) =>
a -> m Bool
webInspectorGetCanAttach a
inspector = WebInspectorAttachCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (WebInspectorAttachCallback -> m Bool)
-> WebInspectorAttachCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebInspector
inspector' <- a -> IO (Ptr WebInspector)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
inspector
    CInt
result <- Ptr WebInspector -> IO CInt
webkit_web_inspector_get_can_attach Ptr WebInspector
inspector'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
inspector
    Bool -> WebInspectorAttachCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data WebInspectorGetCanAttachMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsWebInspector a) => O.OverloadedMethod WebInspectorGetCanAttachMethodInfo a signature where
    overloadedMethod = webInspectorGetCanAttach

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


#endif

-- method WebInspector::get_inspected_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "inspector"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebInspector" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebInspector"
--                 , 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_inspector_get_inspected_uri" webkit_web_inspector_get_inspected_uri :: 
    Ptr WebInspector ->                     -- inspector : TInterface (Name {namespace = "WebKit2", name = "WebInspector"})
    IO CString

-- | Get the URI that is currently being inspected.
-- 
-- This can be 'P.Nothing' if
-- nothing has been loaded yet in the inspected view, if the inspector
-- has been closed or when inspected view was loaded from a HTML string
-- instead of a URI.
webInspectorGetInspectedUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebInspector a) =>
    a
    -- ^ /@inspector@/: a t'GI.WebKit2.Objects.WebInspector.WebInspector'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the URI that is currently being inspected or 'P.Nothing'
webInspectorGetInspectedUri :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebInspector a) =>
a -> m (Maybe Text)
webInspectorGetInspectedUri a
inspector = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebInspector
inspector' <- a -> IO (Ptr WebInspector)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
inspector
    CString
result <- Ptr WebInspector -> IO CString
webkit_web_inspector_get_inspected_uri Ptr WebInspector
inspector'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
inspector
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data WebInspectorGetInspectedUriMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsWebInspector a) => O.OverloadedMethod WebInspectorGetInspectedUriMethodInfo a signature where
    overloadedMethod = webInspectorGetInspectedUri

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


#endif

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

foreign import ccall "webkit_web_inspector_get_web_view" webkit_web_inspector_get_web_view :: 
    Ptr WebInspector ->                     -- inspector : TInterface (Name {namespace = "WebKit2", name = "WebInspector"})
    IO (Ptr WebKit2.WebViewBase.WebViewBase)

-- | Get the t'GI.WebKit2.Objects.WebViewBase.WebViewBase' used to display the inspector.
-- 
-- This might be 'P.Nothing' if the inspector hasn\'t been loaded yet,
-- or it has been closed.
webInspectorGetWebView ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebInspector a) =>
    a
    -- ^ /@inspector@/: a t'GI.WebKit2.Objects.WebInspector.WebInspector'
    -> m (Maybe WebKit2.WebViewBase.WebViewBase)
    -- ^ __Returns:__ the t'GI.WebKit2.Objects.WebViewBase.WebViewBase' used to display the inspector or 'P.Nothing'
webInspectorGetWebView :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebInspector a) =>
a -> m (Maybe WebViewBase)
webInspectorGetWebView a
inspector = IO (Maybe WebViewBase) -> m (Maybe WebViewBase)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe WebViewBase) -> m (Maybe WebViewBase))
-> IO (Maybe WebViewBase) -> m (Maybe WebViewBase)
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebInspector
inspector' <- a -> IO (Ptr WebInspector)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
inspector
    Ptr WebViewBase
result <- Ptr WebInspector -> IO (Ptr WebViewBase)
webkit_web_inspector_get_web_view Ptr WebInspector
inspector'
    Maybe WebViewBase
maybeResult <- Ptr WebViewBase
-> (Ptr WebViewBase -> IO WebViewBase) -> IO (Maybe WebViewBase)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr WebViewBase
result ((Ptr WebViewBase -> IO WebViewBase) -> IO (Maybe WebViewBase))
-> (Ptr WebViewBase -> IO WebViewBase) -> IO (Maybe WebViewBase)
forall a b. (a -> b) -> a -> b
$ \Ptr WebViewBase
result' -> do
        WebViewBase
result'' <- ((ManagedPtr WebViewBase -> WebViewBase)
-> Ptr WebViewBase -> IO WebViewBase
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr WebViewBase -> WebViewBase
WebKit2.WebViewBase.WebViewBase) Ptr WebViewBase
result'
        WebViewBase -> IO WebViewBase
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WebViewBase
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
inspector
    Maybe WebViewBase -> IO (Maybe WebViewBase)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe WebViewBase
maybeResult

#if defined(ENABLE_OVERLOADING)
data WebInspectorGetWebViewMethodInfo
instance (signature ~ (m (Maybe WebKit2.WebViewBase.WebViewBase)), MonadIO m, IsWebInspector a) => O.OverloadedMethod WebInspectorGetWebViewMethodInfo a signature where
    overloadedMethod = webInspectorGetWebView

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


#endif

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

foreign import ccall "webkit_web_inspector_is_attached" webkit_web_inspector_is_attached :: 
    Ptr WebInspector ->                     -- inspector : TInterface (Name {namespace = "WebKit2", name = "WebInspector"})
    IO CInt

-- | Whether the /@inspector@/ view is currently attached to the same window that contains
-- the inspected view.
webInspectorIsAttached ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebInspector a) =>
    a
    -- ^ /@inspector@/: a t'GI.WebKit2.Objects.WebInspector.WebInspector'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@inspector@/ is currently attached or 'P.False' otherwise
webInspectorIsAttached :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebInspector a) =>
a -> m Bool
webInspectorIsAttached a
inspector = WebInspectorAttachCallback -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (WebInspectorAttachCallback -> m Bool)
-> WebInspectorAttachCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr WebInspector
inspector' <- a -> IO (Ptr WebInspector)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
inspector
    CInt
result <- Ptr WebInspector -> IO CInt
webkit_web_inspector_is_attached Ptr WebInspector
inspector'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
inspector
    Bool -> WebInspectorAttachCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data WebInspectorIsAttachedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsWebInspector a) => O.OverloadedMethod WebInspectorIsAttachedMethodInfo a signature where
    overloadedMethod = webInspectorIsAttached

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


#endif

-- method WebInspector::show
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "inspector"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "WebInspector" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitWebInspector"
--                 , 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_inspector_show" webkit_web_inspector_show :: 
    Ptr WebInspector ->                     -- inspector : TInterface (Name {namespace = "WebKit2", name = "WebInspector"})
    IO ()

-- | Request /@inspector@/ to be shown.
webInspectorShow ::
    (B.CallStack.HasCallStack, MonadIO m, IsWebInspector a) =>
    a
    -- ^ /@inspector@/: a t'GI.WebKit2.Objects.WebInspector.WebInspector'
    -> m ()
webInspectorShow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWebInspector a) =>
a -> m ()
webInspectorShow a
inspector = 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 WebInspector
inspector' <- a -> IO (Ptr WebInspector)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
inspector
    Ptr WebInspector -> IO ()
webkit_web_inspector_show Ptr WebInspector
inspector'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
inspector
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WebInspectorShowMethodInfo
instance (signature ~ (m ()), MonadIO m, IsWebInspector a) => O.OverloadedMethod WebInspectorShowMethodInfo a signature where
    overloadedMethod = webInspectorShow

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


#endif