{-# 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.WebKit2.Structs.OptionMenuItem
    ( 

-- * Exported types
    OptionMenuItem(..)                      ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveOptionMenuItemMethod             ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    OptionMenuItemCopyMethodInfo            ,
#endif
    optionMenuItemCopy                      ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    OptionMenuItemFreeMethodInfo            ,
#endif
    optionMenuItemFree                      ,


-- ** getLabel #method:getLabel#

#if defined(ENABLE_OVERLOADING)
    OptionMenuItemGetLabelMethodInfo        ,
#endif
    optionMenuItemGetLabel                  ,


-- ** getTooltip #method:getTooltip#

#if defined(ENABLE_OVERLOADING)
    OptionMenuItemGetTooltipMethodInfo      ,
#endif
    optionMenuItemGetTooltip                ,


-- ** isEnabled #method:isEnabled#

#if defined(ENABLE_OVERLOADING)
    OptionMenuItemIsEnabledMethodInfo       ,
#endif
    optionMenuItemIsEnabled                 ,


-- ** isGroupChild #method:isGroupChild#

#if defined(ENABLE_OVERLOADING)
    OptionMenuItemIsGroupChildMethodInfo    ,
#endif
    optionMenuItemIsGroupChild              ,


-- ** isGroupLabel #method:isGroupLabel#

#if defined(ENABLE_OVERLOADING)
    OptionMenuItemIsGroupLabelMethodInfo    ,
#endif
    optionMenuItemIsGroupLabel              ,


-- ** isSelected #method:isSelected#

#if defined(ENABLE_OVERLOADING)
    OptionMenuItemIsSelectedMethodInfo      ,
#endif
    optionMenuItemIsSelected                ,




    ) 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.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 Control.Monad.IO.Class as MIO
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


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

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

foreign import ccall "webkit_option_menu_item_get_type" c_webkit_option_menu_item_get_type :: 
    IO GType

type instance O.ParentTypes OptionMenuItem = '[]
instance O.HasParentTypes OptionMenuItem

instance B.Types.TypedObject OptionMenuItem where
    glibType :: IO GType
glibType = IO GType
c_webkit_option_menu_item_get_type

instance B.Types.GBoxed OptionMenuItem

-- | Convert 'OptionMenuItem' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue OptionMenuItem where
    toGValue :: OptionMenuItem -> IO GValue
toGValue OptionMenuItem
o = do
        GType
gtype <- IO GType
c_webkit_option_menu_item_get_type
        OptionMenuItem -> (Ptr OptionMenuItem -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr OptionMenuItem
o (GType
-> (GValue -> Ptr OptionMenuItem -> IO ())
-> Ptr OptionMenuItem
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr OptionMenuItem -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO OptionMenuItem
fromGValue GValue
gv = do
        Ptr OptionMenuItem
ptr <- GValue -> IO (Ptr OptionMenuItem)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr OptionMenuItem)
        (ManagedPtr OptionMenuItem -> OptionMenuItem)
-> Ptr OptionMenuItem -> IO OptionMenuItem
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr OptionMenuItem -> OptionMenuItem
OptionMenuItem Ptr OptionMenuItem
ptr
        
    


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

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

foreign import ccall "webkit_option_menu_item_copy" webkit_option_menu_item_copy :: 
    Ptr OptionMenuItem ->                   -- item : TInterface (Name {namespace = "WebKit2", name = "OptionMenuItem"})
    IO (Ptr OptionMenuItem)

-- | Make a copy of the t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem'.
-- 
-- /Since: 2.18/
optionMenuItemCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OptionMenuItem
    -- ^ /@item@/: a t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem'
    -> m OptionMenuItem
    -- ^ __Returns:__ A copy of passed in t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem'
optionMenuItemCopy :: OptionMenuItem -> m OptionMenuItem
optionMenuItemCopy OptionMenuItem
item = IO OptionMenuItem -> m OptionMenuItem
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO OptionMenuItem -> m OptionMenuItem)
-> IO OptionMenuItem -> m OptionMenuItem
forall a b. (a -> b) -> a -> b
$ do
    Ptr OptionMenuItem
item' <- OptionMenuItem -> IO (Ptr OptionMenuItem)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OptionMenuItem
item
    Ptr OptionMenuItem
result <- Ptr OptionMenuItem -> IO (Ptr OptionMenuItem)
webkit_option_menu_item_copy Ptr OptionMenuItem
item'
    Text -> Ptr OptionMenuItem -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"optionMenuItemCopy" Ptr OptionMenuItem
result
    OptionMenuItem
result' <- ((ManagedPtr OptionMenuItem -> OptionMenuItem)
-> Ptr OptionMenuItem -> IO OptionMenuItem
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr OptionMenuItem -> OptionMenuItem
OptionMenuItem) Ptr OptionMenuItem
result
    OptionMenuItem -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OptionMenuItem
item
    OptionMenuItem -> IO OptionMenuItem
forall (m :: * -> *) a. Monad m => a -> m a
return OptionMenuItem
result'

#if defined(ENABLE_OVERLOADING)
data OptionMenuItemCopyMethodInfo
instance (signature ~ (m OptionMenuItem), MonadIO m) => O.MethodInfo OptionMenuItemCopyMethodInfo OptionMenuItem signature where
    overloadedMethod = optionMenuItemCopy

#endif

-- method OptionMenuItem::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "OptionMenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitOptionMenuItem"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_option_menu_item_free" webkit_option_menu_item_free :: 
    Ptr OptionMenuItem ->                   -- item : TInterface (Name {namespace = "WebKit2", name = "OptionMenuItem"})
    IO ()

-- | Free the t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem'.
-- 
-- /Since: 2.18/
optionMenuItemFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OptionMenuItem
    -- ^ /@item@/: A t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem'
    -> m ()
optionMenuItemFree :: OptionMenuItem -> m ()
optionMenuItemFree OptionMenuItem
item = 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 OptionMenuItem
item' <- OptionMenuItem -> IO (Ptr OptionMenuItem)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OptionMenuItem
item
    Ptr OptionMenuItem -> IO ()
webkit_option_menu_item_free Ptr OptionMenuItem
item'
    OptionMenuItem -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OptionMenuItem
item
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data OptionMenuItemFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo OptionMenuItemFreeMethodInfo OptionMenuItem signature where
    overloadedMethod = optionMenuItemFree

#endif

-- method OptionMenuItem::get_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "OptionMenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitOptionMenuItem"
--                 , 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_option_menu_item_get_label" webkit_option_menu_item_get_label :: 
    Ptr OptionMenuItem ->                   -- item : TInterface (Name {namespace = "WebKit2", name = "OptionMenuItem"})
    IO CString

-- | Get the label of a t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem'.
-- 
-- /Since: 2.18/
optionMenuItemGetLabel ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OptionMenuItem
    -- ^ /@item@/: a t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem'
    -> m T.Text
    -- ^ __Returns:__ The label of /@item@/.
optionMenuItemGetLabel :: OptionMenuItem -> m Text
optionMenuItemGetLabel OptionMenuItem
item = 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 OptionMenuItem
item' <- OptionMenuItem -> IO (Ptr OptionMenuItem)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OptionMenuItem
item
    CString
result <- Ptr OptionMenuItem -> IO CString
webkit_option_menu_item_get_label Ptr OptionMenuItem
item'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"optionMenuItemGetLabel" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    OptionMenuItem -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OptionMenuItem
item
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data OptionMenuItemGetLabelMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo OptionMenuItemGetLabelMethodInfo OptionMenuItem signature where
    overloadedMethod = optionMenuItemGetLabel

#endif

-- method OptionMenuItem::get_tooltip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "OptionMenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitOptionMenuItem"
--                 , 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_option_menu_item_get_tooltip" webkit_option_menu_item_get_tooltip :: 
    Ptr OptionMenuItem ->                   -- item : TInterface (Name {namespace = "WebKit2", name = "OptionMenuItem"})
    IO CString

-- | Get the tooltip of a t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem'.
-- 
-- /Since: 2.18/
optionMenuItemGetTooltip ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OptionMenuItem
    -- ^ /@item@/: a t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The tooltip of /@item@/, or 'P.Nothing'.
optionMenuItemGetTooltip :: OptionMenuItem -> m (Maybe Text)
optionMenuItemGetTooltip OptionMenuItem
item = 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
$ do
    Ptr OptionMenuItem
item' <- OptionMenuItem -> IO (Ptr OptionMenuItem)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OptionMenuItem
item
    CString
result <- Ptr OptionMenuItem -> IO CString
webkit_option_menu_item_get_tooltip Ptr OptionMenuItem
item'
    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 (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    OptionMenuItem -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OptionMenuItem
item
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data OptionMenuItemGetTooltipMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.MethodInfo OptionMenuItemGetTooltipMethodInfo OptionMenuItem signature where
    overloadedMethod = optionMenuItemGetTooltip

#endif

-- method OptionMenuItem::is_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "OptionMenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitOptionMenuItem"
--                 , 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_option_menu_item_is_enabled" webkit_option_menu_item_is_enabled :: 
    Ptr OptionMenuItem ->                   -- item : TInterface (Name {namespace = "WebKit2", name = "OptionMenuItem"})
    IO CInt

-- | Whether a t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem' is enabled.
-- 
-- /Since: 2.18/
optionMenuItemIsEnabled ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OptionMenuItem
    -- ^ /@item@/: a t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@item@/ is enabled or 'P.False' otherwise.
optionMenuItemIsEnabled :: OptionMenuItem -> m Bool
optionMenuItemIsEnabled OptionMenuItem
item = 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 OptionMenuItem
item' <- OptionMenuItem -> IO (Ptr OptionMenuItem)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OptionMenuItem
item
    CInt
result <- Ptr OptionMenuItem -> IO CInt
webkit_option_menu_item_is_enabled Ptr OptionMenuItem
item'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    OptionMenuItem -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OptionMenuItem
item
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data OptionMenuItemIsEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo OptionMenuItemIsEnabledMethodInfo OptionMenuItem signature where
    overloadedMethod = optionMenuItemIsEnabled

#endif

-- method OptionMenuItem::is_group_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "OptionMenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitOptionMenuItem"
--                 , 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_option_menu_item_is_group_child" webkit_option_menu_item_is_group_child :: 
    Ptr OptionMenuItem ->                   -- item : TInterface (Name {namespace = "WebKit2", name = "OptionMenuItem"})
    IO CInt

-- | Whether a t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem' is a group child.
-- 
-- /Since: 2.18/
optionMenuItemIsGroupChild ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OptionMenuItem
    -- ^ /@item@/: a t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@item@/ is a group child or 'P.False' otherwise.
optionMenuItemIsGroupChild :: OptionMenuItem -> m Bool
optionMenuItemIsGroupChild OptionMenuItem
item = 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 OptionMenuItem
item' <- OptionMenuItem -> IO (Ptr OptionMenuItem)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OptionMenuItem
item
    CInt
result <- Ptr OptionMenuItem -> IO CInt
webkit_option_menu_item_is_group_child Ptr OptionMenuItem
item'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    OptionMenuItem -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OptionMenuItem
item
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data OptionMenuItemIsGroupChildMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo OptionMenuItemIsGroupChildMethodInfo OptionMenuItem signature where
    overloadedMethod = optionMenuItemIsGroupChild

#endif

-- method OptionMenuItem::is_group_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "OptionMenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitOptionMenuItem"
--                 , 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_option_menu_item_is_group_label" webkit_option_menu_item_is_group_label :: 
    Ptr OptionMenuItem ->                   -- item : TInterface (Name {namespace = "WebKit2", name = "OptionMenuItem"})
    IO CInt

-- | Whether a t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem' is a group label.
-- 
-- /Since: 2.18/
optionMenuItemIsGroupLabel ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OptionMenuItem
    -- ^ /@item@/: a t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@item@/ is a group label or 'P.False' otherwise.
optionMenuItemIsGroupLabel :: OptionMenuItem -> m Bool
optionMenuItemIsGroupLabel OptionMenuItem
item = 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 OptionMenuItem
item' <- OptionMenuItem -> IO (Ptr OptionMenuItem)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OptionMenuItem
item
    CInt
result <- Ptr OptionMenuItem -> IO CInt
webkit_option_menu_item_is_group_label Ptr OptionMenuItem
item'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    OptionMenuItem -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OptionMenuItem
item
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data OptionMenuItemIsGroupLabelMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo OptionMenuItemIsGroupLabelMethodInfo OptionMenuItem signature where
    overloadedMethod = optionMenuItemIsGroupLabel

#endif

-- method OptionMenuItem::is_selected
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "OptionMenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitOptionMenuItem"
--                 , 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_option_menu_item_is_selected" webkit_option_menu_item_is_selected :: 
    Ptr OptionMenuItem ->                   -- item : TInterface (Name {namespace = "WebKit2", name = "OptionMenuItem"})
    IO CInt

-- | Whether a t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem' is the currently selected one.
-- 
-- /Since: 2.18/
optionMenuItemIsSelected ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    OptionMenuItem
    -- ^ /@item@/: a t'GI.WebKit2.Structs.OptionMenuItem.OptionMenuItem'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@item@/ is selected or 'P.False' otherwise.
optionMenuItemIsSelected :: OptionMenuItem -> m Bool
optionMenuItemIsSelected OptionMenuItem
item = 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 OptionMenuItem
item' <- OptionMenuItem -> IO (Ptr OptionMenuItem)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr OptionMenuItem
item
    CInt
result <- Ptr OptionMenuItem -> IO CInt
webkit_option_menu_item_is_selected Ptr OptionMenuItem
item'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    OptionMenuItem -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr OptionMenuItem
item
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data OptionMenuItemIsSelectedMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo OptionMenuItemIsSelectedMethodInfo OptionMenuItem signature where
    overloadedMethod = optionMenuItemIsSelected

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveOptionMenuItemMethod (t :: Symbol) (o :: *) :: * where
    ResolveOptionMenuItemMethod "copy" o = OptionMenuItemCopyMethodInfo
    ResolveOptionMenuItemMethod "free" o = OptionMenuItemFreeMethodInfo
    ResolveOptionMenuItemMethod "isEnabled" o = OptionMenuItemIsEnabledMethodInfo
    ResolveOptionMenuItemMethod "isGroupChild" o = OptionMenuItemIsGroupChildMethodInfo
    ResolveOptionMenuItemMethod "isGroupLabel" o = OptionMenuItemIsGroupLabelMethodInfo
    ResolveOptionMenuItemMethod "isSelected" o = OptionMenuItemIsSelectedMethodInfo
    ResolveOptionMenuItemMethod "getLabel" o = OptionMenuItemGetLabelMethodInfo
    ResolveOptionMenuItemMethod "getTooltip" o = OptionMenuItemGetTooltipMethodInfo
    ResolveOptionMenuItemMethod l o = O.MethodResolutionFailed l o

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

#endif