{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.WebKit.Objects.WebWindowFeatures
    ( 

-- * Exported types
    WebWindowFeatures(..)                   ,
    WebWindowFeaturesK                      ,
    toWebWindowFeatures                     ,
    noWebWindowFeatures                     ,


 -- * Methods
-- ** webWindowFeaturesEqual
    webWindowFeaturesEqual                  ,


-- ** webWindowFeaturesNew
    webWindowFeaturesNew                    ,




 -- * Properties
-- ** Fullscreen
    WebWindowFeaturesFullscreenPropertyInfo ,
    constructWebWindowFeaturesFullscreen    ,
    getWebWindowFeaturesFullscreen          ,
    setWebWindowFeaturesFullscreen          ,


-- ** Height
    WebWindowFeaturesHeightPropertyInfo     ,
    constructWebWindowFeaturesHeight        ,
    getWebWindowFeaturesHeight              ,
    setWebWindowFeaturesHeight              ,


-- ** LocationbarVisible
    WebWindowFeaturesLocationbarVisiblePropertyInfo,
    constructWebWindowFeaturesLocationbarVisible,
    getWebWindowFeaturesLocationbarVisible  ,
    setWebWindowFeaturesLocationbarVisible  ,


-- ** MenubarVisible
    WebWindowFeaturesMenubarVisiblePropertyInfo,
    constructWebWindowFeaturesMenubarVisible,
    getWebWindowFeaturesMenubarVisible      ,
    setWebWindowFeaturesMenubarVisible      ,


-- ** ScrollbarVisible
    WebWindowFeaturesScrollbarVisiblePropertyInfo,
    constructWebWindowFeaturesScrollbarVisible,
    getWebWindowFeaturesScrollbarVisible    ,
    setWebWindowFeaturesScrollbarVisible    ,


-- ** StatusbarVisible
    WebWindowFeaturesStatusbarVisiblePropertyInfo,
    constructWebWindowFeaturesStatusbarVisible,
    getWebWindowFeaturesStatusbarVisible    ,
    setWebWindowFeaturesStatusbarVisible    ,


-- ** ToolbarVisible
    WebWindowFeaturesToolbarVisiblePropertyInfo,
    constructWebWindowFeaturesToolbarVisible,
    getWebWindowFeaturesToolbarVisible      ,
    setWebWindowFeaturesToolbarVisible      ,


-- ** Width
    WebWindowFeaturesWidthPropertyInfo      ,
    constructWebWindowFeaturesWidth         ,
    getWebWindowFeaturesWidth               ,
    setWebWindowFeaturesWidth               ,


-- ** X
    WebWindowFeaturesXPropertyInfo          ,
    constructWebWindowFeaturesX             ,
    getWebWindowFeaturesX                   ,
    setWebWindowFeaturesX                   ,


-- ** Y
    WebWindowFeaturesYPropertyInfo          ,
    constructWebWindowFeaturesY             ,
    getWebWindowFeaturesY                   ,
    setWebWindowFeaturesY                   ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.WebKit.Types
import GI.WebKit.Callbacks
import qualified GI.GObject as GObject

newtype WebWindowFeatures = WebWindowFeatures (ForeignPtr WebWindowFeatures)
foreign import ccall "webkit_web_window_features_get_type"
    c_webkit_web_window_features_get_type :: IO GType

type instance ParentTypes WebWindowFeatures = WebWindowFeaturesParentTypes
type WebWindowFeaturesParentTypes = '[GObject.Object]

instance GObject WebWindowFeatures where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_webkit_web_window_features_get_type
    

class GObject o => WebWindowFeaturesK o
instance (GObject o, IsDescendantOf WebWindowFeatures o) => WebWindowFeaturesK o

toWebWindowFeatures :: WebWindowFeaturesK o => o -> IO WebWindowFeatures
toWebWindowFeatures = unsafeCastTo WebWindowFeatures

noWebWindowFeatures :: Maybe WebWindowFeatures
noWebWindowFeatures = Nothing

-- VVV Prop "fullscreen"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]

getWebWindowFeaturesFullscreen :: (MonadIO m, WebWindowFeaturesK o) => o -> m Bool
getWebWindowFeaturesFullscreen obj = liftIO $ getObjectPropertyBool obj "fullscreen"

setWebWindowFeaturesFullscreen :: (MonadIO m, WebWindowFeaturesK o) => o -> Bool -> m ()
setWebWindowFeaturesFullscreen obj val = liftIO $ setObjectPropertyBool obj "fullscreen" val

constructWebWindowFeaturesFullscreen :: Bool -> IO ([Char], GValue)
constructWebWindowFeaturesFullscreen val = constructObjectPropertyBool "fullscreen" val

data WebWindowFeaturesFullscreenPropertyInfo
instance AttrInfo WebWindowFeaturesFullscreenPropertyInfo where
    type AttrAllowedOps WebWindowFeaturesFullscreenPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WebWindowFeaturesFullscreenPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint WebWindowFeaturesFullscreenPropertyInfo = WebWindowFeaturesK
    type AttrGetType WebWindowFeaturesFullscreenPropertyInfo = Bool
    type AttrLabel WebWindowFeaturesFullscreenPropertyInfo = "WebWindowFeatures::fullscreen"
    attrGet _ = getWebWindowFeaturesFullscreen
    attrSet _ = setWebWindowFeaturesFullscreen
    attrConstruct _ = constructWebWindowFeaturesFullscreen

-- VVV Prop "height"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]

getWebWindowFeaturesHeight :: (MonadIO m, WebWindowFeaturesK o) => o -> m Int32
getWebWindowFeaturesHeight obj = liftIO $ getObjectPropertyCInt obj "height"

setWebWindowFeaturesHeight :: (MonadIO m, WebWindowFeaturesK o) => o -> Int32 -> m ()
setWebWindowFeaturesHeight obj val = liftIO $ setObjectPropertyCInt obj "height" val

constructWebWindowFeaturesHeight :: Int32 -> IO ([Char], GValue)
constructWebWindowFeaturesHeight val = constructObjectPropertyCInt "height" val

data WebWindowFeaturesHeightPropertyInfo
instance AttrInfo WebWindowFeaturesHeightPropertyInfo where
    type AttrAllowedOps WebWindowFeaturesHeightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WebWindowFeaturesHeightPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint WebWindowFeaturesHeightPropertyInfo = WebWindowFeaturesK
    type AttrGetType WebWindowFeaturesHeightPropertyInfo = Int32
    type AttrLabel WebWindowFeaturesHeightPropertyInfo = "WebWindowFeatures::height"
    attrGet _ = getWebWindowFeaturesHeight
    attrSet _ = setWebWindowFeaturesHeight
    attrConstruct _ = constructWebWindowFeaturesHeight

-- VVV Prop "locationbar-visible"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]

getWebWindowFeaturesLocationbarVisible :: (MonadIO m, WebWindowFeaturesK o) => o -> m Bool
getWebWindowFeaturesLocationbarVisible obj = liftIO $ getObjectPropertyBool obj "locationbar-visible"

setWebWindowFeaturesLocationbarVisible :: (MonadIO m, WebWindowFeaturesK o) => o -> Bool -> m ()
setWebWindowFeaturesLocationbarVisible obj val = liftIO $ setObjectPropertyBool obj "locationbar-visible" val

constructWebWindowFeaturesLocationbarVisible :: Bool -> IO ([Char], GValue)
constructWebWindowFeaturesLocationbarVisible val = constructObjectPropertyBool "locationbar-visible" val

data WebWindowFeaturesLocationbarVisiblePropertyInfo
instance AttrInfo WebWindowFeaturesLocationbarVisiblePropertyInfo where
    type AttrAllowedOps WebWindowFeaturesLocationbarVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WebWindowFeaturesLocationbarVisiblePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint WebWindowFeaturesLocationbarVisiblePropertyInfo = WebWindowFeaturesK
    type AttrGetType WebWindowFeaturesLocationbarVisiblePropertyInfo = Bool
    type AttrLabel WebWindowFeaturesLocationbarVisiblePropertyInfo = "WebWindowFeatures::locationbar-visible"
    attrGet _ = getWebWindowFeaturesLocationbarVisible
    attrSet _ = setWebWindowFeaturesLocationbarVisible
    attrConstruct _ = constructWebWindowFeaturesLocationbarVisible

-- VVV Prop "menubar-visible"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]

getWebWindowFeaturesMenubarVisible :: (MonadIO m, WebWindowFeaturesK o) => o -> m Bool
getWebWindowFeaturesMenubarVisible obj = liftIO $ getObjectPropertyBool obj "menubar-visible"

setWebWindowFeaturesMenubarVisible :: (MonadIO m, WebWindowFeaturesK o) => o -> Bool -> m ()
setWebWindowFeaturesMenubarVisible obj val = liftIO $ setObjectPropertyBool obj "menubar-visible" val

constructWebWindowFeaturesMenubarVisible :: Bool -> IO ([Char], GValue)
constructWebWindowFeaturesMenubarVisible val = constructObjectPropertyBool "menubar-visible" val

data WebWindowFeaturesMenubarVisiblePropertyInfo
instance AttrInfo WebWindowFeaturesMenubarVisiblePropertyInfo where
    type AttrAllowedOps WebWindowFeaturesMenubarVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WebWindowFeaturesMenubarVisiblePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint WebWindowFeaturesMenubarVisiblePropertyInfo = WebWindowFeaturesK
    type AttrGetType WebWindowFeaturesMenubarVisiblePropertyInfo = Bool
    type AttrLabel WebWindowFeaturesMenubarVisiblePropertyInfo = "WebWindowFeatures::menubar-visible"
    attrGet _ = getWebWindowFeaturesMenubarVisible
    attrSet _ = setWebWindowFeaturesMenubarVisible
    attrConstruct _ = constructWebWindowFeaturesMenubarVisible

-- VVV Prop "scrollbar-visible"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]

getWebWindowFeaturesScrollbarVisible :: (MonadIO m, WebWindowFeaturesK o) => o -> m Bool
getWebWindowFeaturesScrollbarVisible obj = liftIO $ getObjectPropertyBool obj "scrollbar-visible"

setWebWindowFeaturesScrollbarVisible :: (MonadIO m, WebWindowFeaturesK o) => o -> Bool -> m ()
setWebWindowFeaturesScrollbarVisible obj val = liftIO $ setObjectPropertyBool obj "scrollbar-visible" val

constructWebWindowFeaturesScrollbarVisible :: Bool -> IO ([Char], GValue)
constructWebWindowFeaturesScrollbarVisible val = constructObjectPropertyBool "scrollbar-visible" val

data WebWindowFeaturesScrollbarVisiblePropertyInfo
instance AttrInfo WebWindowFeaturesScrollbarVisiblePropertyInfo where
    type AttrAllowedOps WebWindowFeaturesScrollbarVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WebWindowFeaturesScrollbarVisiblePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint WebWindowFeaturesScrollbarVisiblePropertyInfo = WebWindowFeaturesK
    type AttrGetType WebWindowFeaturesScrollbarVisiblePropertyInfo = Bool
    type AttrLabel WebWindowFeaturesScrollbarVisiblePropertyInfo = "WebWindowFeatures::scrollbar-visible"
    attrGet _ = getWebWindowFeaturesScrollbarVisible
    attrSet _ = setWebWindowFeaturesScrollbarVisible
    attrConstruct _ = constructWebWindowFeaturesScrollbarVisible

-- VVV Prop "statusbar-visible"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]

getWebWindowFeaturesStatusbarVisible :: (MonadIO m, WebWindowFeaturesK o) => o -> m Bool
getWebWindowFeaturesStatusbarVisible obj = liftIO $ getObjectPropertyBool obj "statusbar-visible"

setWebWindowFeaturesStatusbarVisible :: (MonadIO m, WebWindowFeaturesK o) => o -> Bool -> m ()
setWebWindowFeaturesStatusbarVisible obj val = liftIO $ setObjectPropertyBool obj "statusbar-visible" val

constructWebWindowFeaturesStatusbarVisible :: Bool -> IO ([Char], GValue)
constructWebWindowFeaturesStatusbarVisible val = constructObjectPropertyBool "statusbar-visible" val

data WebWindowFeaturesStatusbarVisiblePropertyInfo
instance AttrInfo WebWindowFeaturesStatusbarVisiblePropertyInfo where
    type AttrAllowedOps WebWindowFeaturesStatusbarVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WebWindowFeaturesStatusbarVisiblePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint WebWindowFeaturesStatusbarVisiblePropertyInfo = WebWindowFeaturesK
    type AttrGetType WebWindowFeaturesStatusbarVisiblePropertyInfo = Bool
    type AttrLabel WebWindowFeaturesStatusbarVisiblePropertyInfo = "WebWindowFeatures::statusbar-visible"
    attrGet _ = getWebWindowFeaturesStatusbarVisible
    attrSet _ = setWebWindowFeaturesStatusbarVisible
    attrConstruct _ = constructWebWindowFeaturesStatusbarVisible

-- VVV Prop "toolbar-visible"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]

getWebWindowFeaturesToolbarVisible :: (MonadIO m, WebWindowFeaturesK o) => o -> m Bool
getWebWindowFeaturesToolbarVisible obj = liftIO $ getObjectPropertyBool obj "toolbar-visible"

setWebWindowFeaturesToolbarVisible :: (MonadIO m, WebWindowFeaturesK o) => o -> Bool -> m ()
setWebWindowFeaturesToolbarVisible obj val = liftIO $ setObjectPropertyBool obj "toolbar-visible" val

constructWebWindowFeaturesToolbarVisible :: Bool -> IO ([Char], GValue)
constructWebWindowFeaturesToolbarVisible val = constructObjectPropertyBool "toolbar-visible" val

data WebWindowFeaturesToolbarVisiblePropertyInfo
instance AttrInfo WebWindowFeaturesToolbarVisiblePropertyInfo where
    type AttrAllowedOps WebWindowFeaturesToolbarVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WebWindowFeaturesToolbarVisiblePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint WebWindowFeaturesToolbarVisiblePropertyInfo = WebWindowFeaturesK
    type AttrGetType WebWindowFeaturesToolbarVisiblePropertyInfo = Bool
    type AttrLabel WebWindowFeaturesToolbarVisiblePropertyInfo = "WebWindowFeatures::toolbar-visible"
    attrGet _ = getWebWindowFeaturesToolbarVisible
    attrSet _ = setWebWindowFeaturesToolbarVisible
    attrConstruct _ = constructWebWindowFeaturesToolbarVisible

-- VVV Prop "width"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]

getWebWindowFeaturesWidth :: (MonadIO m, WebWindowFeaturesK o) => o -> m Int32
getWebWindowFeaturesWidth obj = liftIO $ getObjectPropertyCInt obj "width"

setWebWindowFeaturesWidth :: (MonadIO m, WebWindowFeaturesK o) => o -> Int32 -> m ()
setWebWindowFeaturesWidth obj val = liftIO $ setObjectPropertyCInt obj "width" val

constructWebWindowFeaturesWidth :: Int32 -> IO ([Char], GValue)
constructWebWindowFeaturesWidth val = constructObjectPropertyCInt "width" val

data WebWindowFeaturesWidthPropertyInfo
instance AttrInfo WebWindowFeaturesWidthPropertyInfo where
    type AttrAllowedOps WebWindowFeaturesWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WebWindowFeaturesWidthPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint WebWindowFeaturesWidthPropertyInfo = WebWindowFeaturesK
    type AttrGetType WebWindowFeaturesWidthPropertyInfo = Int32
    type AttrLabel WebWindowFeaturesWidthPropertyInfo = "WebWindowFeatures::width"
    attrGet _ = getWebWindowFeaturesWidth
    attrSet _ = setWebWindowFeaturesWidth
    attrConstruct _ = constructWebWindowFeaturesWidth

-- VVV Prop "x"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]

getWebWindowFeaturesX :: (MonadIO m, WebWindowFeaturesK o) => o -> m Int32
getWebWindowFeaturesX obj = liftIO $ getObjectPropertyCInt obj "x"

setWebWindowFeaturesX :: (MonadIO m, WebWindowFeaturesK o) => o -> Int32 -> m ()
setWebWindowFeaturesX obj val = liftIO $ setObjectPropertyCInt obj "x" val

constructWebWindowFeaturesX :: Int32 -> IO ([Char], GValue)
constructWebWindowFeaturesX val = constructObjectPropertyCInt "x" val

data WebWindowFeaturesXPropertyInfo
instance AttrInfo WebWindowFeaturesXPropertyInfo where
    type AttrAllowedOps WebWindowFeaturesXPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WebWindowFeaturesXPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint WebWindowFeaturesXPropertyInfo = WebWindowFeaturesK
    type AttrGetType WebWindowFeaturesXPropertyInfo = Int32
    type AttrLabel WebWindowFeaturesXPropertyInfo = "WebWindowFeatures::x"
    attrGet _ = getWebWindowFeaturesX
    attrSet _ = setWebWindowFeaturesX
    attrConstruct _ = constructWebWindowFeaturesX

-- VVV Prop "y"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]

getWebWindowFeaturesY :: (MonadIO m, WebWindowFeaturesK o) => o -> m Int32
getWebWindowFeaturesY obj = liftIO $ getObjectPropertyCInt obj "y"

setWebWindowFeaturesY :: (MonadIO m, WebWindowFeaturesK o) => o -> Int32 -> m ()
setWebWindowFeaturesY obj val = liftIO $ setObjectPropertyCInt obj "y" val

constructWebWindowFeaturesY :: Int32 -> IO ([Char], GValue)
constructWebWindowFeaturesY val = constructObjectPropertyCInt "y" val

data WebWindowFeaturesYPropertyInfo
instance AttrInfo WebWindowFeaturesYPropertyInfo where
    type AttrAllowedOps WebWindowFeaturesYPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint WebWindowFeaturesYPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint WebWindowFeaturesYPropertyInfo = WebWindowFeaturesK
    type AttrGetType WebWindowFeaturesYPropertyInfo = Int32
    type AttrLabel WebWindowFeaturesYPropertyInfo = "WebWindowFeatures::y"
    attrGet _ = getWebWindowFeaturesY
    attrSet _ = setWebWindowFeaturesY
    attrConstruct _ = constructWebWindowFeaturesY

type instance AttributeList WebWindowFeatures = WebWindowFeaturesAttributeList
type WebWindowFeaturesAttributeList = ('[ '("fullscreen", WebWindowFeaturesFullscreenPropertyInfo), '("height", WebWindowFeaturesHeightPropertyInfo), '("locationbar-visible", WebWindowFeaturesLocationbarVisiblePropertyInfo), '("menubar-visible", WebWindowFeaturesMenubarVisiblePropertyInfo), '("scrollbar-visible", WebWindowFeaturesScrollbarVisiblePropertyInfo), '("statusbar-visible", WebWindowFeaturesStatusbarVisiblePropertyInfo), '("toolbar-visible", WebWindowFeaturesToolbarVisiblePropertyInfo), '("width", WebWindowFeaturesWidthPropertyInfo), '("x", WebWindowFeaturesXPropertyInfo), '("y", WebWindowFeaturesYPropertyInfo)] :: [(Symbol, *)])

type instance SignalList WebWindowFeatures = WebWindowFeaturesSignalList
type WebWindowFeaturesSignalList = ('[ '("notify", GObject.ObjectNotifySignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method WebWindowFeatures::new
-- method type : Constructor
-- Args : []
-- Lengths : []
-- hInArgs : []
-- returnType : TInterface "WebKit" "WebWindowFeatures"
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_window_features_new" webkit_web_window_features_new :: 
    IO (Ptr WebWindowFeatures)


webWindowFeaturesNew ::
    (MonadIO m) =>
    m WebWindowFeatures
webWindowFeaturesNew  = liftIO $ do
    result <- webkit_web_window_features_new
    checkUnexpectedReturnNULL "webkit_web_window_features_new" result
    result' <- (wrapObject WebWindowFeatures) result
    return result'

-- method WebWindowFeatures::equal
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "WebWindowFeatures", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "features2", argType = TInterface "WebKit" "WebWindowFeatures", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "WebWindowFeatures", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "features2", argType = TInterface "WebKit" "WebWindowFeatures", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "webkit_web_window_features_equal" webkit_web_window_features_equal :: 
    Ptr WebWindowFeatures ->                -- _obj : TInterface "WebKit" "WebWindowFeatures"
    Ptr WebWindowFeatures ->                -- features2 : TInterface "WebKit" "WebWindowFeatures"
    IO CInt


webWindowFeaturesEqual ::
    (MonadIO m, WebWindowFeaturesK a, WebWindowFeaturesK b) =>
    a ->                                    -- _obj
    b ->                                    -- features2
    m Bool
webWindowFeaturesEqual _obj features2 = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let features2' = unsafeManagedPtrCastPtr features2
    result <- webkit_web_window_features_equal _obj' features2'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr features2
    return result'