{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A web page frame.
-- 
-- Each @WebKitWebPage@ has at least one main frame, and can have any number
-- of subframes.
-- 
-- /Since: 2.26/

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

module GI.WebKit2WebExtension.Objects.Frame
    ( 

-- * Exported types
    Frame(..)                               ,
    IsFrame                                 ,
    toFrame                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isMainFrame]("GI.WebKit2WebExtension.Objects.Frame#g:method:isMainFrame"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getId]("GI.WebKit2WebExtension.Objects.Frame#g:method:getId"), [getJsContext]("GI.WebKit2WebExtension.Objects.Frame#g:method:getJsContext"), [getJsContextForScriptWorld]("GI.WebKit2WebExtension.Objects.Frame#g:method:getJsContextForScriptWorld"), [getJsValueForDomObject]("GI.WebKit2WebExtension.Objects.Frame#g:method:getJsValueForDomObject"), [getJsValueForDomObjectInScriptWorld]("GI.WebKit2WebExtension.Objects.Frame#g:method:getJsValueForDomObjectInScriptWorld"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getUri]("GI.WebKit2WebExtension.Objects.Frame#g:method:getUri").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveFrameMethod                      ,
#endif

-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    FrameGetIdMethodInfo                    ,
#endif
    frameGetId                              ,


-- ** getJsContext #method:getJsContext#

#if defined(ENABLE_OVERLOADING)
    FrameGetJsContextMethodInfo             ,
#endif
    frameGetJsContext                       ,


-- ** getJsContextForScriptWorld #method:getJsContextForScriptWorld#

#if defined(ENABLE_OVERLOADING)
    FrameGetJsContextForScriptWorldMethodInfo,
#endif
    frameGetJsContextForScriptWorld         ,


-- ** getJsValueForDomObject #method:getJsValueForDomObject#

#if defined(ENABLE_OVERLOADING)
    FrameGetJsValueForDomObjectMethodInfo   ,
#endif
    frameGetJsValueForDomObject             ,


-- ** getJsValueForDomObjectInScriptWorld #method:getJsValueForDomObjectInScriptWorld#

#if defined(ENABLE_OVERLOADING)
    FrameGetJsValueForDomObjectInScriptWorldMethodInfo,
#endif
    frameGetJsValueForDomObjectInScriptWorld,


-- ** getUri #method:getUri#

#if defined(ENABLE_OVERLOADING)
    FrameGetUriMethodInfo                   ,
#endif
    frameGetUri                             ,


-- ** isMainFrame #method:isMainFrame#

#if defined(ENABLE_OVERLOADING)
    FrameIsMainFrameMethodInfo              ,
#endif
    frameIsMainFrame                        ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.JavaScriptCore.Objects.Context as JavaScriptCore.Context
import qualified GI.JavaScriptCore.Objects.Value as JavaScriptCore.Value
import {-# SOURCE #-} qualified GI.WebKit2WebExtension.Objects.DOMObject as WebKit2WebExtension.DOMObject
import {-# SOURCE #-} qualified GI.WebKit2WebExtension.Objects.ScriptWorld as WebKit2WebExtension.ScriptWorld

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

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

foreign import ccall "webkit_frame_get_type"
    c_webkit_frame_get_type :: IO B.Types.GType

instance B.Types.TypedObject Frame where
    glibType :: IO GType
glibType = IO GType
c_webkit_frame_get_type

instance B.Types.GObject Frame

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveFrameMethod (t :: Symbol) (o :: *) :: * where
    ResolveFrameMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFrameMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFrameMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFrameMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFrameMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFrameMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFrameMethod "isMainFrame" o = FrameIsMainFrameMethodInfo
    ResolveFrameMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFrameMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFrameMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFrameMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFrameMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFrameMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFrameMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFrameMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFrameMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFrameMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFrameMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFrameMethod "getId" o = FrameGetIdMethodInfo
    ResolveFrameMethod "getJsContext" o = FrameGetJsContextMethodInfo
    ResolveFrameMethod "getJsContextForScriptWorld" o = FrameGetJsContextForScriptWorldMethodInfo
    ResolveFrameMethod "getJsValueForDomObject" o = FrameGetJsValueForDomObjectMethodInfo
    ResolveFrameMethod "getJsValueForDomObjectInScriptWorld" o = FrameGetJsValueForDomObjectInScriptWorldMethodInfo
    ResolveFrameMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFrameMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFrameMethod "getUri" o = FrameGetUriMethodInfo
    ResolveFrameMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFrameMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFrameMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFrameMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Frame = FrameSignalList
type FrameSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "webkit_frame_get_id" webkit_frame_get_id :: 
    Ptr Frame ->                            -- frame : TInterface (Name {namespace = "WebKit2WebExtension", name = "Frame"})
    IO Word64

-- | Gets the process-unique identifier of this t'GI.WebKit2WebExtension.Objects.Frame.Frame'. No other
-- frame in the same web process will have the same ID; however, frames
-- in other web processes may.
-- 
-- /Since: 2.26/
frameGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsFrame a) =>
    a
    -- ^ /@frame@/: a t'GI.WebKit2WebExtension.Objects.Frame.Frame'
    -> m Word64
    -- ^ __Returns:__ the identifier of /@frame@/
frameGetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFrame a) =>
a -> m Word64
frameGetId a
frame = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Frame
frame' <- a -> IO (Ptr Frame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
frame
    Word64
result <- Ptr Frame -> IO Word64
webkit_frame_get_id Ptr Frame
frame'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
frame
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data FrameGetIdMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsFrame a) => O.OverloadedMethod FrameGetIdMethodInfo a signature where
    overloadedMethod = frameGetId

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


#endif

-- method Frame::get_js_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "Frame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "JavaScriptCore" , name = "Context" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_frame_get_js_context" webkit_frame_get_js_context :: 
    Ptr Frame ->                            -- frame : TInterface (Name {namespace = "WebKit2WebExtension", name = "Frame"})
    IO (Ptr JavaScriptCore.Context.Context)

-- | Get the JavaScript execution context of /@frame@/. Use this function to bridge
-- between the WebKit and JavaScriptCore APIs.
-- 
-- /Since: 2.22/
frameGetJsContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsFrame a) =>
    a
    -- ^ /@frame@/: a t'GI.WebKit2WebExtension.Objects.Frame.Frame'
    -> m JavaScriptCore.Context.Context
    -- ^ __Returns:__ the t'GI.JavaScriptCore.Objects.Context.Context' for the JavaScript execution context of /@frame@/.
frameGetJsContext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFrame a) =>
a -> m Context
frameGetJsContext a
frame = IO Context -> m Context
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Context -> m Context) -> IO Context -> m Context
forall a b. (a -> b) -> a -> b
$ do
    Ptr Frame
frame' <- a -> IO (Ptr Frame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
frame
    Ptr Context
result <- Ptr Frame -> IO (Ptr Context)
webkit_frame_get_js_context Ptr Frame
frame'
    Text -> Ptr Context -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"frameGetJsContext" Ptr Context
result
    Context
result' <- ((ManagedPtr Context -> Context) -> Ptr Context -> IO Context
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Context -> Context
JavaScriptCore.Context.Context) Ptr Context
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
frame
    Context -> IO Context
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Context
result'

#if defined(ENABLE_OVERLOADING)
data FrameGetJsContextMethodInfo
instance (signature ~ (m JavaScriptCore.Context.Context), MonadIO m, IsFrame a) => O.OverloadedMethod FrameGetJsContextMethodInfo a signature where
    overloadedMethod = frameGetJsContext

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


#endif

-- method Frame::get_js_context_for_script_world
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "Frame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "world"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "ScriptWorld" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitScriptWorld"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "JavaScriptCore" , name = "Context" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_frame_get_js_context_for_script_world" webkit_frame_get_js_context_for_script_world :: 
    Ptr Frame ->                            -- frame : TInterface (Name {namespace = "WebKit2WebExtension", name = "Frame"})
    Ptr WebKit2WebExtension.ScriptWorld.ScriptWorld -> -- world : TInterface (Name {namespace = "WebKit2WebExtension", name = "ScriptWorld"})
    IO (Ptr JavaScriptCore.Context.Context)

-- | Get the JavaScript execution context of /@frame@/ for the given t'GI.WebKit2WebExtension.Objects.ScriptWorld.ScriptWorld'.
-- 
-- /Since: 2.22/
frameGetJsContextForScriptWorld ::
    (B.CallStack.HasCallStack, MonadIO m, IsFrame a, WebKit2WebExtension.ScriptWorld.IsScriptWorld b) =>
    a
    -- ^ /@frame@/: a t'GI.WebKit2WebExtension.Objects.Frame.Frame'
    -> b
    -- ^ /@world@/: a t'GI.WebKit2WebExtension.Objects.ScriptWorld.ScriptWorld'
    -> m JavaScriptCore.Context.Context
    -- ^ __Returns:__ the t'GI.JavaScriptCore.Objects.Context.Context' for the JavaScript execution context of /@frame@/ for /@world@/.
frameGetJsContextForScriptWorld :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFrame a, IsScriptWorld b) =>
a -> b -> m Context
frameGetJsContextForScriptWorld a
frame b
world = IO Context -> m Context
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Context -> m Context) -> IO Context -> m Context
forall a b. (a -> b) -> a -> b
$ do
    Ptr Frame
frame' <- a -> IO (Ptr Frame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
frame
    Ptr ScriptWorld
world' <- b -> IO (Ptr ScriptWorld)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
world
    Ptr Context
result <- Ptr Frame -> Ptr ScriptWorld -> IO (Ptr Context)
webkit_frame_get_js_context_for_script_world Ptr Frame
frame' Ptr ScriptWorld
world'
    Text -> Ptr Context -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"frameGetJsContextForScriptWorld" Ptr Context
result
    Context
result' <- ((ManagedPtr Context -> Context) -> Ptr Context -> IO Context
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Context -> Context
JavaScriptCore.Context.Context) Ptr Context
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
frame
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
world
    Context -> IO Context
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Context
result'

#if defined(ENABLE_OVERLOADING)
data FrameGetJsContextForScriptWorldMethodInfo
instance (signature ~ (b -> m JavaScriptCore.Context.Context), MonadIO m, IsFrame a, WebKit2WebExtension.ScriptWorld.IsScriptWorld b) => O.OverloadedMethod FrameGetJsContextForScriptWorldMethodInfo a signature where
    overloadedMethod = frameGetJsContextForScriptWorld

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


#endif

-- method Frame::get_js_value_for_dom_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "Frame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dom_object"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "DOMObject" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitDOMObject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_frame_get_js_value_for_dom_object" webkit_frame_get_js_value_for_dom_object :: 
    Ptr Frame ->                            -- frame : TInterface (Name {namespace = "WebKit2WebExtension", name = "Frame"})
    Ptr WebKit2WebExtension.DOMObject.DOMObject -> -- dom_object : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMObject"})
    IO (Ptr JavaScriptCore.Value.Value)

-- | Get a t'GI.JavaScriptCore.Objects.Value.Value' referencing the given DOM object. The value is created in the JavaScript execution
-- context of /@frame@/.
-- 
-- /Since: 2.22/
frameGetJsValueForDomObject ::
    (B.CallStack.HasCallStack, MonadIO m, IsFrame a, WebKit2WebExtension.DOMObject.IsDOMObject b) =>
    a
    -- ^ /@frame@/: a t'GI.WebKit2WebExtension.Objects.Frame.Frame'
    -> b
    -- ^ /@domObject@/: a t'GI.WebKit2WebExtension.Objects.DOMObject.DOMObject'
    -> m JavaScriptCore.Value.Value
    -- ^ __Returns:__ the t'GI.JavaScriptCore.Objects.Value.Value' referencing /@domObject@/.
frameGetJsValueForDomObject :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFrame a, IsDOMObject b) =>
a -> b -> m Value
frameGetJsValueForDomObject a
frame b
domObject = IO Value -> m Value
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Frame
frame' <- a -> IO (Ptr Frame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
frame
    Ptr DOMObject
domObject' <- b -> IO (Ptr DOMObject)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
domObject
    Ptr Value
result <- Ptr Frame -> Ptr DOMObject -> IO (Ptr Value)
webkit_frame_get_js_value_for_dom_object Ptr Frame
frame' Ptr DOMObject
domObject'
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"frameGetJsValueForDomObject" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
JavaScriptCore.Value.Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
frame
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
domObject
    Value -> IO Value
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
data FrameGetJsValueForDomObjectMethodInfo
instance (signature ~ (b -> m JavaScriptCore.Value.Value), MonadIO m, IsFrame a, WebKit2WebExtension.DOMObject.IsDOMObject b) => O.OverloadedMethod FrameGetJsValueForDomObjectMethodInfo a signature where
    overloadedMethod = frameGetJsValueForDomObject

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


#endif

-- method Frame::get_js_value_for_dom_object_in_script_world
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "Frame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dom_object"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "DOMObject" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitDOMObject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "world"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "ScriptWorld" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitScriptWorld"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_frame_get_js_value_for_dom_object_in_script_world" webkit_frame_get_js_value_for_dom_object_in_script_world :: 
    Ptr Frame ->                            -- frame : TInterface (Name {namespace = "WebKit2WebExtension", name = "Frame"})
    Ptr WebKit2WebExtension.DOMObject.DOMObject -> -- dom_object : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMObject"})
    Ptr WebKit2WebExtension.ScriptWorld.ScriptWorld -> -- world : TInterface (Name {namespace = "WebKit2WebExtension", name = "ScriptWorld"})
    IO (Ptr JavaScriptCore.Value.Value)

-- | Get a t'GI.JavaScriptCore.Objects.Value.Value' referencing the given DOM object. The value is created in the JavaScript execution
-- context of /@frame@/ for the given t'GI.WebKit2WebExtension.Objects.ScriptWorld.ScriptWorld'.
-- 
-- /Since: 2.22/
frameGetJsValueForDomObjectInScriptWorld ::
    (B.CallStack.HasCallStack, MonadIO m, IsFrame a, WebKit2WebExtension.DOMObject.IsDOMObject b, WebKit2WebExtension.ScriptWorld.IsScriptWorld c) =>
    a
    -- ^ /@frame@/: a t'GI.WebKit2WebExtension.Objects.Frame.Frame'
    -> b
    -- ^ /@domObject@/: a t'GI.WebKit2WebExtension.Objects.DOMObject.DOMObject'
    -> c
    -- ^ /@world@/: a t'GI.WebKit2WebExtension.Objects.ScriptWorld.ScriptWorld'
    -> m JavaScriptCore.Value.Value
    -- ^ __Returns:__ the t'GI.JavaScriptCore.Objects.Value.Value' referencing /@domObject@/
frameGetJsValueForDomObjectInScriptWorld :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFrame a, IsDOMObject b,
 IsScriptWorld c) =>
a -> b -> c -> m Value
frameGetJsValueForDomObjectInScriptWorld a
frame b
domObject c
world = IO Value -> m Value
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Frame
frame' <- a -> IO (Ptr Frame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
frame
    Ptr DOMObject
domObject' <- b -> IO (Ptr DOMObject)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
domObject
    Ptr ScriptWorld
world' <- c -> IO (Ptr ScriptWorld)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
world
    Ptr Value
result <- Ptr Frame -> Ptr DOMObject -> Ptr ScriptWorld -> IO (Ptr Value)
webkit_frame_get_js_value_for_dom_object_in_script_world Ptr Frame
frame' Ptr DOMObject
domObject' Ptr ScriptWorld
world'
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"frameGetJsValueForDomObjectInScriptWorld" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
JavaScriptCore.Value.Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
frame
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
domObject
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
world
    Value -> IO Value
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
data FrameGetJsValueForDomObjectInScriptWorldMethodInfo
instance (signature ~ (b -> c -> m JavaScriptCore.Value.Value), MonadIO m, IsFrame a, WebKit2WebExtension.DOMObject.IsDOMObject b, WebKit2WebExtension.ScriptWorld.IsScriptWorld c) => O.OverloadedMethod FrameGetJsValueForDomObjectInScriptWorldMethodInfo a signature where
    overloadedMethod = frameGetJsValueForDomObjectInScriptWorld

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


#endif

-- method Frame::get_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "Frame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitFrame" , 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_frame_get_uri" webkit_frame_get_uri :: 
    Ptr Frame ->                            -- frame : TInterface (Name {namespace = "WebKit2WebExtension", name = "Frame"})
    IO CString

-- | Gets the current active URI of /@frame@/.
-- 
-- /Since: 2.2/
frameGetUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsFrame a) =>
    a
    -- ^ /@frame@/: a t'GI.WebKit2WebExtension.Objects.Frame.Frame'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the current active URI of /@frame@/ or 'P.Nothing' if nothing has been
    --    loaded yet.
frameGetUri :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFrame a) =>
a -> m (Maybe Text)
frameGetUri a
frame = 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 Frame
frame' <- a -> IO (Ptr Frame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
frame
    CString
result <- Ptr Frame -> IO CString
webkit_frame_get_uri Ptr Frame
frame'
    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
frame
    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 FrameGetUriMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsFrame a) => O.OverloadedMethod FrameGetUriMethodInfo a signature where
    overloadedMethod = frameGetUri

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


#endif

-- method Frame::is_main_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "Frame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitFrame" , 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_frame_is_main_frame" webkit_frame_is_main_frame :: 
    Ptr Frame ->                            -- frame : TInterface (Name {namespace = "WebKit2WebExtension", name = "Frame"})
    IO CInt

-- | Gets whether /@frame@/ is the main frame of a t'GI.WebKit2WebExtension.Objects.WebPage.WebPage'
-- 
-- /Since: 2.2/
frameIsMainFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsFrame a) =>
    a
    -- ^ /@frame@/: a t'GI.WebKit2WebExtension.Objects.Frame.Frame'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@frame@/ is a main frame or 'P.False' otherwise
frameIsMainFrame :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFrame a) =>
a -> m Bool
frameIsMainFrame a
frame = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Frame
frame' <- a -> IO (Ptr Frame)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
frame
    CInt
result <- Ptr Frame -> IO CInt
webkit_frame_is_main_frame Ptr Frame
frame'
    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
frame
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FrameIsMainFrameMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFrame a) => O.OverloadedMethod FrameIsMainFrameMethodInfo a signature where
    overloadedMethod = frameIsMainFrame

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


#endif