{-# LANGUAGE TypeApplications #-}


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

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

module GI.WebKit2WebExtension.Objects.DOMKeyboardEvent
    ( 

-- * Exported types
    DOMKeyboardEvent(..)                    ,
    IsDOMKeyboardEvent                      ,
    toDOMKeyboardEvent                      ,
    noDOMKeyboardEvent                      ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDOMKeyboardEventMethod           ,
#endif


-- ** getAltGraphKey #method:getAltGraphKey#

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventGetAltGraphKeyMethodInfo,
#endif
    dOMKeyboardEventGetAltGraphKey          ,


-- ** getAltKey #method:getAltKey#

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventGetAltKeyMethodInfo     ,
#endif
    dOMKeyboardEventGetAltKey               ,


-- ** getCtrlKey #method:getCtrlKey#

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventGetCtrlKeyMethodInfo    ,
#endif
    dOMKeyboardEventGetCtrlKey              ,


-- ** getKeyIdentifier #method:getKeyIdentifier#

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventGetKeyIdentifierMethodInfo,
#endif
    dOMKeyboardEventGetKeyIdentifier        ,


-- ** getKeyLocation #method:getKeyLocation#

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventGetKeyLocationMethodInfo,
#endif
    dOMKeyboardEventGetKeyLocation          ,


-- ** getMetaKey #method:getMetaKey#

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventGetMetaKeyMethodInfo    ,
#endif
    dOMKeyboardEventGetMetaKey              ,


-- ** getModifierState #method:getModifierState#

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventGetModifierStateMethodInfo,
#endif
    dOMKeyboardEventGetModifierState        ,


-- ** getShiftKey #method:getShiftKey#

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventGetShiftKeyMethodInfo   ,
#endif
    dOMKeyboardEventGetShiftKey             ,


-- ** initKeyboardEvent #method:initKeyboardEvent#

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventInitKeyboardEventMethodInfo,
#endif
    dOMKeyboardEventInitKeyboardEvent       ,




 -- * Properties
-- ** altGraphKey #attr:altGraphKey#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventAltGraphKeyPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
    dOMKeyboardEventAltGraphKey             ,
#endif
    getDOMKeyboardEventAltGraphKey          ,


-- ** altKey #attr:altKey#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventAltKeyPropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    dOMKeyboardEventAltKey                  ,
#endif
    getDOMKeyboardEventAltKey               ,


-- ** ctrlKey #attr:ctrlKey#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventCtrlKeyPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    dOMKeyboardEventCtrlKey                 ,
#endif
    getDOMKeyboardEventCtrlKey              ,


-- ** keyIdentifier #attr:keyIdentifier#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventKeyIdentifierPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    dOMKeyboardEventKeyIdentifier           ,
#endif
    getDOMKeyboardEventKeyIdentifier        ,


-- ** keyLocation #attr:keyLocation#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventKeyLocationPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
    dOMKeyboardEventKeyLocation             ,
#endif
    getDOMKeyboardEventKeyLocation          ,


-- ** metaKey #attr:metaKey#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventMetaKeyPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    dOMKeyboardEventMetaKey                 ,
#endif
    getDOMKeyboardEventMetaKey              ,


-- ** shiftKey #attr:shiftKey#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DOMKeyboardEventShiftKeyPropertyInfo    ,
#endif
#if defined(ENABLE_OVERLOADING)
    dOMKeyboardEventShiftKey                ,
#endif
    getDOMKeyboardEventShiftKey             ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.WebKit2WebExtension.Objects.DOMDOMWindow as WebKit2WebExtension.DOMDOMWindow
import {-# SOURCE #-} qualified GI.WebKit2WebExtension.Objects.DOMEvent as WebKit2WebExtension.DOMEvent
import {-# SOURCE #-} qualified GI.WebKit2WebExtension.Objects.DOMObject as WebKit2WebExtension.DOMObject
import {-# SOURCE #-} qualified GI.WebKit2WebExtension.Objects.DOMUIEvent as WebKit2WebExtension.DOMUIEvent

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

instance GObject DOMKeyboardEvent where
    gobjectType :: IO GType
gobjectType = IO GType
c_webkit_dom_keyboard_event_get_type
    

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

-- | Type class for types which can be safely cast to `DOMKeyboardEvent`, for instance with `toDOMKeyboardEvent`.
class (GObject o, O.IsDescendantOf DOMKeyboardEvent o) => IsDOMKeyboardEvent o
instance (GObject o, O.IsDescendantOf DOMKeyboardEvent o) => IsDOMKeyboardEvent o

instance O.HasParentTypes DOMKeyboardEvent
type instance O.ParentTypes DOMKeyboardEvent = '[WebKit2WebExtension.DOMUIEvent.DOMUIEvent, WebKit2WebExtension.DOMEvent.DOMEvent, WebKit2WebExtension.DOMObject.DOMObject, GObject.Object.Object]

-- | Cast to `DOMKeyboardEvent`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toDOMKeyboardEvent :: (MonadIO m, IsDOMKeyboardEvent o) => o -> m DOMKeyboardEvent
toDOMKeyboardEvent :: o -> m DOMKeyboardEvent
toDOMKeyboardEvent = IO DOMKeyboardEvent -> m DOMKeyboardEvent
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DOMKeyboardEvent -> m DOMKeyboardEvent)
-> (o -> IO DOMKeyboardEvent) -> o -> m DOMKeyboardEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr DOMKeyboardEvent -> DOMKeyboardEvent)
-> o -> IO DOMKeyboardEvent
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr DOMKeyboardEvent -> DOMKeyboardEvent
DOMKeyboardEvent

-- | A convenience alias for `Nothing` :: `Maybe` `DOMKeyboardEvent`.
noDOMKeyboardEvent :: Maybe DOMKeyboardEvent
noDOMKeyboardEvent :: Maybe DOMKeyboardEvent
noDOMKeyboardEvent = Maybe DOMKeyboardEvent
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveDOMKeyboardEventMethod (t :: Symbol) (o :: *) :: * where
    ResolveDOMKeyboardEventMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDOMKeyboardEventMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDOMKeyboardEventMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDOMKeyboardEventMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDOMKeyboardEventMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDOMKeyboardEventMethod "initEvent" o = WebKit2WebExtension.DOMEvent.DOMEventInitEventMethodInfo
    ResolveDOMKeyboardEventMethod "initKeyboardEvent" o = DOMKeyboardEventInitKeyboardEventMethodInfo
    ResolveDOMKeyboardEventMethod "initUiEvent" o = WebKit2WebExtension.DOMUIEvent.DOMUIEventInitUiEventMethodInfo
    ResolveDOMKeyboardEventMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDOMKeyboardEventMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDOMKeyboardEventMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDOMKeyboardEventMethod "preventDefault" o = WebKit2WebExtension.DOMEvent.DOMEventPreventDefaultMethodInfo
    ResolveDOMKeyboardEventMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDOMKeyboardEventMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDOMKeyboardEventMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDOMKeyboardEventMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDOMKeyboardEventMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDOMKeyboardEventMethod "stopPropagation" o = WebKit2WebExtension.DOMEvent.DOMEventStopPropagationMethodInfo
    ResolveDOMKeyboardEventMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDOMKeyboardEventMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDOMKeyboardEventMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDOMKeyboardEventMethod "getAltGraphKey" o = DOMKeyboardEventGetAltGraphKeyMethodInfo
    ResolveDOMKeyboardEventMethod "getAltKey" o = DOMKeyboardEventGetAltKeyMethodInfo
    ResolveDOMKeyboardEventMethod "getBubbles" o = WebKit2WebExtension.DOMEvent.DOMEventGetBubblesMethodInfo
    ResolveDOMKeyboardEventMethod "getCancelBubble" o = WebKit2WebExtension.DOMEvent.DOMEventGetCancelBubbleMethodInfo
    ResolveDOMKeyboardEventMethod "getCancelable" o = WebKit2WebExtension.DOMEvent.DOMEventGetCancelableMethodInfo
    ResolveDOMKeyboardEventMethod "getCharCode" o = WebKit2WebExtension.DOMUIEvent.DOMUIEventGetCharCodeMethodInfo
    ResolveDOMKeyboardEventMethod "getCtrlKey" o = DOMKeyboardEventGetCtrlKeyMethodInfo
    ResolveDOMKeyboardEventMethod "getCurrentTarget" o = WebKit2WebExtension.DOMEvent.DOMEventGetCurrentTargetMethodInfo
    ResolveDOMKeyboardEventMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDOMKeyboardEventMethod "getDetail" o = WebKit2WebExtension.DOMUIEvent.DOMUIEventGetDetailMethodInfo
    ResolveDOMKeyboardEventMethod "getEventPhase" o = WebKit2WebExtension.DOMEvent.DOMEventGetEventPhaseMethodInfo
    ResolveDOMKeyboardEventMethod "getEventType" o = WebKit2WebExtension.DOMEvent.DOMEventGetEventTypeMethodInfo
    ResolveDOMKeyboardEventMethod "getKeyCode" o = WebKit2WebExtension.DOMUIEvent.DOMUIEventGetKeyCodeMethodInfo
    ResolveDOMKeyboardEventMethod "getKeyIdentifier" o = DOMKeyboardEventGetKeyIdentifierMethodInfo
    ResolveDOMKeyboardEventMethod "getKeyLocation" o = DOMKeyboardEventGetKeyLocationMethodInfo
    ResolveDOMKeyboardEventMethod "getLayerX" o = WebKit2WebExtension.DOMUIEvent.DOMUIEventGetLayerXMethodInfo
    ResolveDOMKeyboardEventMethod "getLayerY" o = WebKit2WebExtension.DOMUIEvent.DOMUIEventGetLayerYMethodInfo
    ResolveDOMKeyboardEventMethod "getMetaKey" o = DOMKeyboardEventGetMetaKeyMethodInfo
    ResolveDOMKeyboardEventMethod "getModifierState" o = DOMKeyboardEventGetModifierStateMethodInfo
    ResolveDOMKeyboardEventMethod "getPageX" o = WebKit2WebExtension.DOMUIEvent.DOMUIEventGetPageXMethodInfo
    ResolveDOMKeyboardEventMethod "getPageY" o = WebKit2WebExtension.DOMUIEvent.DOMUIEventGetPageYMethodInfo
    ResolveDOMKeyboardEventMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDOMKeyboardEventMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDOMKeyboardEventMethod "getReturnValue" o = WebKit2WebExtension.DOMEvent.DOMEventGetReturnValueMethodInfo
    ResolveDOMKeyboardEventMethod "getShiftKey" o = DOMKeyboardEventGetShiftKeyMethodInfo
    ResolveDOMKeyboardEventMethod "getSrcElement" o = WebKit2WebExtension.DOMEvent.DOMEventGetSrcElementMethodInfo
    ResolveDOMKeyboardEventMethod "getTarget" o = WebKit2WebExtension.DOMEvent.DOMEventGetTargetMethodInfo
    ResolveDOMKeyboardEventMethod "getTimeStamp" o = WebKit2WebExtension.DOMEvent.DOMEventGetTimeStampMethodInfo
    ResolveDOMKeyboardEventMethod "getView" o = WebKit2WebExtension.DOMUIEvent.DOMUIEventGetViewMethodInfo
    ResolveDOMKeyboardEventMethod "setCancelBubble" o = WebKit2WebExtension.DOMEvent.DOMEventSetCancelBubbleMethodInfo
    ResolveDOMKeyboardEventMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDOMKeyboardEventMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDOMKeyboardEventMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDOMKeyboardEventMethod "setReturnValue" o = WebKit2WebExtension.DOMEvent.DOMEventSetReturnValueMethodInfo
    ResolveDOMKeyboardEventMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDOMKeyboardEventMethod t DOMKeyboardEvent, O.MethodInfo info DOMKeyboardEvent p) => OL.IsLabel t (DOMKeyboardEvent -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

-- VVV Prop "alt-graph-key"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@alt-graph-key@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dOMKeyboardEvent #altGraphKey
-- @
getDOMKeyboardEventAltGraphKey :: (MonadIO m, IsDOMKeyboardEvent o) => o -> m Bool
getDOMKeyboardEventAltGraphKey :: o -> m Bool
getDOMKeyboardEventAltGraphKey obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "alt-graph-key"

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventAltGraphKeyPropertyInfo
instance AttrInfo DOMKeyboardEventAltGraphKeyPropertyInfo where
    type AttrAllowedOps DOMKeyboardEventAltGraphKeyPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DOMKeyboardEventAltGraphKeyPropertyInfo = IsDOMKeyboardEvent
    type AttrSetTypeConstraint DOMKeyboardEventAltGraphKeyPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DOMKeyboardEventAltGraphKeyPropertyInfo = (~) ()
    type AttrTransferType DOMKeyboardEventAltGraphKeyPropertyInfo = ()
    type AttrGetType DOMKeyboardEventAltGraphKeyPropertyInfo = Bool
    type AttrLabel DOMKeyboardEventAltGraphKeyPropertyInfo = "alt-graph-key"
    type AttrOrigin DOMKeyboardEventAltGraphKeyPropertyInfo = DOMKeyboardEvent
    attrGet = getDOMKeyboardEventAltGraphKey
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

-- | Get the value of the “@alt-key@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dOMKeyboardEvent #altKey
-- @
getDOMKeyboardEventAltKey :: (MonadIO m, IsDOMKeyboardEvent o) => o -> m Bool
getDOMKeyboardEventAltKey :: o -> m Bool
getDOMKeyboardEventAltKey obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "alt-key"

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventAltKeyPropertyInfo
instance AttrInfo DOMKeyboardEventAltKeyPropertyInfo where
    type AttrAllowedOps DOMKeyboardEventAltKeyPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DOMKeyboardEventAltKeyPropertyInfo = IsDOMKeyboardEvent
    type AttrSetTypeConstraint DOMKeyboardEventAltKeyPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DOMKeyboardEventAltKeyPropertyInfo = (~) ()
    type AttrTransferType DOMKeyboardEventAltKeyPropertyInfo = ()
    type AttrGetType DOMKeyboardEventAltKeyPropertyInfo = Bool
    type AttrLabel DOMKeyboardEventAltKeyPropertyInfo = "alt-key"
    type AttrOrigin DOMKeyboardEventAltKeyPropertyInfo = DOMKeyboardEvent
    attrGet = getDOMKeyboardEventAltKey
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

-- | Get the value of the “@ctrl-key@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dOMKeyboardEvent #ctrlKey
-- @
getDOMKeyboardEventCtrlKey :: (MonadIO m, IsDOMKeyboardEvent o) => o -> m Bool
getDOMKeyboardEventCtrlKey :: o -> m Bool
getDOMKeyboardEventCtrlKey obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "ctrl-key"

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventCtrlKeyPropertyInfo
instance AttrInfo DOMKeyboardEventCtrlKeyPropertyInfo where
    type AttrAllowedOps DOMKeyboardEventCtrlKeyPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DOMKeyboardEventCtrlKeyPropertyInfo = IsDOMKeyboardEvent
    type AttrSetTypeConstraint DOMKeyboardEventCtrlKeyPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DOMKeyboardEventCtrlKeyPropertyInfo = (~) ()
    type AttrTransferType DOMKeyboardEventCtrlKeyPropertyInfo = ()
    type AttrGetType DOMKeyboardEventCtrlKeyPropertyInfo = Bool
    type AttrLabel DOMKeyboardEventCtrlKeyPropertyInfo = "ctrl-key"
    type AttrOrigin DOMKeyboardEventCtrlKeyPropertyInfo = DOMKeyboardEvent
    attrGet = getDOMKeyboardEventCtrlKey
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "key-identifier"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@key-identifier@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dOMKeyboardEvent #keyIdentifier
-- @
getDOMKeyboardEventKeyIdentifier :: (MonadIO m, IsDOMKeyboardEvent o) => o -> m (Maybe T.Text)
getDOMKeyboardEventKeyIdentifier :: o -> m (Maybe Text)
getDOMKeyboardEventKeyIdentifier obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "key-identifier"

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventKeyIdentifierPropertyInfo
instance AttrInfo DOMKeyboardEventKeyIdentifierPropertyInfo where
    type AttrAllowedOps DOMKeyboardEventKeyIdentifierPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DOMKeyboardEventKeyIdentifierPropertyInfo = IsDOMKeyboardEvent
    type AttrSetTypeConstraint DOMKeyboardEventKeyIdentifierPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DOMKeyboardEventKeyIdentifierPropertyInfo = (~) ()
    type AttrTransferType DOMKeyboardEventKeyIdentifierPropertyInfo = ()
    type AttrGetType DOMKeyboardEventKeyIdentifierPropertyInfo = (Maybe T.Text)
    type AttrLabel DOMKeyboardEventKeyIdentifierPropertyInfo = "key-identifier"
    type AttrOrigin DOMKeyboardEventKeyIdentifierPropertyInfo = DOMKeyboardEvent
    attrGet = getDOMKeyboardEventKeyIdentifier
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "key-location"
   -- Type: TBasicType TULong
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@key-location@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dOMKeyboardEvent #keyLocation
-- @
getDOMKeyboardEventKeyLocation :: (MonadIO m, IsDOMKeyboardEvent o) => o -> m CULong
getDOMKeyboardEventKeyLocation :: o -> m CULong
getDOMKeyboardEventKeyLocation obj :: o
obj = IO CULong -> m CULong
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CULong -> m CULong) -> IO CULong -> m CULong
forall a b. (a -> b) -> a -> b
$ o -> String -> IO CULong
forall a. GObject a => a -> String -> IO CULong
B.Properties.getObjectPropertyULong o
obj "key-location"

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventKeyLocationPropertyInfo
instance AttrInfo DOMKeyboardEventKeyLocationPropertyInfo where
    type AttrAllowedOps DOMKeyboardEventKeyLocationPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DOMKeyboardEventKeyLocationPropertyInfo = IsDOMKeyboardEvent
    type AttrSetTypeConstraint DOMKeyboardEventKeyLocationPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DOMKeyboardEventKeyLocationPropertyInfo = (~) ()
    type AttrTransferType DOMKeyboardEventKeyLocationPropertyInfo = ()
    type AttrGetType DOMKeyboardEventKeyLocationPropertyInfo = CULong
    type AttrLabel DOMKeyboardEventKeyLocationPropertyInfo = "key-location"
    type AttrOrigin DOMKeyboardEventKeyLocationPropertyInfo = DOMKeyboardEvent
    attrGet = getDOMKeyboardEventKeyLocation
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

-- | Get the value of the “@meta-key@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dOMKeyboardEvent #metaKey
-- @
getDOMKeyboardEventMetaKey :: (MonadIO m, IsDOMKeyboardEvent o) => o -> m Bool
getDOMKeyboardEventMetaKey :: o -> m Bool
getDOMKeyboardEventMetaKey obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "meta-key"

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventMetaKeyPropertyInfo
instance AttrInfo DOMKeyboardEventMetaKeyPropertyInfo where
    type AttrAllowedOps DOMKeyboardEventMetaKeyPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DOMKeyboardEventMetaKeyPropertyInfo = IsDOMKeyboardEvent
    type AttrSetTypeConstraint DOMKeyboardEventMetaKeyPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DOMKeyboardEventMetaKeyPropertyInfo = (~) ()
    type AttrTransferType DOMKeyboardEventMetaKeyPropertyInfo = ()
    type AttrGetType DOMKeyboardEventMetaKeyPropertyInfo = Bool
    type AttrLabel DOMKeyboardEventMetaKeyPropertyInfo = "meta-key"
    type AttrOrigin DOMKeyboardEventMetaKeyPropertyInfo = DOMKeyboardEvent
    attrGet = getDOMKeyboardEventMetaKey
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

-- | Get the value of the “@shift-key@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dOMKeyboardEvent #shiftKey
-- @
getDOMKeyboardEventShiftKey :: (MonadIO m, IsDOMKeyboardEvent o) => o -> m Bool
getDOMKeyboardEventShiftKey :: o -> m Bool
getDOMKeyboardEventShiftKey obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "shift-key"

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventShiftKeyPropertyInfo
instance AttrInfo DOMKeyboardEventShiftKeyPropertyInfo where
    type AttrAllowedOps DOMKeyboardEventShiftKeyPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DOMKeyboardEventShiftKeyPropertyInfo = IsDOMKeyboardEvent
    type AttrSetTypeConstraint DOMKeyboardEventShiftKeyPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DOMKeyboardEventShiftKeyPropertyInfo = (~) ()
    type AttrTransferType DOMKeyboardEventShiftKeyPropertyInfo = ()
    type AttrGetType DOMKeyboardEventShiftKeyPropertyInfo = Bool
    type AttrLabel DOMKeyboardEventShiftKeyPropertyInfo = "shift-key"
    type AttrOrigin DOMKeyboardEventShiftKeyPropertyInfo = DOMKeyboardEvent
    attrGet = getDOMKeyboardEventShiftKey
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DOMKeyboardEvent
type instance O.AttributeList DOMKeyboardEvent = DOMKeyboardEventAttributeList
type DOMKeyboardEventAttributeList = ('[ '("altGraphKey", DOMKeyboardEventAltGraphKeyPropertyInfo), '("altKey", DOMKeyboardEventAltKeyPropertyInfo), '("bubbles", WebKit2WebExtension.DOMEvent.DOMEventBubblesPropertyInfo), '("cancelBubble", WebKit2WebExtension.DOMEvent.DOMEventCancelBubblePropertyInfo), '("cancelable", WebKit2WebExtension.DOMEvent.DOMEventCancelablePropertyInfo), '("charCode", WebKit2WebExtension.DOMUIEvent.DOMUIEventCharCodePropertyInfo), '("coreObject", WebKit2WebExtension.DOMObject.DOMObjectCoreObjectPropertyInfo), '("ctrlKey", DOMKeyboardEventCtrlKeyPropertyInfo), '("currentTarget", WebKit2WebExtension.DOMEvent.DOMEventCurrentTargetPropertyInfo), '("detail", WebKit2WebExtension.DOMUIEvent.DOMUIEventDetailPropertyInfo), '("eventPhase", WebKit2WebExtension.DOMEvent.DOMEventEventPhasePropertyInfo), '("keyCode", WebKit2WebExtension.DOMUIEvent.DOMUIEventKeyCodePropertyInfo), '("keyIdentifier", DOMKeyboardEventKeyIdentifierPropertyInfo), '("keyLocation", DOMKeyboardEventKeyLocationPropertyInfo), '("layerX", WebKit2WebExtension.DOMUIEvent.DOMUIEventLayerXPropertyInfo), '("layerY", WebKit2WebExtension.DOMUIEvent.DOMUIEventLayerYPropertyInfo), '("metaKey", DOMKeyboardEventMetaKeyPropertyInfo), '("pageX", WebKit2WebExtension.DOMUIEvent.DOMUIEventPageXPropertyInfo), '("pageY", WebKit2WebExtension.DOMUIEvent.DOMUIEventPageYPropertyInfo), '("returnValue", WebKit2WebExtension.DOMEvent.DOMEventReturnValuePropertyInfo), '("shiftKey", DOMKeyboardEventShiftKeyPropertyInfo), '("srcElement", WebKit2WebExtension.DOMEvent.DOMEventSrcElementPropertyInfo), '("target", WebKit2WebExtension.DOMEvent.DOMEventTargetPropertyInfo), '("timeStamp", WebKit2WebExtension.DOMEvent.DOMEventTimeStampPropertyInfo), '("type", WebKit2WebExtension.DOMEvent.DOMEventTypePropertyInfo), '("view", WebKit2WebExtension.DOMUIEvent.DOMUIEventViewPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
dOMKeyboardEventAltGraphKey :: AttrLabelProxy "altGraphKey"
dOMKeyboardEventAltGraphKey = AttrLabelProxy

dOMKeyboardEventAltKey :: AttrLabelProxy "altKey"
dOMKeyboardEventAltKey = AttrLabelProxy

dOMKeyboardEventCtrlKey :: AttrLabelProxy "ctrlKey"
dOMKeyboardEventCtrlKey = AttrLabelProxy

dOMKeyboardEventKeyIdentifier :: AttrLabelProxy "keyIdentifier"
dOMKeyboardEventKeyIdentifier = AttrLabelProxy

dOMKeyboardEventKeyLocation :: AttrLabelProxy "keyLocation"
dOMKeyboardEventKeyLocation = AttrLabelProxy

dOMKeyboardEventMetaKey :: AttrLabelProxy "metaKey"
dOMKeyboardEventMetaKey = AttrLabelProxy

dOMKeyboardEventShiftKey :: AttrLabelProxy "shiftKey"
dOMKeyboardEventShiftKey = AttrLabelProxy

#endif

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

#endif

-- method DOMKeyboardEvent::get_alt_graph_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMKeyboardEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMKeyboardEvent"
--                 , 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_dom_keyboard_event_get_alt_graph_key" webkit_dom_keyboard_event_get_alt_graph_key :: 
    Ptr DOMKeyboardEvent ->                 -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMKeyboardEvent"})
    IO CInt

{-# DEPRECATED dOMKeyboardEventGetAltGraphKey ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
dOMKeyboardEventGetAltGraphKey ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMKeyboardEvent a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMKeyboardEvent.DOMKeyboardEvent'
    -> m Bool
    -- ^ __Returns:__ A t'P.Bool'
dOMKeyboardEventGetAltGraphKey :: a -> m Bool
dOMKeyboardEventGetAltGraphKey self :: a
self = IO Bool -> m Bool
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 DOMKeyboardEvent
self' <- a -> IO (Ptr DOMKeyboardEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr DOMKeyboardEvent -> IO CInt
webkit_dom_keyboard_event_get_alt_graph_key Ptr DOMKeyboardEvent
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventGetAltGraphKeyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDOMKeyboardEvent a) => O.MethodInfo DOMKeyboardEventGetAltGraphKeyMethodInfo a signature where
    overloadedMethod = dOMKeyboardEventGetAltGraphKey

#endif

-- method DOMKeyboardEvent::get_alt_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMKeyboardEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMKeyboardEvent"
--                 , 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_dom_keyboard_event_get_alt_key" webkit_dom_keyboard_event_get_alt_key :: 
    Ptr DOMKeyboardEvent ->                 -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMKeyboardEvent"})
    IO CInt

{-# DEPRECATED dOMKeyboardEventGetAltKey ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
dOMKeyboardEventGetAltKey ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMKeyboardEvent a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMKeyboardEvent.DOMKeyboardEvent'
    -> m Bool
    -- ^ __Returns:__ A t'P.Bool'
dOMKeyboardEventGetAltKey :: a -> m Bool
dOMKeyboardEventGetAltKey self :: a
self = IO Bool -> m Bool
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 DOMKeyboardEvent
self' <- a -> IO (Ptr DOMKeyboardEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr DOMKeyboardEvent -> IO CInt
webkit_dom_keyboard_event_get_alt_key Ptr DOMKeyboardEvent
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventGetAltKeyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDOMKeyboardEvent a) => O.MethodInfo DOMKeyboardEventGetAltKeyMethodInfo a signature where
    overloadedMethod = dOMKeyboardEventGetAltKey

#endif

-- method DOMKeyboardEvent::get_ctrl_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMKeyboardEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMKeyboardEvent"
--                 , 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_dom_keyboard_event_get_ctrl_key" webkit_dom_keyboard_event_get_ctrl_key :: 
    Ptr DOMKeyboardEvent ->                 -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMKeyboardEvent"})
    IO CInt

{-# DEPRECATED dOMKeyboardEventGetCtrlKey ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
dOMKeyboardEventGetCtrlKey ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMKeyboardEvent a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMKeyboardEvent.DOMKeyboardEvent'
    -> m Bool
    -- ^ __Returns:__ A t'P.Bool'
dOMKeyboardEventGetCtrlKey :: a -> m Bool
dOMKeyboardEventGetCtrlKey self :: a
self = IO Bool -> m Bool
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 DOMKeyboardEvent
self' <- a -> IO (Ptr DOMKeyboardEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr DOMKeyboardEvent -> IO CInt
webkit_dom_keyboard_event_get_ctrl_key Ptr DOMKeyboardEvent
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventGetCtrlKeyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDOMKeyboardEvent a) => O.MethodInfo DOMKeyboardEventGetCtrlKeyMethodInfo a signature where
    overloadedMethod = dOMKeyboardEventGetCtrlKey

#endif

-- method DOMKeyboardEvent::get_key_identifier
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMKeyboardEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMKeyboardEvent"
--                 , 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_dom_keyboard_event_get_key_identifier" webkit_dom_keyboard_event_get_key_identifier :: 
    Ptr DOMKeyboardEvent ->                 -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMKeyboardEvent"})
    IO CString

{-# DEPRECATED dOMKeyboardEventGetKeyIdentifier ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
dOMKeyboardEventGetKeyIdentifier ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMKeyboardEvent a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMKeyboardEvent.DOMKeyboardEvent'
    -> m T.Text
    -- ^ __Returns:__ A @/gchar/@
dOMKeyboardEventGetKeyIdentifier :: a -> m Text
dOMKeyboardEventGetKeyIdentifier self :: a
self = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr DOMKeyboardEvent
self' <- a -> IO (Ptr DOMKeyboardEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr DOMKeyboardEvent -> IO CString
webkit_dom_keyboard_event_get_key_identifier Ptr DOMKeyboardEvent
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "dOMKeyboardEventGetKeyIdentifier" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventGetKeyIdentifierMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDOMKeyboardEvent a) => O.MethodInfo DOMKeyboardEventGetKeyIdentifierMethodInfo a signature where
    overloadedMethod = dOMKeyboardEventGetKeyIdentifier

#endif

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

foreign import ccall "webkit_dom_keyboard_event_get_key_location" webkit_dom_keyboard_event_get_key_location :: 
    Ptr DOMKeyboardEvent ->                 -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMKeyboardEvent"})
    IO CULong

{-# DEPRECATED dOMKeyboardEventGetKeyLocation ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
dOMKeyboardEventGetKeyLocation ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMKeyboardEvent a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMKeyboardEvent.DOMKeyboardEvent'
    -> m CULong
    -- ^ __Returns:__ A @/gulong/@
dOMKeyboardEventGetKeyLocation :: a -> m CULong
dOMKeyboardEventGetKeyLocation self :: a
self = IO CULong -> m CULong
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CULong -> m CULong) -> IO CULong -> m CULong
forall a b. (a -> b) -> a -> b
$ do
    Ptr DOMKeyboardEvent
self' <- a -> IO (Ptr DOMKeyboardEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CULong
result <- Ptr DOMKeyboardEvent -> IO CULong
webkit_dom_keyboard_event_get_key_location Ptr DOMKeyboardEvent
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CULong -> IO CULong
forall (m :: * -> *) a. Monad m => a -> m a
return CULong
result

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventGetKeyLocationMethodInfo
instance (signature ~ (m CULong), MonadIO m, IsDOMKeyboardEvent a) => O.MethodInfo DOMKeyboardEventGetKeyLocationMethodInfo a signature where
    overloadedMethod = dOMKeyboardEventGetKeyLocation

#endif

-- method DOMKeyboardEvent::get_meta_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMKeyboardEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMKeyboardEvent"
--                 , 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_dom_keyboard_event_get_meta_key" webkit_dom_keyboard_event_get_meta_key :: 
    Ptr DOMKeyboardEvent ->                 -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMKeyboardEvent"})
    IO CInt

{-# DEPRECATED dOMKeyboardEventGetMetaKey ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
dOMKeyboardEventGetMetaKey ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMKeyboardEvent a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMKeyboardEvent.DOMKeyboardEvent'
    -> m Bool
    -- ^ __Returns:__ A t'P.Bool'
dOMKeyboardEventGetMetaKey :: a -> m Bool
dOMKeyboardEventGetMetaKey self :: a
self = IO Bool -> m Bool
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 DOMKeyboardEvent
self' <- a -> IO (Ptr DOMKeyboardEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr DOMKeyboardEvent -> IO CInt
webkit_dom_keyboard_event_get_meta_key Ptr DOMKeyboardEvent
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventGetMetaKeyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDOMKeyboardEvent a) => O.MethodInfo DOMKeyboardEventGetMetaKeyMethodInfo a signature where
    overloadedMethod = dOMKeyboardEventGetMetaKey

#endif

-- method DOMKeyboardEvent::get_modifier_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMKeyboardEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMKeyboardEvent"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyIdentifierArg"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gchar" , 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_dom_keyboard_event_get_modifier_state" webkit_dom_keyboard_event_get_modifier_state :: 
    Ptr DOMKeyboardEvent ->                 -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMKeyboardEvent"})
    CString ->                              -- keyIdentifierArg : TBasicType TUTF8
    IO CInt

{-# DEPRECATED dOMKeyboardEventGetModifierState ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
dOMKeyboardEventGetModifierState ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMKeyboardEvent a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMKeyboardEvent.DOMKeyboardEvent'
    -> T.Text
    -- ^ /@keyIdentifierArg@/: A @/gchar/@
    -> m Bool
    -- ^ __Returns:__ A t'P.Bool'
dOMKeyboardEventGetModifierState :: a -> Text -> m Bool
dOMKeyboardEventGetModifierState self :: a
self keyIdentifierArg :: Text
keyIdentifierArg = IO Bool -> m Bool
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 DOMKeyboardEvent
self' <- a -> IO (Ptr DOMKeyboardEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
keyIdentifierArg' <- Text -> IO CString
textToCString Text
keyIdentifierArg
    CInt
result <- Ptr DOMKeyboardEvent -> CString -> IO CInt
webkit_dom_keyboard_event_get_modifier_state Ptr DOMKeyboardEvent
self' CString
keyIdentifierArg'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
keyIdentifierArg'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventGetModifierStateMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsDOMKeyboardEvent a) => O.MethodInfo DOMKeyboardEventGetModifierStateMethodInfo a signature where
    overloadedMethod = dOMKeyboardEventGetModifierState

#endif

-- method DOMKeyboardEvent::get_shift_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMKeyboardEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMKeyboardEvent"
--                 , 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_dom_keyboard_event_get_shift_key" webkit_dom_keyboard_event_get_shift_key :: 
    Ptr DOMKeyboardEvent ->                 -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMKeyboardEvent"})
    IO CInt

{-# DEPRECATED dOMKeyboardEventGetShiftKey ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
dOMKeyboardEventGetShiftKey ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMKeyboardEvent a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMKeyboardEvent.DOMKeyboardEvent'
    -> m Bool
    -- ^ __Returns:__ A t'P.Bool'
dOMKeyboardEventGetShiftKey :: a -> m Bool
dOMKeyboardEventGetShiftKey self :: a
self = IO Bool -> m Bool
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 DOMKeyboardEvent
self' <- a -> IO (Ptr DOMKeyboardEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr DOMKeyboardEvent -> IO CInt
webkit_dom_keyboard_event_get_shift_key Ptr DOMKeyboardEvent
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventGetShiftKeyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDOMKeyboardEvent a) => O.MethodInfo DOMKeyboardEventGetShiftKeyMethodInfo a signature where
    overloadedMethod = dOMKeyboardEventGetShiftKey

#endif

-- method DOMKeyboardEvent::init_keyboard_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMKeyboardEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMKeyboardEvent"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gchar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "canBubble"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gboolean" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancelable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gboolean" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "view"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "DOMDOMWindow" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMDOMWindow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyIdentifier"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gchar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "location"
--           , argType = TBasicType TULong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gulong" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ctrlKey"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gboolean" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "altKey"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gboolean" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "shiftKey"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gboolean" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "metaKey"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gboolean" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "altGraphKey"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gboolean" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_keyboard_event_init_keyboard_event" webkit_dom_keyboard_event_init_keyboard_event :: 
    Ptr DOMKeyboardEvent ->                 -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMKeyboardEvent"})
    CString ->                              -- type : TBasicType TUTF8
    CInt ->                                 -- canBubble : TBasicType TBoolean
    CInt ->                                 -- cancelable : TBasicType TBoolean
    Ptr WebKit2WebExtension.DOMDOMWindow.DOMDOMWindow -> -- view : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMDOMWindow"})
    CString ->                              -- keyIdentifier : TBasicType TUTF8
    CULong ->                               -- location : TBasicType TULong
    CInt ->                                 -- ctrlKey : TBasicType TBoolean
    CInt ->                                 -- altKey : TBasicType TBoolean
    CInt ->                                 -- shiftKey : TBasicType TBoolean
    CInt ->                                 -- metaKey : TBasicType TBoolean
    CInt ->                                 -- altGraphKey : TBasicType TBoolean
    IO ()

{-# DEPRECATED dOMKeyboardEventInitKeyboardEvent ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
dOMKeyboardEventInitKeyboardEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMKeyboardEvent a, WebKit2WebExtension.DOMDOMWindow.IsDOMDOMWindow b) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMKeyboardEvent.DOMKeyboardEvent'
    -> T.Text
    -- ^ /@type@/: A @/gchar/@
    -> Bool
    -- ^ /@canBubble@/: A t'P.Bool'
    -> Bool
    -- ^ /@cancelable@/: A t'P.Bool'
    -> b
    -- ^ /@view@/: A t'GI.WebKit2WebExtension.Objects.DOMDOMWindow.DOMDOMWindow'
    -> T.Text
    -- ^ /@keyIdentifier@/: A @/gchar/@
    -> CULong
    -- ^ /@location@/: A @/gulong/@
    -> Bool
    -- ^ /@ctrlKey@/: A t'P.Bool'
    -> Bool
    -- ^ /@altKey@/: A t'P.Bool'
    -> Bool
    -- ^ /@shiftKey@/: A t'P.Bool'
    -> Bool
    -- ^ /@metaKey@/: A t'P.Bool'
    -> Bool
    -- ^ /@altGraphKey@/: A t'P.Bool'
    -> m ()
dOMKeyboardEventInitKeyboardEvent :: a
-> Text
-> Bool
-> Bool
-> b
-> Text
-> CULong
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> m ()
dOMKeyboardEventInitKeyboardEvent self :: a
self type_ :: Text
type_ canBubble :: Bool
canBubble cancelable :: Bool
cancelable view :: b
view keyIdentifier :: Text
keyIdentifier location :: CULong
location ctrlKey :: Bool
ctrlKey altKey :: Bool
altKey shiftKey :: Bool
shiftKey metaKey :: Bool
metaKey altGraphKey :: Bool
altGraphKey = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DOMKeyboardEvent
self' <- a -> IO (Ptr DOMKeyboardEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
type_' <- Text -> IO CString
textToCString Text
type_
    let canBubble' :: CInt
canBubble' = (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
canBubble
    let cancelable' :: CInt
cancelable' = (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
cancelable
    Ptr DOMDOMWindow
view' <- b -> IO (Ptr DOMDOMWindow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
view
    CString
keyIdentifier' <- Text -> IO CString
textToCString Text
keyIdentifier
    let ctrlKey' :: CInt
ctrlKey' = (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
ctrlKey
    let altKey' :: CInt
altKey' = (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
altKey
    let shiftKey' :: CInt
shiftKey' = (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
shiftKey
    let metaKey' :: CInt
metaKey' = (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
metaKey
    let altGraphKey' :: CInt
altGraphKey' = (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
altGraphKey
    Ptr DOMKeyboardEvent
-> CString
-> CInt
-> CInt
-> Ptr DOMDOMWindow
-> CString
-> CULong
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> IO ()
webkit_dom_keyboard_event_init_keyboard_event Ptr DOMKeyboardEvent
self' CString
type_' CInt
canBubble' CInt
cancelable' Ptr DOMDOMWindow
view' CString
keyIdentifier' CULong
location CInt
ctrlKey' CInt
altKey' CInt
shiftKey' CInt
metaKey' CInt
altGraphKey'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
view
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
type_'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
keyIdentifier'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DOMKeyboardEventInitKeyboardEventMethodInfo
instance (signature ~ (T.Text -> Bool -> Bool -> b -> T.Text -> CULong -> Bool -> Bool -> Bool -> Bool -> Bool -> m ()), MonadIO m, IsDOMKeyboardEvent a, WebKit2WebExtension.DOMDOMWindow.IsDOMDOMWindow b) => O.MethodInfo DOMKeyboardEventInitKeyboardEventMethodInfo a signature where
    overloadedMethod = dOMKeyboardEventInitKeyboardEvent

#endif