{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- IBusExtensionEvent properties.

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

module GI.IBus.Objects.ExtensionEvent
    ( 

-- * Exported types
    ExtensionEvent(..)                      ,
    IsExtensionEvent                        ,
    toExtensionEvent                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [copy]("GI.IBus.Objects.Serializable#g:method:copy"), [destroy]("GI.IBus.Objects.Object#g:method:destroy"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isEnabled]("GI.IBus.Objects.ExtensionEvent#g:method:isEnabled"), [isExtension]("GI.IBus.Objects.ExtensionEvent#g:method:isExtension"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeQattachment]("GI.IBus.Objects.Serializable#g:method:removeQattachment"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [serializeObject]("GI.IBus.Objects.Serializable#g:method:serializeObject"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getName]("GI.IBus.Objects.ExtensionEvent#g:method:getName"), [getParams]("GI.IBus.Objects.ExtensionEvent#g:method:getParams"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQattachment]("GI.IBus.Objects.Serializable#g:method:getQattachment"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getVersion]("GI.IBus.Objects.ExtensionEvent#g:method:getVersion").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setQattachment]("GI.IBus.Objects.Serializable#g:method:setQattachment").

#if defined(ENABLE_OVERLOADING)
    ResolveExtensionEventMethod             ,
#endif

-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    ExtensionEventGetNameMethodInfo         ,
#endif
    extensionEventGetName                   ,


-- ** getParams #method:getParams#

#if defined(ENABLE_OVERLOADING)
    ExtensionEventGetParamsMethodInfo       ,
#endif
    extensionEventGetParams                 ,


-- ** getVersion #method:getVersion#

#if defined(ENABLE_OVERLOADING)
    ExtensionEventGetVersionMethodInfo      ,
#endif
    extensionEventGetVersion                ,


-- ** isEnabled #method:isEnabled#

#if defined(ENABLE_OVERLOADING)
    ExtensionEventIsEnabledMethodInfo       ,
#endif
    extensionEventIsEnabled                 ,


-- ** isExtension #method:isExtension#

#if defined(ENABLE_OVERLOADING)
    ExtensionEventIsExtensionMethodInfo     ,
#endif
    extensionEventIsExtension               ,




 -- * Properties


-- ** isEnabled #attr:isEnabled#
-- | 'P.True' if the extension is enabled in the t'GI.IBus.Objects.ExtensionEvent.ExtensionEvent'.

#if defined(ENABLE_OVERLOADING)
    ExtensionEventIsEnabledPropertyInfo     ,
#endif
    constructExtensionEventIsEnabled        ,
    getExtensionEventIsEnabled              ,


-- ** isExtension #attr:isExtension#
-- | 'P.True' if the t'GI.IBus.Objects.ExtensionEvent.ExtensionEvent' is called by an extension.
-- 'P.False' if the t'GI.IBus.Objects.ExtensionEvent.ExtensionEvent' is called by an active engine or
-- panel.
-- If this value is 'P.True', the event is send to ibus-daemon, an active
-- engine. If it\'s 'P.False', the event is sned to ibus-daemon, panels.

#if defined(ENABLE_OVERLOADING)
    ExtensionEventIsExtensionPropertyInfo   ,
#endif
    constructExtensionEventIsExtension      ,
    getExtensionEventIsExtension            ,


-- ** name #attr:name#
-- | Name of the extension in the t'GI.IBus.Objects.ExtensionEvent.ExtensionEvent'.

#if defined(ENABLE_OVERLOADING)
    ExtensionEventNamePropertyInfo          ,
#endif
    constructExtensionEventName             ,
#if defined(ENABLE_OVERLOADING)
    extensionEventName                      ,
#endif
    getExtensionEventName                   ,


-- ** params #attr:params#
-- | Parameters to enable the extension in the t'GI.IBus.Objects.ExtensionEvent.ExtensionEvent'.

#if defined(ENABLE_OVERLOADING)
    ExtensionEventParamsPropertyInfo        ,
#endif
    constructExtensionEventParams           ,
#if defined(ENABLE_OVERLOADING)
    extensionEventParams                    ,
#endif
    getExtensionEventParams                 ,


-- ** version #attr:version#
-- | Version of the t'GI.IBus.Objects.ExtensionEvent.ExtensionEvent'.

#if defined(ENABLE_OVERLOADING)
    ExtensionEventVersionPropertyInfo       ,
#endif
#if defined(ENABLE_OVERLOADING)
    extensionEventVersion                   ,
#endif
    getExtensionEventVersion                ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Object as IBus.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Serializable as IBus.Serializable

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

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

foreign import ccall "ibus_extension_event_get_type"
    c_ibus_extension_event_get_type :: IO B.Types.GType

instance B.Types.TypedObject ExtensionEvent where
    glibType :: IO GType
glibType = IO GType
c_ibus_extension_event_get_type

instance B.Types.GObject ExtensionEvent

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

instance O.HasParentTypes ExtensionEvent
type instance O.ParentTypes ExtensionEvent = '[IBus.Serializable.Serializable, IBus.Object.Object, GObject.Object.Object]

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

-- | Convert 'ExtensionEvent' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe ExtensionEvent) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ibus_extension_event_get_type
    gvalueSet_ :: Ptr GValue -> Maybe ExtensionEvent -> IO ()
gvalueSet_ Ptr GValue
gv Maybe ExtensionEvent
P.Nothing = Ptr GValue -> Ptr ExtensionEvent -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr ExtensionEvent
forall a. Ptr a
FP.nullPtr :: FP.Ptr ExtensionEvent)
    gvalueSet_ Ptr GValue
gv (P.Just ExtensionEvent
obj) = ExtensionEvent -> (Ptr ExtensionEvent -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ExtensionEvent
obj (Ptr GValue -> Ptr ExtensionEvent -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe ExtensionEvent)
gvalueGet_ Ptr GValue
gv = do
        Ptr ExtensionEvent
ptr <- Ptr GValue -> IO (Ptr ExtensionEvent)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr ExtensionEvent)
        if Ptr ExtensionEvent
ptr Ptr ExtensionEvent -> Ptr ExtensionEvent -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ExtensionEvent
forall a. Ptr a
FP.nullPtr
        then ExtensionEvent -> Maybe ExtensionEvent
forall a. a -> Maybe a
P.Just (ExtensionEvent -> Maybe ExtensionEvent)
-> IO ExtensionEvent -> IO (Maybe ExtensionEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr ExtensionEvent -> ExtensionEvent)
-> Ptr ExtensionEvent -> IO ExtensionEvent
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr ExtensionEvent -> ExtensionEvent
ExtensionEvent Ptr ExtensionEvent
ptr
        else Maybe ExtensionEvent -> IO (Maybe ExtensionEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExtensionEvent
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveExtensionEventMethod (t :: Symbol) (o :: *) :: * where
    ResolveExtensionEventMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveExtensionEventMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveExtensionEventMethod "copy" o = IBus.Serializable.SerializableCopyMethodInfo
    ResolveExtensionEventMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    ResolveExtensionEventMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveExtensionEventMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveExtensionEventMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveExtensionEventMethod "isEnabled" o = ExtensionEventIsEnabledMethodInfo
    ResolveExtensionEventMethod "isExtension" o = ExtensionEventIsExtensionMethodInfo
    ResolveExtensionEventMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveExtensionEventMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveExtensionEventMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveExtensionEventMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveExtensionEventMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveExtensionEventMethod "removeQattachment" o = IBus.Serializable.SerializableRemoveQattachmentMethodInfo
    ResolveExtensionEventMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveExtensionEventMethod "serializeObject" o = IBus.Serializable.SerializableSerializeObjectMethodInfo
    ResolveExtensionEventMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveExtensionEventMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveExtensionEventMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveExtensionEventMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveExtensionEventMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveExtensionEventMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveExtensionEventMethod "getName" o = ExtensionEventGetNameMethodInfo
    ResolveExtensionEventMethod "getParams" o = ExtensionEventGetParamsMethodInfo
    ResolveExtensionEventMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveExtensionEventMethod "getQattachment" o = IBus.Serializable.SerializableGetQattachmentMethodInfo
    ResolveExtensionEventMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveExtensionEventMethod "getVersion" o = ExtensionEventGetVersionMethodInfo
    ResolveExtensionEventMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveExtensionEventMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveExtensionEventMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveExtensionEventMethod "setQattachment" o = IBus.Serializable.SerializableSetQattachmentMethodInfo
    ResolveExtensionEventMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveExtensionEventMethod t ExtensionEvent, O.OverloadedMethod info ExtensionEvent p, R.HasField t ExtensionEvent p) => R.HasField t ExtensionEvent p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- VVV Prop "is-enabled"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@is-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' extensionEvent #isEnabled
-- @
getExtensionEventIsEnabled :: (MonadIO m, IsExtensionEvent o) => o -> m Bool
getExtensionEventIsEnabled :: forall (m :: * -> *) o.
(MonadIO m, IsExtensionEvent o) =>
o -> m Bool
getExtensionEventIsEnabled o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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 String
"is-enabled"

-- | Construct a `GValueConstruct` with valid value for the “@is-enabled@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructExtensionEventIsEnabled :: (IsExtensionEvent o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructExtensionEventIsEnabled :: forall o (m :: * -> *).
(IsExtensionEvent o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructExtensionEventIsEnabled Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"is-enabled" Bool
val

#if defined(ENABLE_OVERLOADING)
data ExtensionEventIsEnabledPropertyInfo
instance AttrInfo ExtensionEventIsEnabledPropertyInfo where
    type AttrAllowedOps ExtensionEventIsEnabledPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ExtensionEventIsEnabledPropertyInfo = IsExtensionEvent
    type AttrSetTypeConstraint ExtensionEventIsEnabledPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ExtensionEventIsEnabledPropertyInfo = (~) Bool
    type AttrTransferType ExtensionEventIsEnabledPropertyInfo = Bool
    type AttrGetType ExtensionEventIsEnabledPropertyInfo = Bool
    type AttrLabel ExtensionEventIsEnabledPropertyInfo = "is-enabled"
    type AttrOrigin ExtensionEventIsEnabledPropertyInfo = ExtensionEvent
    attrGet = getExtensionEventIsEnabled
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructExtensionEventIsEnabled
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.ExtensionEvent.isEnabled"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.4/docs/GI-IBus-Objects-ExtensionEvent.html#g:attr:isEnabled"
        })
#endif

-- VVV Prop "is-extension"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@is-extension@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' extensionEvent #isExtension
-- @
getExtensionEventIsExtension :: (MonadIO m, IsExtensionEvent o) => o -> m Bool
getExtensionEventIsExtension :: forall (m :: * -> *) o.
(MonadIO m, IsExtensionEvent o) =>
o -> m Bool
getExtensionEventIsExtension o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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 String
"is-extension"

-- | Construct a `GValueConstruct` with valid value for the “@is-extension@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructExtensionEventIsExtension :: (IsExtensionEvent o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructExtensionEventIsExtension :: forall o (m :: * -> *).
(IsExtensionEvent o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructExtensionEventIsExtension Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"is-extension" Bool
val

#if defined(ENABLE_OVERLOADING)
data ExtensionEventIsExtensionPropertyInfo
instance AttrInfo ExtensionEventIsExtensionPropertyInfo where
    type AttrAllowedOps ExtensionEventIsExtensionPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ExtensionEventIsExtensionPropertyInfo = IsExtensionEvent
    type AttrSetTypeConstraint ExtensionEventIsExtensionPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ExtensionEventIsExtensionPropertyInfo = (~) Bool
    type AttrTransferType ExtensionEventIsExtensionPropertyInfo = Bool
    type AttrGetType ExtensionEventIsExtensionPropertyInfo = Bool
    type AttrLabel ExtensionEventIsExtensionPropertyInfo = "is-extension"
    type AttrOrigin ExtensionEventIsExtensionPropertyInfo = ExtensionEvent
    attrGet = getExtensionEventIsExtension
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructExtensionEventIsExtension
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.ExtensionEvent.isExtension"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.4/docs/GI-IBus-Objects-ExtensionEvent.html#g:attr:isExtension"
        })
#endif

-- VVV Prop "name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructExtensionEventName :: (IsExtensionEvent o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructExtensionEventName :: forall o (m :: * -> *).
(IsExtensionEvent o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructExtensionEventName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data ExtensionEventNamePropertyInfo
instance AttrInfo ExtensionEventNamePropertyInfo where
    type AttrAllowedOps ExtensionEventNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ExtensionEventNamePropertyInfo = IsExtensionEvent
    type AttrSetTypeConstraint ExtensionEventNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ExtensionEventNamePropertyInfo = (~) T.Text
    type AttrTransferType ExtensionEventNamePropertyInfo = T.Text
    type AttrGetType ExtensionEventNamePropertyInfo = T.Text
    type AttrLabel ExtensionEventNamePropertyInfo = "name"
    type AttrOrigin ExtensionEventNamePropertyInfo = ExtensionEvent
    attrGet = getExtensionEventName
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructExtensionEventName
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.ExtensionEvent.name"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.4/docs/GI-IBus-Objects-ExtensionEvent.html#g:attr:name"
        })
#endif

-- VVV Prop "params"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@params@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructExtensionEventParams :: (IsExtensionEvent o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructExtensionEventParams :: forall o (m :: * -> *).
(IsExtensionEvent o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructExtensionEventParams Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"params" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data ExtensionEventParamsPropertyInfo
instance AttrInfo ExtensionEventParamsPropertyInfo where
    type AttrAllowedOps ExtensionEventParamsPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ExtensionEventParamsPropertyInfo = IsExtensionEvent
    type AttrSetTypeConstraint ExtensionEventParamsPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ExtensionEventParamsPropertyInfo = (~) T.Text
    type AttrTransferType ExtensionEventParamsPropertyInfo = T.Text
    type AttrGetType ExtensionEventParamsPropertyInfo = T.Text
    type AttrLabel ExtensionEventParamsPropertyInfo = "params"
    type AttrOrigin ExtensionEventParamsPropertyInfo = ExtensionEvent
    attrGet = getExtensionEventParams
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructExtensionEventParams
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.ExtensionEvent.params"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.4/docs/GI-IBus-Objects-ExtensionEvent.html#g:attr:params"
        })
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data ExtensionEventVersionPropertyInfo
instance AttrInfo ExtensionEventVersionPropertyInfo where
    type AttrAllowedOps ExtensionEventVersionPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ExtensionEventVersionPropertyInfo = IsExtensionEvent
    type AttrSetTypeConstraint ExtensionEventVersionPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ExtensionEventVersionPropertyInfo = (~) ()
    type AttrTransferType ExtensionEventVersionPropertyInfo = ()
    type AttrGetType ExtensionEventVersionPropertyInfo = Word32
    type AttrLabel ExtensionEventVersionPropertyInfo = "version"
    type AttrOrigin ExtensionEventVersionPropertyInfo = ExtensionEvent
    attrGet = getExtensionEventVersion
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.ExtensionEvent.version"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.4/docs/GI-IBus-Objects-ExtensionEvent.html#g:attr:version"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ExtensionEvent
type instance O.AttributeList ExtensionEvent = ExtensionEventAttributeList
type ExtensionEventAttributeList = ('[ '("isEnabled", ExtensionEventIsEnabledPropertyInfo), '("isExtension", ExtensionEventIsExtensionPropertyInfo), '("name", ExtensionEventNamePropertyInfo), '("params", ExtensionEventParamsPropertyInfo), '("version", ExtensionEventVersionPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
extensionEventName :: AttrLabelProxy "name"
extensionEventName = AttrLabelProxy

extensionEventParams :: AttrLabelProxy "params"
extensionEventParams = AttrLabelProxy

extensionEventVersion :: AttrLabelProxy "version"
extensionEventVersion = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ExtensionEvent = ExtensionEventSignalList
type ExtensionEventSignalList = ('[ '("destroy", IBus.Object.ObjectDestroySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method ExtensionEvent::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "ExtensionEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "ibus_extension_event_get_name" ibus_extension_event_get_name :: 
    Ptr ExtensionEvent ->                   -- event : TInterface (Name {namespace = "IBus", name = "ExtensionEvent"})
    IO CString

-- | /No description available in the introspection data./
extensionEventGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsExtensionEvent a) =>
    a
    -> m T.Text
extensionEventGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsExtensionEvent a) =>
a -> m Text
extensionEventGetName a
event = 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 ExtensionEvent
event' <- a -> IO (Ptr ExtensionEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CString
result <- Ptr ExtensionEvent -> IO CString
ibus_extension_event_get_name Ptr ExtensionEvent
event'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"extensionEventGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ExtensionEventGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsExtensionEvent a) => O.OverloadedMethod ExtensionEventGetNameMethodInfo a signature where
    overloadedMethod = extensionEventGetName

instance O.OverloadedMethodInfo ExtensionEventGetNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.ExtensionEvent.extensionEventGetName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.4/docs/GI-IBus-Objects-ExtensionEvent.html#v:extensionEventGetName"
        })


#endif

-- method ExtensionEvent::get_params
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "ExtensionEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusExtensionEvent."
--                 , 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 "ibus_extension_event_get_params" ibus_extension_event_get_params :: 
    Ptr ExtensionEvent ->                   -- event : TInterface (Name {namespace = "IBus", name = "ExtensionEvent"})
    IO CString

-- | /No description available in the introspection data./
extensionEventGetParams ::
    (B.CallStack.HasCallStack, MonadIO m, IsExtensionEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.ExtensionEvent.ExtensionEvent'.
    -> m T.Text
    -- ^ __Returns:__ Parameters to enable the extension for t'GI.IBus.Objects.XEvent.XEvent'
extensionEventGetParams :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsExtensionEvent a) =>
a -> m Text
extensionEventGetParams a
event = 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 ExtensionEvent
event' <- a -> IO (Ptr ExtensionEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CString
result <- Ptr ExtensionEvent -> IO CString
ibus_extension_event_get_params Ptr ExtensionEvent
event'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"extensionEventGetParams" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ExtensionEventGetParamsMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsExtensionEvent a) => O.OverloadedMethod ExtensionEventGetParamsMethodInfo a signature where
    overloadedMethod = extensionEventGetParams

instance O.OverloadedMethodInfo ExtensionEventGetParamsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.ExtensionEvent.extensionEventGetParams",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.4/docs/GI-IBus-Objects-ExtensionEvent.html#v:extensionEventGetParams"
        })


#endif

-- method ExtensionEvent::get_version
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "ExtensionEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusExtensionEvent."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_extension_event_get_version" ibus_extension_event_get_version :: 
    Ptr ExtensionEvent ->                   -- event : TInterface (Name {namespace = "IBus", name = "ExtensionEvent"})
    IO Word32

-- | /No description available in the introspection data./
extensionEventGetVersion ::
    (B.CallStack.HasCallStack, MonadIO m, IsExtensionEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.ExtensionEvent.ExtensionEvent'.
    -> m Word32
    -- ^ __Returns:__ Version of t'GI.IBus.Objects.ExtensionEvent.ExtensionEvent'
extensionEventGetVersion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsExtensionEvent a) =>
a -> m Word32
extensionEventGetVersion a
event = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr ExtensionEvent
event' <- a -> IO (Ptr ExtensionEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Word32
result <- Ptr ExtensionEvent -> IO Word32
ibus_extension_event_get_version Ptr ExtensionEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ExtensionEventGetVersionMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsExtensionEvent a) => O.OverloadedMethod ExtensionEventGetVersionMethodInfo a signature where
    overloadedMethod = extensionEventGetVersion

instance O.OverloadedMethodInfo ExtensionEventGetVersionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.ExtensionEvent.extensionEventGetVersion",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.4/docs/GI-IBus-Objects-ExtensionEvent.html#v:extensionEventGetVersion"
        })


#endif

-- method ExtensionEvent::is_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "ExtensionEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusExtensionEvent."
--                 , 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 "ibus_extension_event_is_enabled" ibus_extension_event_is_enabled :: 
    Ptr ExtensionEvent ->                   -- event : TInterface (Name {namespace = "IBus", name = "ExtensionEvent"})
    IO CInt

-- | /No description available in the introspection data./
extensionEventIsEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsExtensionEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.ExtensionEvent.ExtensionEvent'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the extension is enabled for t'GI.IBus.Objects.ExtensionEvent.ExtensionEvent'
extensionEventIsEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsExtensionEvent a) =>
a -> m Bool
extensionEventIsEnabled a
event = 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 ExtensionEvent
event' <- a -> IO (Ptr ExtensionEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CInt
result <- Ptr ExtensionEvent -> IO CInt
ibus_extension_event_is_enabled Ptr ExtensionEvent
event'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ExtensionEventIsEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsExtensionEvent a) => O.OverloadedMethod ExtensionEventIsEnabledMethodInfo a signature where
    overloadedMethod = extensionEventIsEnabled

instance O.OverloadedMethodInfo ExtensionEventIsEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.ExtensionEvent.extensionEventIsEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.4/docs/GI-IBus-Objects-ExtensionEvent.html#v:extensionEventIsEnabled"
        })


#endif

-- method ExtensionEvent::is_extension
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "ExtensionEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusExtensionEvent."
--                 , 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 "ibus_extension_event_is_extension" ibus_extension_event_is_extension :: 
    Ptr ExtensionEvent ->                   -- event : TInterface (Name {namespace = "IBus", name = "ExtensionEvent"})
    IO CInt

-- | /No description available in the introspection data./
extensionEventIsExtension ::
    (B.CallStack.HasCallStack, MonadIO m, IsExtensionEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.ExtensionEvent.ExtensionEvent'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the t'GI.IBus.Objects.ExtensionEvent.ExtensionEvent' is called by an extension.
    -- 'P.False' if the t'GI.IBus.Objects.ExtensionEvent.ExtensionEvent' is called by an active engine or
    -- panel.
    -- If this value is 'P.True', the event is send to ibus-daemon, an active
    -- engine. If it\'s 'P.False', the event is sned to ibus-daemon, panels.
extensionEventIsExtension :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsExtensionEvent a) =>
a -> m Bool
extensionEventIsExtension a
event = 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 ExtensionEvent
event' <- a -> IO (Ptr ExtensionEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CInt
result <- Ptr ExtensionEvent -> IO CInt
ibus_extension_event_is_extension Ptr ExtensionEvent
event'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ExtensionEventIsExtensionMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsExtensionEvent a) => O.OverloadedMethod ExtensionEventIsExtensionMethodInfo a signature where
    overloadedMethod = extensionEventIsExtension

instance O.OverloadedMethodInfo ExtensionEventIsExtensionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.ExtensionEvent.extensionEventIsExtension",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.4/docs/GI-IBus-Objects-ExtensionEvent.html#v:extensionEventIsExtension"
        })


#endif