{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An IBusProperty is an UI component like a button or a menu item
-- which shows the status of corresponding input method engine property.
-- End user can operate and see the current status of IME through these components.
-- For example, ibus-chewing users change the English\/Chinese input mode by
-- pressing ctrl-space or click on the Eng\/Chi switch button.
-- And the IBusProperty shows the change correspondingly.
-- 
-- see_also: t'GI.IBus.Objects.PropList.PropList', t'GI.IBus.Objects.Engine.Engine'

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

module GI.IBus.Objects.Property
    ( 

-- * Exported types
    Property(..)                            ,
    IsProperty                              ,
    toProperty                              ,


 -- * 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"), [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"), [update]("GI.IBus.Objects.Property#g:method:update"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getIcon]("GI.IBus.Objects.Property#g:method:getIcon"), [getKey]("GI.IBus.Objects.Property#g:method:getKey"), [getLabel]("GI.IBus.Objects.Property#g:method:getLabel"), [getPropType]("GI.IBus.Objects.Property#g:method:getPropType"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQattachment]("GI.IBus.Objects.Serializable#g:method:getQattachment"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSensitive]("GI.IBus.Objects.Property#g:method:getSensitive"), [getState]("GI.IBus.Objects.Property#g:method:getState"), [getSubProps]("GI.IBus.Objects.Property#g:method:getSubProps"), [getSymbol]("GI.IBus.Objects.Property#g:method:getSymbol"), [getTooltip]("GI.IBus.Objects.Property#g:method:getTooltip"), [getVisible]("GI.IBus.Objects.Property#g:method:getVisible").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setIcon]("GI.IBus.Objects.Property#g:method:setIcon"), [setLabel]("GI.IBus.Objects.Property#g:method:setLabel"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setQattachment]("GI.IBus.Objects.Serializable#g:method:setQattachment"), [setSensitive]("GI.IBus.Objects.Property#g:method:setSensitive"), [setState]("GI.IBus.Objects.Property#g:method:setState"), [setSubProps]("GI.IBus.Objects.Property#g:method:setSubProps"), [setSymbol]("GI.IBus.Objects.Property#g:method:setSymbol"), [setTooltip]("GI.IBus.Objects.Property#g:method:setTooltip"), [setVisible]("GI.IBus.Objects.Property#g:method:setVisible").

#if defined(ENABLE_OVERLOADING)
    ResolvePropertyMethod                   ,
#endif

-- ** getIcon #method:getIcon#

#if defined(ENABLE_OVERLOADING)
    PropertyGetIconMethodInfo               ,
#endif
    propertyGetIcon                         ,


-- ** getKey #method:getKey#

#if defined(ENABLE_OVERLOADING)
    PropertyGetKeyMethodInfo                ,
#endif
    propertyGetKey                          ,


-- ** getLabel #method:getLabel#

#if defined(ENABLE_OVERLOADING)
    PropertyGetLabelMethodInfo              ,
#endif
    propertyGetLabel                        ,


-- ** getPropType #method:getPropType#

#if defined(ENABLE_OVERLOADING)
    PropertyGetPropTypeMethodInfo           ,
#endif
    propertyGetPropType                     ,


-- ** getSensitive #method:getSensitive#

#if defined(ENABLE_OVERLOADING)
    PropertyGetSensitiveMethodInfo          ,
#endif
    propertyGetSensitive                    ,


-- ** getState #method:getState#

#if defined(ENABLE_OVERLOADING)
    PropertyGetStateMethodInfo              ,
#endif
    propertyGetState                        ,


-- ** getSubProps #method:getSubProps#

#if defined(ENABLE_OVERLOADING)
    PropertyGetSubPropsMethodInfo           ,
#endif
    propertyGetSubProps                     ,


-- ** getSymbol #method:getSymbol#

#if defined(ENABLE_OVERLOADING)
    PropertyGetSymbolMethodInfo             ,
#endif
    propertyGetSymbol                       ,


-- ** getTooltip #method:getTooltip#

#if defined(ENABLE_OVERLOADING)
    PropertyGetTooltipMethodInfo            ,
#endif
    propertyGetTooltip                      ,


-- ** getVisible #method:getVisible#

#if defined(ENABLE_OVERLOADING)
    PropertyGetVisibleMethodInfo            ,
#endif
    propertyGetVisible                      ,


-- ** new #method:new#

    propertyNew                             ,


-- ** setIcon #method:setIcon#

#if defined(ENABLE_OVERLOADING)
    PropertySetIconMethodInfo               ,
#endif
    propertySetIcon                         ,


-- ** setLabel #method:setLabel#

#if defined(ENABLE_OVERLOADING)
    PropertySetLabelMethodInfo              ,
#endif
    propertySetLabel                        ,


-- ** setSensitive #method:setSensitive#

#if defined(ENABLE_OVERLOADING)
    PropertySetSensitiveMethodInfo          ,
#endif
    propertySetSensitive                    ,


-- ** setState #method:setState#

#if defined(ENABLE_OVERLOADING)
    PropertySetStateMethodInfo              ,
#endif
    propertySetState                        ,


-- ** setSubProps #method:setSubProps#

#if defined(ENABLE_OVERLOADING)
    PropertySetSubPropsMethodInfo           ,
#endif
    propertySetSubProps                     ,


-- ** setSymbol #method:setSymbol#

#if defined(ENABLE_OVERLOADING)
    PropertySetSymbolMethodInfo             ,
#endif
    propertySetSymbol                       ,


-- ** setTooltip #method:setTooltip#

#if defined(ENABLE_OVERLOADING)
    PropertySetTooltipMethodInfo            ,
#endif
    propertySetTooltip                      ,


-- ** setVisible #method:setVisible#

#if defined(ENABLE_OVERLOADING)
    PropertySetVisibleMethodInfo            ,
#endif
    propertySetVisible                      ,


-- ** update #method:update#

#if defined(ENABLE_OVERLOADING)
    PropertyUpdateMethodInfo                ,
#endif
    propertyUpdate                          ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    PropertyIconPropertyInfo                ,
#endif
    constructPropertyIcon                   ,
    getPropertyIcon                         ,
#if defined(ENABLE_OVERLOADING)
    propertyIcon                            ,
#endif
    setPropertyIcon                         ,


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

#if defined(ENABLE_OVERLOADING)
    PropertyKeyPropertyInfo                 ,
#endif
    constructPropertyKey                    ,
    getPropertyKey                          ,
#if defined(ENABLE_OVERLOADING)
    propertyKey                             ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    PropertyLabelPropertyInfo               ,
#endif
    constructPropertyLabel                  ,
    getPropertyLabel                        ,
#if defined(ENABLE_OVERLOADING)
    propertyLabel                           ,
#endif
    setPropertyLabel                        ,


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

#if defined(ENABLE_OVERLOADING)
    PropertyPropTypePropertyInfo            ,
#endif
    constructPropertyPropType               ,
    getPropertyPropType                     ,
#if defined(ENABLE_OVERLOADING)
    propertyPropType                        ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    PropertySensitivePropertyInfo           ,
#endif
    constructPropertySensitive              ,
    getPropertySensitive                    ,
#if defined(ENABLE_OVERLOADING)
    propertySensitive                       ,
#endif
    setPropertySensitive                    ,


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

#if defined(ENABLE_OVERLOADING)
    PropertyStatePropertyInfo               ,
#endif
    constructPropertyState                  ,
    getPropertyState                        ,
#if defined(ENABLE_OVERLOADING)
    propertyState                           ,
#endif
    setPropertyState                        ,


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

#if defined(ENABLE_OVERLOADING)
    PropertySubPropsPropertyInfo            ,
#endif
    constructPropertySubProps               ,
    getPropertySubProps                     ,
#if defined(ENABLE_OVERLOADING)
    propertySubProps                        ,
#endif
    setPropertySubProps                     ,


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

#if defined(ENABLE_OVERLOADING)
    PropertySymbolPropertyInfo              ,
#endif
    constructPropertySymbol                 ,
    getPropertySymbol                       ,
#if defined(ENABLE_OVERLOADING)
    propertySymbol                          ,
#endif
    setPropertySymbol                       ,


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

#if defined(ENABLE_OVERLOADING)
    PropertyTooltipPropertyInfo             ,
#endif
    constructPropertyTooltip                ,
    getPropertyTooltip                      ,
#if defined(ENABLE_OVERLOADING)
    propertyTooltip                         ,
#endif
    setPropertyTooltip                      ,


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

#if defined(ENABLE_OVERLOADING)
    PropertyVisiblePropertyInfo             ,
#endif
    constructPropertyVisible                ,
    getPropertyVisible                      ,
#if defined(ENABLE_OVERLOADING)
    propertyVisible                         ,
#endif
    setPropertyVisible                      ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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.Enums as IBus.Enums
import {-# SOURCE #-} qualified GI.IBus.Objects.Object as IBus.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.PropList as IBus.PropList
import {-# SOURCE #-} qualified GI.IBus.Objects.Serializable as IBus.Serializable
import {-# SOURCE #-} qualified GI.IBus.Objects.Text as IBus.Text

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

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

foreign import ccall "ibus_property_get_type"
    c_ibus_property_get_type :: IO B.Types.GType

instance B.Types.TypedObject Property where
    glibType :: IO GType
glibType = IO GType
c_ibus_property_get_type

instance B.Types.GObject Property

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolvePropertyMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePropertyMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePropertyMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePropertyMethod "copy" o = IBus.Serializable.SerializableCopyMethodInfo
    ResolvePropertyMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    ResolvePropertyMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePropertyMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePropertyMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePropertyMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePropertyMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePropertyMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePropertyMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePropertyMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePropertyMethod "removeQattachment" o = IBus.Serializable.SerializableRemoveQattachmentMethodInfo
    ResolvePropertyMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePropertyMethod "serializeObject" o = IBus.Serializable.SerializableSerializeObjectMethodInfo
    ResolvePropertyMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePropertyMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePropertyMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePropertyMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePropertyMethod "update" o = PropertyUpdateMethodInfo
    ResolvePropertyMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePropertyMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePropertyMethod "getIcon" o = PropertyGetIconMethodInfo
    ResolvePropertyMethod "getKey" o = PropertyGetKeyMethodInfo
    ResolvePropertyMethod "getLabel" o = PropertyGetLabelMethodInfo
    ResolvePropertyMethod "getPropType" o = PropertyGetPropTypeMethodInfo
    ResolvePropertyMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePropertyMethod "getQattachment" o = IBus.Serializable.SerializableGetQattachmentMethodInfo
    ResolvePropertyMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePropertyMethod "getSensitive" o = PropertyGetSensitiveMethodInfo
    ResolvePropertyMethod "getState" o = PropertyGetStateMethodInfo
    ResolvePropertyMethod "getSubProps" o = PropertyGetSubPropsMethodInfo
    ResolvePropertyMethod "getSymbol" o = PropertyGetSymbolMethodInfo
    ResolvePropertyMethod "getTooltip" o = PropertyGetTooltipMethodInfo
    ResolvePropertyMethod "getVisible" o = PropertyGetVisibleMethodInfo
    ResolvePropertyMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePropertyMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePropertyMethod "setIcon" o = PropertySetIconMethodInfo
    ResolvePropertyMethod "setLabel" o = PropertySetLabelMethodInfo
    ResolvePropertyMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePropertyMethod "setQattachment" o = IBus.Serializable.SerializableSetQattachmentMethodInfo
    ResolvePropertyMethod "setSensitive" o = PropertySetSensitiveMethodInfo
    ResolvePropertyMethod "setState" o = PropertySetStateMethodInfo
    ResolvePropertyMethod "setSubProps" o = PropertySetSubPropsMethodInfo
    ResolvePropertyMethod "setSymbol" o = PropertySetSymbolMethodInfo
    ResolvePropertyMethod "setTooltip" o = PropertySetTooltipMethodInfo
    ResolvePropertyMethod "setVisible" o = PropertySetVisibleMethodInfo
    ResolvePropertyMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

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

-- | Set the value of the “@icon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' property [ #icon 'Data.GI.Base.Attributes.:=' value ]
-- @
setPropertyIcon :: (MonadIO m, IsProperty o) => o -> T.Text -> m ()
setPropertyIcon :: forall (m :: * -> *) o.
(MonadIO m, IsProperty o) =>
o -> Text -> m ()
setPropertyIcon o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"icon" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@icon@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPropertyIcon :: (IsProperty o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructPropertyIcon :: forall o (m :: * -> *).
(IsProperty o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructPropertyIcon Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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
"icon" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@key@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPropertyKey :: (IsProperty o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructPropertyKey :: forall o (m :: * -> *).
(IsProperty o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructPropertyKey Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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
"key" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

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

-- VVV Prop "label"
   -- Type: TInterface (Name {namespace = "IBus", name = "Text"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@label@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' property #label
-- @
getPropertyLabel :: (MonadIO m, IsProperty o) => o -> m IBus.Text.Text
getPropertyLabel :: forall (m :: * -> *) o. (MonadIO m, IsProperty o) => o -> m Text
getPropertyLabel o
obj = IO Text -> m Text
forall a. IO a -> m a
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
"getPropertyLabel" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Text -> Text) -> IO (Maybe Text)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"label" ManagedPtr Text -> Text
IBus.Text.Text

-- | Set the value of the “@label@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' property [ #label 'Data.GI.Base.Attributes.:=' value ]
-- @
setPropertyLabel :: (MonadIO m, IsProperty o, IBus.Text.IsText a) => o -> a -> m ()
setPropertyLabel :: forall (m :: * -> *) o a.
(MonadIO m, IsProperty o, IsText a) =>
o -> a -> m ()
setPropertyLabel o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"label" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@label@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPropertyLabel :: (IsProperty o, MIO.MonadIO m, IBus.Text.IsText a) => a -> m (GValueConstruct o)
constructPropertyLabel :: forall o (m :: * -> *) a.
(IsProperty o, MonadIO m, IsText a) =>
a -> m (GValueConstruct o)
constructPropertyLabel a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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 a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"label" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data PropertyLabelPropertyInfo
instance AttrInfo PropertyLabelPropertyInfo where
    type AttrAllowedOps PropertyLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PropertyLabelPropertyInfo = IsProperty
    type AttrSetTypeConstraint PropertyLabelPropertyInfo = IBus.Text.IsText
    type AttrTransferTypeConstraint PropertyLabelPropertyInfo = IBus.Text.IsText
    type AttrTransferType PropertyLabelPropertyInfo = IBus.Text.Text
    type AttrGetType PropertyLabelPropertyInfo = IBus.Text.Text
    type AttrLabel PropertyLabelPropertyInfo = "label"
    type AttrOrigin PropertyLabelPropertyInfo = Property
    attrGet = getPropertyLabel
    attrSet = setPropertyLabel
    attrTransfer _ v = do
        unsafeCastTo IBus.Text.Text v
    attrConstruct = constructPropertyLabel
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Property.label"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.7/docs/GI-IBus-Objects-Property.html#g:attr:label"
        })
#endif

-- VVV Prop "prop-type"
   -- Type: TInterface (Name {namespace = "IBus", name = "PropType"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@prop-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' property #propType
-- @
getPropertyPropType :: (MonadIO m, IsProperty o) => o -> m IBus.Enums.PropType
getPropertyPropType :: forall (m :: * -> *) o.
(MonadIO m, IsProperty o) =>
o -> m PropType
getPropertyPropType o
obj = IO PropType -> m PropType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO PropType -> m PropType) -> IO PropType -> m PropType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO PropType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"prop-type"

-- | Construct a `GValueConstruct` with valid value for the “@prop-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPropertyPropType :: (IsProperty o, MIO.MonadIO m) => IBus.Enums.PropType -> m (GValueConstruct o)
constructPropertyPropType :: forall o (m :: * -> *).
(IsProperty o, MonadIO m) =>
PropType -> m (GValueConstruct o)
constructPropertyPropType PropType
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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 -> PropType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"prop-type" PropType
val

#if defined(ENABLE_OVERLOADING)
data PropertyPropTypePropertyInfo
instance AttrInfo PropertyPropTypePropertyInfo where
    type AttrAllowedOps PropertyPropTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PropertyPropTypePropertyInfo = IsProperty
    type AttrSetTypeConstraint PropertyPropTypePropertyInfo = (~) IBus.Enums.PropType
    type AttrTransferTypeConstraint PropertyPropTypePropertyInfo = (~) IBus.Enums.PropType
    type AttrTransferType PropertyPropTypePropertyInfo = IBus.Enums.PropType
    type AttrGetType PropertyPropTypePropertyInfo = IBus.Enums.PropType
    type AttrLabel PropertyPropTypePropertyInfo = "prop-type"
    type AttrOrigin PropertyPropTypePropertyInfo = Property
    attrGet = getPropertyPropType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPropertyPropType
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Property.propType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.7/docs/GI-IBus-Objects-Property.html#g:attr:propType"
        })
#endif

-- VVV Prop "sensitive"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@sensitive@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' property [ #sensitive 'Data.GI.Base.Attributes.:=' value ]
-- @
setPropertySensitive :: (MonadIO m, IsProperty o) => o -> Bool -> m ()
setPropertySensitive :: forall (m :: * -> *) o.
(MonadIO m, IsProperty o) =>
o -> Bool -> m ()
setPropertySensitive o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"sensitive" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@sensitive@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPropertySensitive :: (IsProperty o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructPropertySensitive :: forall o (m :: * -> *).
(IsProperty o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructPropertySensitive Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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
"sensitive" Bool
val

#if defined(ENABLE_OVERLOADING)
data PropertySensitivePropertyInfo
instance AttrInfo PropertySensitivePropertyInfo where
    type AttrAllowedOps PropertySensitivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PropertySensitivePropertyInfo = IsProperty
    type AttrSetTypeConstraint PropertySensitivePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PropertySensitivePropertyInfo = (~) Bool
    type AttrTransferType PropertySensitivePropertyInfo = Bool
    type AttrGetType PropertySensitivePropertyInfo = Bool
    type AttrLabel PropertySensitivePropertyInfo = "sensitive"
    type AttrOrigin PropertySensitivePropertyInfo = Property
    attrGet = getPropertySensitive
    attrSet = setPropertySensitive
    attrTransfer _ v = do
        return v
    attrConstruct = constructPropertySensitive
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Property.sensitive"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.7/docs/GI-IBus-Objects-Property.html#g:attr:sensitive"
        })
#endif

-- VVV Prop "state"
   -- Type: TInterface (Name {namespace = "IBus", name = "PropState"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@state@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' property #state
-- @
getPropertyState :: (MonadIO m, IsProperty o) => o -> m IBus.Enums.PropState
getPropertyState :: forall (m :: * -> *) o.
(MonadIO m, IsProperty o) =>
o -> m PropState
getPropertyState o
obj = IO PropState -> m PropState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO PropState -> m PropState) -> IO PropState -> m PropState
forall a b. (a -> b) -> a -> b
$ o -> String -> IO PropState
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"state"

-- | Set the value of the “@state@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' property [ #state 'Data.GI.Base.Attributes.:=' value ]
-- @
setPropertyState :: (MonadIO m, IsProperty o) => o -> IBus.Enums.PropState -> m ()
setPropertyState :: forall (m :: * -> *) o.
(MonadIO m, IsProperty o) =>
o -> PropState -> m ()
setPropertyState o
obj PropState
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> PropState -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"state" PropState
val

-- | Construct a `GValueConstruct` with valid value for the “@state@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPropertyState :: (IsProperty o, MIO.MonadIO m) => IBus.Enums.PropState -> m (GValueConstruct o)
constructPropertyState :: forall o (m :: * -> *).
(IsProperty o, MonadIO m) =>
PropState -> m (GValueConstruct o)
constructPropertyState PropState
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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 -> PropState -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"state" PropState
val

#if defined(ENABLE_OVERLOADING)
data PropertyStatePropertyInfo
instance AttrInfo PropertyStatePropertyInfo where
    type AttrAllowedOps PropertyStatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PropertyStatePropertyInfo = IsProperty
    type AttrSetTypeConstraint PropertyStatePropertyInfo = (~) IBus.Enums.PropState
    type AttrTransferTypeConstraint PropertyStatePropertyInfo = (~) IBus.Enums.PropState
    type AttrTransferType PropertyStatePropertyInfo = IBus.Enums.PropState
    type AttrGetType PropertyStatePropertyInfo = IBus.Enums.PropState
    type AttrLabel PropertyStatePropertyInfo = "state"
    type AttrOrigin PropertyStatePropertyInfo = Property
    attrGet = getPropertyState
    attrSet = setPropertyState
    attrTransfer _ v = do
        return v
    attrConstruct = constructPropertyState
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Property.state"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.7/docs/GI-IBus-Objects-Property.html#g:attr:state"
        })
#endif

-- VVV Prop "sub-props"
   -- Type: TInterface (Name {namespace = "IBus", name = "PropList"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@sub-props@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' property [ #subProps 'Data.GI.Base.Attributes.:=' value ]
-- @
setPropertySubProps :: (MonadIO m, IsProperty o, IBus.PropList.IsPropList a) => o -> a -> m ()
setPropertySubProps :: forall (m :: * -> *) o a.
(MonadIO m, IsProperty o, IsPropList a) =>
o -> a -> m ()
setPropertySubProps o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"sub-props" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@sub-props@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPropertySubProps :: (IsProperty o, MIO.MonadIO m, IBus.PropList.IsPropList a) => a -> m (GValueConstruct o)
constructPropertySubProps :: forall o (m :: * -> *) a.
(IsProperty o, MonadIO m, IsPropList a) =>
a -> m (GValueConstruct o)
constructPropertySubProps a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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 a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"sub-props" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data PropertySubPropsPropertyInfo
instance AttrInfo PropertySubPropsPropertyInfo where
    type AttrAllowedOps PropertySubPropsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PropertySubPropsPropertyInfo = IsProperty
    type AttrSetTypeConstraint PropertySubPropsPropertyInfo = IBus.PropList.IsPropList
    type AttrTransferTypeConstraint PropertySubPropsPropertyInfo = IBus.PropList.IsPropList
    type AttrTransferType PropertySubPropsPropertyInfo = IBus.PropList.PropList
    type AttrGetType PropertySubPropsPropertyInfo = IBus.PropList.PropList
    type AttrLabel PropertySubPropsPropertyInfo = "sub-props"
    type AttrOrigin PropertySubPropsPropertyInfo = Property
    attrGet = getPropertySubProps
    attrSet = setPropertySubProps
    attrTransfer _ v = do
        unsafeCastTo IBus.PropList.PropList v
    attrConstruct = constructPropertySubProps
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Property.subProps"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.7/docs/GI-IBus-Objects-Property.html#g:attr:subProps"
        })
#endif

-- VVV Prop "symbol"
   -- Type: TInterface (Name {namespace = "IBus", name = "Text"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@symbol@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' property #symbol
-- @
getPropertySymbol :: (MonadIO m, IsProperty o) => o -> m IBus.Text.Text
getPropertySymbol :: forall (m :: * -> *) o. (MonadIO m, IsProperty o) => o -> m Text
getPropertySymbol o
obj = IO Text -> m Text
forall a. IO a -> m a
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
"getPropertySymbol" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Text -> Text) -> IO (Maybe Text)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"symbol" ManagedPtr Text -> Text
IBus.Text.Text

-- | Set the value of the “@symbol@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' property [ #symbol 'Data.GI.Base.Attributes.:=' value ]
-- @
setPropertySymbol :: (MonadIO m, IsProperty o, IBus.Text.IsText a) => o -> a -> m ()
setPropertySymbol :: forall (m :: * -> *) o a.
(MonadIO m, IsProperty o, IsText a) =>
o -> a -> m ()
setPropertySymbol o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"symbol" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@symbol@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPropertySymbol :: (IsProperty o, MIO.MonadIO m, IBus.Text.IsText a) => a -> m (GValueConstruct o)
constructPropertySymbol :: forall o (m :: * -> *) a.
(IsProperty o, MonadIO m, IsText a) =>
a -> m (GValueConstruct o)
constructPropertySymbol a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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 a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"symbol" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data PropertySymbolPropertyInfo
instance AttrInfo PropertySymbolPropertyInfo where
    type AttrAllowedOps PropertySymbolPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PropertySymbolPropertyInfo = IsProperty
    type AttrSetTypeConstraint PropertySymbolPropertyInfo = IBus.Text.IsText
    type AttrTransferTypeConstraint PropertySymbolPropertyInfo = IBus.Text.IsText
    type AttrTransferType PropertySymbolPropertyInfo = IBus.Text.Text
    type AttrGetType PropertySymbolPropertyInfo = IBus.Text.Text
    type AttrLabel PropertySymbolPropertyInfo = "symbol"
    type AttrOrigin PropertySymbolPropertyInfo = Property
    attrGet = getPropertySymbol
    attrSet = setPropertySymbol
    attrTransfer _ v = do
        unsafeCastTo IBus.Text.Text v
    attrConstruct = constructPropertySymbol
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Property.symbol"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.7/docs/GI-IBus-Objects-Property.html#g:attr:symbol"
        })
#endif

-- VVV Prop "tooltip"
   -- Type: TInterface (Name {namespace = "IBus", name = "Text"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@tooltip@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' property #tooltip
-- @
getPropertyTooltip :: (MonadIO m, IsProperty o) => o -> m IBus.Text.Text
getPropertyTooltip :: forall (m :: * -> *) o. (MonadIO m, IsProperty o) => o -> m Text
getPropertyTooltip o
obj = IO Text -> m Text
forall a. IO a -> m a
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
"getPropertyTooltip" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Text -> Text) -> IO (Maybe Text)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"tooltip" ManagedPtr Text -> Text
IBus.Text.Text

-- | Set the value of the “@tooltip@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' property [ #tooltip 'Data.GI.Base.Attributes.:=' value ]
-- @
setPropertyTooltip :: (MonadIO m, IsProperty o, IBus.Text.IsText a) => o -> a -> m ()
setPropertyTooltip :: forall (m :: * -> *) o a.
(MonadIO m, IsProperty o, IsText a) =>
o -> a -> m ()
setPropertyTooltip o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"tooltip" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@tooltip@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPropertyTooltip :: (IsProperty o, MIO.MonadIO m, IBus.Text.IsText a) => a -> m (GValueConstruct o)
constructPropertyTooltip :: forall o (m :: * -> *) a.
(IsProperty o, MonadIO m, IsText a) =>
a -> m (GValueConstruct o)
constructPropertyTooltip a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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 a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"tooltip" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data PropertyTooltipPropertyInfo
instance AttrInfo PropertyTooltipPropertyInfo where
    type AttrAllowedOps PropertyTooltipPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PropertyTooltipPropertyInfo = IsProperty
    type AttrSetTypeConstraint PropertyTooltipPropertyInfo = IBus.Text.IsText
    type AttrTransferTypeConstraint PropertyTooltipPropertyInfo = IBus.Text.IsText
    type AttrTransferType PropertyTooltipPropertyInfo = IBus.Text.Text
    type AttrGetType PropertyTooltipPropertyInfo = IBus.Text.Text
    type AttrLabel PropertyTooltipPropertyInfo = "tooltip"
    type AttrOrigin PropertyTooltipPropertyInfo = Property
    attrGet = getPropertyTooltip
    attrSet = setPropertyTooltip
    attrTransfer _ v = do
        unsafeCastTo IBus.Text.Text v
    attrConstruct = constructPropertyTooltip
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Property.tooltip"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.7/docs/GI-IBus-Objects-Property.html#g:attr:tooltip"
        })
#endif

-- VVV Prop "visible"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@visible@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' property [ #visible 'Data.GI.Base.Attributes.:=' value ]
-- @
setPropertyVisible :: (MonadIO m, IsProperty o) => o -> Bool -> m ()
setPropertyVisible :: forall (m :: * -> *) o.
(MonadIO m, IsProperty o) =>
o -> Bool -> m ()
setPropertyVisible o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"visible" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@visible@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPropertyVisible :: (IsProperty o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructPropertyVisible :: forall o (m :: * -> *).
(IsProperty o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructPropertyVisible Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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
"visible" Bool
val

#if defined(ENABLE_OVERLOADING)
data PropertyVisiblePropertyInfo
instance AttrInfo PropertyVisiblePropertyInfo where
    type AttrAllowedOps PropertyVisiblePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PropertyVisiblePropertyInfo = IsProperty
    type AttrSetTypeConstraint PropertyVisiblePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PropertyVisiblePropertyInfo = (~) Bool
    type AttrTransferType PropertyVisiblePropertyInfo = Bool
    type AttrGetType PropertyVisiblePropertyInfo = Bool
    type AttrLabel PropertyVisiblePropertyInfo = "visible"
    type AttrOrigin PropertyVisiblePropertyInfo = Property
    attrGet = getPropertyVisible
    attrSet = setPropertyVisible
    attrTransfer _ v = do
        return v
    attrConstruct = constructPropertyVisible
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Property.visible"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.7/docs/GI-IBus-Objects-Property.html#g:attr:visible"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Property
type instance O.AttributeList Property = PropertyAttributeList
type PropertyAttributeList = ('[ '("icon", PropertyIconPropertyInfo), '("key", PropertyKeyPropertyInfo), '("label", PropertyLabelPropertyInfo), '("propType", PropertyPropTypePropertyInfo), '("sensitive", PropertySensitivePropertyInfo), '("state", PropertyStatePropertyInfo), '("subProps", PropertySubPropsPropertyInfo), '("symbol", PropertySymbolPropertyInfo), '("tooltip", PropertyTooltipPropertyInfo), '("visible", PropertyVisiblePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
propertyIcon :: AttrLabelProxy "icon"
propertyIcon = AttrLabelProxy

propertyKey :: AttrLabelProxy "key"
propertyKey = AttrLabelProxy

propertyLabel :: AttrLabelProxy "label"
propertyLabel = AttrLabelProxy

propertyPropType :: AttrLabelProxy "propType"
propertyPropType = AttrLabelProxy

propertySensitive :: AttrLabelProxy "sensitive"
propertySensitive = AttrLabelProxy

propertyState :: AttrLabelProxy "state"
propertyState = AttrLabelProxy

propertySubProps :: AttrLabelProxy "subProps"
propertySubProps = AttrLabelProxy

propertySymbol :: AttrLabelProxy "symbol"
propertySymbol = AttrLabelProxy

propertyTooltip :: AttrLabelProxy "tooltip"
propertyTooltip = AttrLabelProxy

propertyVisible :: AttrLabelProxy "visible"
propertyVisible = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Property = PropertySignalList
type PropertySignalList = ('[ '("destroy", IBus.Object.ObjectDestroySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Property::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Unique Identity for the #IBusProperty."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PropType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#IBusPropType of #IBusProperty."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TInterface Name { namespace = "IBus" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Text shown in UI." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Icon file for the #IBusProperty."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tooltip"
--           , argType = TInterface Name { namespace = "IBus" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Message shown if mouse hovered the  #IBusProperty."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sensitive"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Whether the #IBusProperty is sensitive to keyboard and mouse event."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "visible"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether the #IBusProperty is visible."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PropState" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "IBusPropState of #IBusProperty."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prop_list"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PropList" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#IBusPropList that contains sub IBusProperties."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "IBus" , name = "Property" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_property_new" ibus_property_new :: 
    CString ->                              -- key : TBasicType TUTF8
    CUInt ->                                -- type : TInterface (Name {namespace = "IBus", name = "PropType"})
    Ptr IBus.Text.Text ->                   -- label : TInterface (Name {namespace = "IBus", name = "Text"})
    CString ->                              -- icon : TBasicType TUTF8
    Ptr IBus.Text.Text ->                   -- tooltip : TInterface (Name {namespace = "IBus", name = "Text"})
    CInt ->                                 -- sensitive : TBasicType TBoolean
    CInt ->                                 -- visible : TBasicType TBoolean
    CUInt ->                                -- state : TInterface (Name {namespace = "IBus", name = "PropState"})
    Ptr IBus.PropList.PropList ->           -- prop_list : TInterface (Name {namespace = "IBus", name = "PropList"})
    IO (Ptr Property)

-- | Creates a new t'GI.IBus.Objects.Property.Property'.
propertyNew ::
    (B.CallStack.HasCallStack, MonadIO m, IBus.Text.IsText a, IBus.Text.IsText b, IBus.PropList.IsPropList c) =>
    T.Text
    -- ^ /@key@/: Unique Identity for the t'GI.IBus.Objects.Property.Property'.
    -> IBus.Enums.PropType
    -- ^ /@type@/: t'GI.IBus.Enums.PropType' of t'GI.IBus.Objects.Property.Property'.
    -> a
    -- ^ /@label@/: Text shown in UI.
    -> Maybe (T.Text)
    -- ^ /@icon@/: Icon file for the t'GI.IBus.Objects.Property.Property'.
    -> b
    -- ^ /@tooltip@/: Message shown if mouse hovered the  t'GI.IBus.Objects.Property.Property'.
    -> Bool
    -- ^ /@sensitive@/: Whether the t'GI.IBus.Objects.Property.Property' is sensitive to keyboard and mouse event.
    -> Bool
    -- ^ /@visible@/: Whether the t'GI.IBus.Objects.Property.Property' is visible.
    -> IBus.Enums.PropState
    -- ^ /@state@/: IBusPropState of t'GI.IBus.Objects.Property.Property'.
    -> Maybe (c)
    -- ^ /@propList@/: t'GI.IBus.Objects.PropList.PropList' that contains sub IBusProperties.
    -> m Property
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.Property.Property'.
propertyNew :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsText a, IsText b, IsPropList c) =>
Text
-> PropType
-> a
-> Maybe Text
-> b
-> Bool
-> Bool
-> PropState
-> Maybe c
-> m Property
propertyNew Text
key PropType
type_ a
label Maybe Text
icon b
tooltip Bool
sensitive Bool
visible PropState
state Maybe c
propList = IO Property -> m Property
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Property -> m Property) -> IO Property -> m Property
forall a b. (a -> b) -> a -> b
$ do
    CString
key' <- Text -> IO CString
textToCString Text
key
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PropType -> Int) -> PropType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PropType -> Int
forall a. Enum a => a -> Int
fromEnum) PropType
type_
    Ptr Text
label' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
label
    CString
maybeIcon <- case Maybe Text
icon of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jIcon -> do
            CString
jIcon' <- Text -> IO CString
textToCString Text
jIcon
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jIcon'
    Ptr Text
tooltip' <- b -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
tooltip
    let sensitive' :: CInt
sensitive' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
sensitive
    let visible' :: CInt
visible' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
visible
    let state' :: CUInt
state' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PropState -> Int) -> PropState -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PropState -> Int
forall a. Enum a => a -> Int
fromEnum) PropState
state
    Ptr PropList
maybePropList <- case Maybe c
propList of
        Maybe c
Nothing -> Ptr PropList -> IO (Ptr PropList)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr PropList
forall a. Ptr a
nullPtr
        Just c
jPropList -> do
            Ptr PropList
jPropList' <- c -> IO (Ptr PropList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jPropList
            Ptr PropList -> IO (Ptr PropList)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr PropList
jPropList'
    Ptr Property
result <- CString
-> CUInt
-> Ptr Text
-> CString
-> Ptr Text
-> CInt
-> CInt
-> CUInt
-> Ptr PropList
-> IO (Ptr Property)
ibus_property_new CString
key' CUInt
type_' Ptr Text
label' CString
maybeIcon Ptr Text
tooltip' CInt
sensitive' CInt
visible' CUInt
state' Ptr PropList
maybePropList
    Text -> Ptr Property -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"propertyNew" Ptr Property
result
    Property
result' <- ((ManagedPtr Property -> Property) -> Ptr Property -> IO Property
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Property -> Property
Property) Ptr Property
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
label
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
tooltip
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
propList c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeIcon
    Property -> IO Property
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Property
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Property::get_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusProperty." , 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_property_get_icon" ibus_property_get_icon :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    IO CString

-- | Get the icon of t'GI.IBus.Objects.Property.Property'.
propertyGetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> m T.Text
    -- ^ __Returns:__ the icon of t'GI.IBus.Objects.Property.Property'. Should not be freed.
propertyGetIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProperty a) =>
a -> m Text
propertyGetIcon a
prop = IO Text -> m Text
forall a. IO a -> m a
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 Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    CString
result <- Ptr Property -> IO CString
ibus_property_get_icon Ptr Property
prop'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"propertyGetIcon" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PropertyGetIconMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsProperty a) => O.OverloadedMethod PropertyGetIconMethodInfo a signature where
    overloadedMethod = propertyGetIcon

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


#endif

-- method Property::get_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusProperty." , 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_property_get_key" ibus_property_get_key :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    IO CString

-- | Get the key of t'GI.IBus.Objects.Property.Property'.
propertyGetKey ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> m T.Text
    -- ^ __Returns:__ the key of t'GI.IBus.Objects.Property.Property'. Should not be freed.
propertyGetKey :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProperty a) =>
a -> m Text
propertyGetKey a
prop = IO Text -> m Text
forall a. IO a -> m a
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 Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    CString
result <- Ptr Property -> IO CString
ibus_property_get_key Ptr Property
prop'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"propertyGetKey" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PropertyGetKeyMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsProperty a) => O.OverloadedMethod PropertyGetKeyMethodInfo a signature where
    overloadedMethod = propertyGetKey

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


#endif

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

foreign import ccall "ibus_property_get_label" ibus_property_get_label :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    IO (Ptr IBus.Text.Text)

-- | Get the label of t'GI.IBus.Objects.Property.Property'.
propertyGetLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> m IBus.Text.Text
    -- ^ __Returns:__ the label of t'GI.IBus.Objects.Property.Property'. Should not be freed.
propertyGetLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProperty a) =>
a -> m Text
propertyGetLabel a
prop = IO Text -> m Text
forall a. IO a -> m a
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 Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    Ptr Text
result <- Ptr Property -> IO (Ptr Text)
ibus_property_get_label Ptr Property
prop'
    Text -> Ptr Text -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"propertyGetLabel" Ptr Text
result
    Text
result' <- ((ManagedPtr Text -> Text) -> Ptr Text -> IO Text
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Text -> Text
IBus.Text.Text) Ptr Text
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PropertyGetLabelMethodInfo
instance (signature ~ (m IBus.Text.Text), MonadIO m, IsProperty a) => O.OverloadedMethod PropertyGetLabelMethodInfo a signature where
    overloadedMethod = propertyGetLabel

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


#endif

-- method Property::get_prop_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "IBus" , name = "PropType" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_property_get_prop_type" ibus_property_get_prop_type :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    IO CUInt

-- | /No description available in the introspection data./
propertyGetPropType ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a) =>
    a
    -> m IBus.Enums.PropType
propertyGetPropType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProperty a) =>
a -> m PropType
propertyGetPropType a
prop = IO PropType -> m PropType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PropType -> m PropType) -> IO PropType -> m PropType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    CUInt
result <- Ptr Property -> IO CUInt
ibus_property_get_prop_type Ptr Property
prop'
    let result' :: PropType
result' = (Int -> PropType
forall a. Enum a => Int -> a
toEnum (Int -> PropType) -> (CUInt -> Int) -> CUInt -> PropType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    PropType -> IO PropType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PropType
result'

#if defined(ENABLE_OVERLOADING)
data PropertyGetPropTypeMethodInfo
instance (signature ~ (m IBus.Enums.PropType), MonadIO m, IsProperty a) => O.OverloadedMethod PropertyGetPropTypeMethodInfo a signature where
    overloadedMethod = propertyGetPropType

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


#endif

-- method Property::get_sensitive
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusProperty." , 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_property_get_sensitive" ibus_property_get_sensitive :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    IO CInt

-- | Get the sensitive of t'GI.IBus.Objects.Property.Property'.
propertyGetSensitive ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> m Bool
    -- ^ __Returns:__ the sensitive of t'GI.IBus.Objects.Property.Property'.
propertyGetSensitive :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProperty a) =>
a -> m Bool
propertyGetSensitive a
prop = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    CInt
result <- Ptr Property -> IO CInt
ibus_property_get_sensitive Ptr Property
prop'
    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
prop
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PropertyGetSensitiveMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsProperty a) => O.OverloadedMethod PropertyGetSensitiveMethodInfo a signature where
    overloadedMethod = propertyGetSensitive

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


#endif

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

foreign import ccall "ibus_property_get_state" ibus_property_get_state :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    IO CUInt

-- | Get the state of t'GI.IBus.Objects.Property.Property'.
propertyGetState ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> m IBus.Enums.PropState
    -- ^ __Returns:__ the state of t'GI.IBus.Objects.Property.Property'.
propertyGetState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProperty a) =>
a -> m PropState
propertyGetState a
prop = IO PropState -> m PropState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PropState -> m PropState) -> IO PropState -> m PropState
forall a b. (a -> b) -> a -> b
$ do
    Ptr Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    CUInt
result <- Ptr Property -> IO CUInt
ibus_property_get_state Ptr Property
prop'
    let result' :: PropState
result' = (Int -> PropState
forall a. Enum a => Int -> a
toEnum (Int -> PropState) -> (CUInt -> Int) -> CUInt -> PropState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    PropState -> IO PropState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PropState
result'

#if defined(ENABLE_OVERLOADING)
data PropertyGetStateMethodInfo
instance (signature ~ (m IBus.Enums.PropState), MonadIO m, IsProperty a) => O.OverloadedMethod PropertyGetStateMethodInfo a signature where
    overloadedMethod = propertyGetState

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


#endif

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

foreign import ccall "ibus_property_get_sub_props" ibus_property_get_sub_props :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    IO (Ptr IBus.PropList.PropList)

-- | Get the IBusPropList of t'GI.IBus.Objects.Property.Property'.
propertyGetSubProps ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> m IBus.PropList.PropList
    -- ^ __Returns:__ the IBusPropList of t'GI.IBus.Objects.Property.Property'.
    --     Should not be freed.
propertyGetSubProps :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProperty a) =>
a -> m PropList
propertyGetSubProps a
prop = IO PropList -> m PropList
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PropList -> m PropList) -> IO PropList -> m PropList
forall a b. (a -> b) -> a -> b
$ do
    Ptr Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    Ptr PropList
result <- Ptr Property -> IO (Ptr PropList)
ibus_property_get_sub_props Ptr Property
prop'
    Text -> Ptr PropList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"propertyGetSubProps" Ptr PropList
result
    PropList
result' <- ((ManagedPtr PropList -> PropList) -> Ptr PropList -> IO PropList
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr PropList -> PropList
IBus.PropList.PropList) Ptr PropList
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    PropList -> IO PropList
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PropList
result'

#if defined(ENABLE_OVERLOADING)
data PropertyGetSubPropsMethodInfo
instance (signature ~ (m IBus.PropList.PropList), MonadIO m, IsProperty a) => O.OverloadedMethod PropertyGetSubPropsMethodInfo a signature where
    overloadedMethod = propertyGetSubProps

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


#endif

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

foreign import ccall "ibus_property_get_symbol" ibus_property_get_symbol :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    IO (Ptr IBus.Text.Text)

-- | Get the symbol of t'GI.IBus.Objects.Property.Property'.
propertyGetSymbol ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> m IBus.Text.Text
    -- ^ __Returns:__ the symbol of t'GI.IBus.Objects.Property.Property'. Should not be freed.
propertyGetSymbol :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProperty a) =>
a -> m Text
propertyGetSymbol a
prop = IO Text -> m Text
forall a. IO a -> m a
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 Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    Ptr Text
result <- Ptr Property -> IO (Ptr Text)
ibus_property_get_symbol Ptr Property
prop'
    Text -> Ptr Text -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"propertyGetSymbol" Ptr Text
result
    Text
result' <- ((ManagedPtr Text -> Text) -> Ptr Text -> IO Text
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Text -> Text
IBus.Text.Text) Ptr Text
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PropertyGetSymbolMethodInfo
instance (signature ~ (m IBus.Text.Text), MonadIO m, IsProperty a) => O.OverloadedMethod PropertyGetSymbolMethodInfo a signature where
    overloadedMethod = propertyGetSymbol

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


#endif

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

foreign import ccall "ibus_property_get_tooltip" ibus_property_get_tooltip :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    IO (Ptr IBus.Text.Text)

-- | Get the tooltip of t'GI.IBus.Objects.Property.Property'.
propertyGetTooltip ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> m IBus.Text.Text
    -- ^ __Returns:__ the tooltip of t'GI.IBus.Objects.Property.Property'. Should not be freed.
propertyGetTooltip :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProperty a) =>
a -> m Text
propertyGetTooltip a
prop = IO Text -> m Text
forall a. IO a -> m a
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 Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    Ptr Text
result <- Ptr Property -> IO (Ptr Text)
ibus_property_get_tooltip Ptr Property
prop'
    Text -> Ptr Text -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"propertyGetTooltip" Ptr Text
result
    Text
result' <- ((ManagedPtr Text -> Text) -> Ptr Text -> IO Text
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Text -> Text
IBus.Text.Text) Ptr Text
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PropertyGetTooltipMethodInfo
instance (signature ~ (m IBus.Text.Text), MonadIO m, IsProperty a) => O.OverloadedMethod PropertyGetTooltipMethodInfo a signature where
    overloadedMethod = propertyGetTooltip

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


#endif

-- method Property::get_visible
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusProperty." , 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_property_get_visible" ibus_property_get_visible :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    IO CInt

-- | Get the visible of t'GI.IBus.Objects.Property.Property'.
propertyGetVisible ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> m Bool
    -- ^ __Returns:__ the visible of t'GI.IBus.Objects.Property.Property'.
propertyGetVisible :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProperty a) =>
a -> m Bool
propertyGetVisible a
prop = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    CInt
result <- Ptr Property -> IO CInt
ibus_property_get_visible Ptr Property
prop'
    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
prop
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PropertyGetVisibleMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsProperty a) => O.OverloadedMethod PropertyGetVisibleMethodInfo a signature where
    overloadedMethod = propertyGetVisible

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


#endif

-- method Property::set_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusProperty." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Icon shown in UI. It could be a full path of an icon file or an icon name."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_property_set_icon" ibus_property_set_icon :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    CString ->                              -- icon : TBasicType TUTF8
    IO ()

-- | Set the icon of t'GI.IBus.Objects.Property.Property'.
propertySetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> T.Text
    -- ^ /@icon@/: Icon shown in UI. It could be a full path of an icon file or an icon name.
    -> m ()
propertySetIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProperty a) =>
a -> Text -> m ()
propertySetIcon a
prop Text
icon = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    CString
icon' <- Text -> IO CString
textToCString Text
icon
    Ptr Property -> CString -> IO ()
ibus_property_set_icon Ptr Property
prop' CString
icon'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
icon'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PropertySetIconMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsProperty a) => O.OverloadedMethod PropertySetIconMethodInfo a signature where
    overloadedMethod = propertySetIcon

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


#endif

-- method Property::set_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusProperty." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TInterface Name { namespace = "IBus" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Text shown in UI." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_property_set_label" ibus_property_set_label :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    Ptr IBus.Text.Text ->                   -- label : TInterface (Name {namespace = "IBus", name = "Text"})
    IO ()

-- | Set the label of t'GI.IBus.Objects.Property.Property'.
propertySetLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a, IBus.Text.IsText b) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> b
    -- ^ /@label@/: Text shown in UI.
    -> m ()
propertySetLabel :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsProperty a, IsText b) =>
a -> b -> m ()
propertySetLabel a
prop b
label = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    Ptr Text
label' <- b -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
label
    Ptr Property -> Ptr Text -> IO ()
ibus_property_set_label Ptr Property
prop' Ptr Text
label'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
label
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PropertySetLabelMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsProperty a, IBus.Text.IsText b) => O.OverloadedMethod PropertySetLabelMethodInfo a signature where
    overloadedMethod = propertySetLabel

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


#endif

-- method Property::set_sensitive
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusProperty." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sensitive"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether the #IBusProperty is sensitive."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_property_set_sensitive" ibus_property_set_sensitive :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    CInt ->                                 -- sensitive : TBasicType TBoolean
    IO ()

-- | Set whether the t'GI.IBus.Objects.Property.Property' is sensitive.
propertySetSensitive ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> Bool
    -- ^ /@sensitive@/: Whether the t'GI.IBus.Objects.Property.Property' is sensitive.
    -> m ()
propertySetSensitive :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProperty a) =>
a -> Bool -> m ()
propertySetSensitive a
prop Bool
sensitive = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    let sensitive' :: CInt
sensitive' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
sensitive
    Ptr Property -> CInt -> IO ()
ibus_property_set_sensitive Ptr Property
prop' CInt
sensitive'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PropertySetSensitiveMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsProperty a) => O.OverloadedMethod PropertySetSensitiveMethodInfo a signature where
    overloadedMethod = propertySetSensitive

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


#endif

-- method Property::set_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusProperty." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PropState" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The state of the #IBusProperty."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_property_set_state" ibus_property_set_state :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    CUInt ->                                -- state : TInterface (Name {namespace = "IBus", name = "PropState"})
    IO ()

-- | Set the state of the t'GI.IBus.Objects.Property.Property'.
propertySetState ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> IBus.Enums.PropState
    -- ^ /@state@/: The state of the t'GI.IBus.Objects.Property.Property'.
    -> m ()
propertySetState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProperty a) =>
a -> PropState -> m ()
propertySetState a
prop PropState
state = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    let state' :: CUInt
state' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PropState -> Int) -> PropState -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PropState -> Int
forall a. Enum a => a -> Int
fromEnum) PropState
state
    Ptr Property -> CUInt -> IO ()
ibus_property_set_state Ptr Property
prop' CUInt
state'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PropertySetStateMethodInfo
instance (signature ~ (IBus.Enums.PropState -> m ()), MonadIO m, IsProperty a) => O.OverloadedMethod PropertySetStateMethodInfo a signature where
    overloadedMethod = propertySetState

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


#endif

-- method Property::set_sub_props
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusProperty." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prop_list"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PropList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#IBusPropList that contains sub IBusProperties."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_property_set_sub_props" ibus_property_set_sub_props :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    Ptr IBus.PropList.PropList ->           -- prop_list : TInterface (Name {namespace = "IBus", name = "PropList"})
    IO ()

-- | Set the sub IBusProperties.
propertySetSubProps ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a, IBus.PropList.IsPropList b) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> b
    -- ^ /@propList@/: t'GI.IBus.Objects.PropList.PropList' that contains sub IBusProperties.
    -> m ()
propertySetSubProps :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsProperty a, IsPropList b) =>
a -> b -> m ()
propertySetSubProps a
prop b
propList = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    Ptr PropList
propList' <- b -> IO (Ptr PropList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
propList
    Ptr Property -> Ptr PropList -> IO ()
ibus_property_set_sub_props Ptr Property
prop' Ptr PropList
propList'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
propList
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PropertySetSubPropsMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsProperty a, IBus.PropList.IsPropList b) => O.OverloadedMethod PropertySetSubPropsMethodInfo a signature where
    overloadedMethod = propertySetSubProps

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


#endif

-- method Property::set_symbol
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusProperty." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "symbol"
--           , argType = TInterface Name { namespace = "IBus" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Text shown in UI." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_property_set_symbol" ibus_property_set_symbol :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    Ptr IBus.Text.Text ->                   -- symbol : TInterface (Name {namespace = "IBus", name = "Text"})
    IO ()

-- | Set the symbol of t'GI.IBus.Objects.Property.Property'.
propertySetSymbol ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a, IBus.Text.IsText b) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> b
    -- ^ /@symbol@/: Text shown in UI.
    -> m ()
propertySetSymbol :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsProperty a, IsText b) =>
a -> b -> m ()
propertySetSymbol a
prop b
symbol = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    Ptr Text
symbol' <- b -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
symbol
    Ptr Property -> Ptr Text -> IO ()
ibus_property_set_symbol Ptr Property
prop' Ptr Text
symbol'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
symbol
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PropertySetSymbolMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsProperty a, IBus.Text.IsText b) => O.OverloadedMethod PropertySetSymbolMethodInfo a signature where
    overloadedMethod = propertySetSymbol

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


#endif

-- method Property::set_tooltip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusProperty." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tooltip"
--           , argType = TInterface Name { namespace = "IBus" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Text of the tooltip."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_property_set_tooltip" ibus_property_set_tooltip :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    Ptr IBus.Text.Text ->                   -- tooltip : TInterface (Name {namespace = "IBus", name = "Text"})
    IO ()

-- | Set the tooltip of t'GI.IBus.Objects.Property.Property'.
propertySetTooltip ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a, IBus.Text.IsText b) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> b
    -- ^ /@tooltip@/: Text of the tooltip.
    -> m ()
propertySetTooltip :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsProperty a, IsText b) =>
a -> b -> m ()
propertySetTooltip a
prop b
tooltip = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    Ptr Text
tooltip' <- b -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
tooltip
    Ptr Property -> Ptr Text -> IO ()
ibus_property_set_tooltip Ptr Property
prop' Ptr Text
tooltip'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
tooltip
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PropertySetTooltipMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsProperty a, IBus.Text.IsText b) => O.OverloadedMethod PropertySetTooltipMethodInfo a signature where
    overloadedMethod = propertySetTooltip

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


#endif

-- method Property::set_visible
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusProperty." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "visible"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether the #IBusProperty is visible."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_property_set_visible" ibus_property_set_visible :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    CInt ->                                 -- visible : TBasicType TBoolean
    IO ()

-- | Set whether the t'GI.IBus.Objects.Property.Property' is visible.
propertySetVisible ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> Bool
    -- ^ /@visible@/: Whether the t'GI.IBus.Objects.Property.Property' is visible.
    -> m ()
propertySetVisible :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProperty a) =>
a -> Bool -> m ()
propertySetVisible a
prop Bool
visible = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    let visible' :: CInt
visible' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
visible
    Ptr Property -> CInt -> IO ()
ibus_property_set_visible Ptr Property
prop' CInt
visible'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
prop
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PropertySetVisibleMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsProperty a) => O.OverloadedMethod PropertySetVisibleMethodInfo a signature where
    overloadedMethod = propertySetVisible

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


#endif

-- method Property::update
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusProperty." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prop_update"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#IBusPropList that contains sub IBusProperties."
--                 , 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_property_update" ibus_property_update :: 
    Ptr Property ->                         -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    Ptr Property ->                         -- prop_update : TInterface (Name {namespace = "IBus", name = "Property"})
    IO CInt

-- | Update the content of an t'GI.IBus.Objects.Property.Property'.
-- t'GI.IBus.Objects.Property.Property' /@propUpdate@/ can either be sub-property of /@prop@/,
-- or holds new values for /@prop@/.
propertyUpdate ::
    (B.CallStack.HasCallStack, MonadIO m, IsProperty a, IsProperty b) =>
    a
    -- ^ /@prop@/: An t'GI.IBus.Objects.Property.Property'.
    -> b
    -- ^ /@propUpdate@/: t'GI.IBus.Objects.PropList.PropList' that contains sub IBusProperties.
    -> m Bool
    -- ^ __Returns:__ TRUE if update succeeded; FALSE otherwise.
propertyUpdate :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsProperty a, IsProperty b) =>
a -> b -> m Bool
propertyUpdate a
prop b
propUpdate = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Property
prop' <- a -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
prop
    Ptr Property
propUpdate' <- b -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
propUpdate
    CInt
result <- Ptr Property -> Ptr Property -> IO CInt
ibus_property_update Ptr Property
prop' Ptr Property
propUpdate'
    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
prop
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
propUpdate
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PropertyUpdateMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsProperty a, IsProperty b) => O.OverloadedMethod PropertyUpdateMethodInfo a signature where
    overloadedMethod = propertyUpdate

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


#endif