{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- See_also: t'GI.IBus.Objects.Property.Property', 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.PropList
    ( 

-- * Exported types
    PropList(..)                            ,
    IsPropList                              ,
    toPropList                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [append]("GI.IBus.Objects.PropList#g:method:append"), [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"), [get]("GI.IBus.Objects.PropList#g:method:get"), [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"), [updateProperty]("GI.IBus.Objects.PropList#g:method:updateProperty"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQattachment]("GI.IBus.Objects.Serializable#g:method:getQattachment"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setQattachment]("GI.IBus.Objects.Serializable#g:method:setQattachment").

#if defined(ENABLE_OVERLOADING)
    ResolvePropListMethod                   ,
#endif

-- ** append #method:append#

#if defined(ENABLE_OVERLOADING)
    PropListAppendMethodInfo                ,
#endif
    propListAppend                          ,


-- ** get #method:get#

#if defined(ENABLE_OVERLOADING)
    PropListGetMethodInfo                   ,
#endif
    propListGet                             ,


-- ** new #method:new#

    propListNew                             ,


-- ** updateProperty #method:updateProperty#

#if defined(ENABLE_OVERLOADING)
    PropListUpdatePropertyMethodInfo        ,
#endif
    propListUpdateProperty                  ,




    ) where

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

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

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

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

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

foreign import ccall "ibus_prop_list_get_type"
    c_ibus_prop_list_get_type :: IO B.Types.GType

instance B.Types.TypedObject PropList where
    glibType :: IO GType
glibType = IO GType
c_ibus_prop_list_get_type

instance B.Types.GObject PropList

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

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

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

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

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

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

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method PropList::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "IBus" , name = "PropList" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_prop_list_new" ibus_prop_list_new :: 
    IO (Ptr PropList)

-- | Create a new t'GI.IBus.Objects.PropList.PropList'.
propListNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m PropList
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.PropList.PropList'.
propListNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m PropList
propListNew  = IO PropList -> m PropList
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 PropList
result <- IO (Ptr PropList)
ibus_prop_list_new
    Text -> Ptr PropList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"propListNew" 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
PropList) Ptr PropList
result
    PropList -> IO PropList
forall (m :: * -> *) a. Monad m => a -> m a
return PropList
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

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

-- | Append an IBusProperty to an IBusPropList, and increase reference.
propListAppend ::
    (B.CallStack.HasCallStack, MonadIO m, IsPropList a, IBus.Property.IsProperty b) =>
    a
    -- ^ /@propList@/: An IBusPropList.
    -> b
    -- ^ /@prop@/: IBusProperty to be append to /@propList@/.
    -> m ()
propListAppend :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPropList a, IsProperty b) =>
a -> b -> m ()
propListAppend a
propList b
prop = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PropList
propList' <- a -> IO (Ptr PropList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
propList
    Ptr Property
prop' <- b -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
prop
    Ptr PropList -> Ptr Property -> IO ()
ibus_prop_list_append Ptr PropList
propList' Ptr Property
prop'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
propList
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
prop
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method PropList::get
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop_list"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PropList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusPropList." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Index of an IBusPropList."
--                 , 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_prop_list_get" ibus_prop_list_get :: 
    Ptr PropList ->                         -- prop_list : TInterface (Name {namespace = "IBus", name = "PropList"})
    Word32 ->                               -- index : TBasicType TUInt
    IO (Ptr IBus.Property.Property)

-- | Gets t'GI.IBus.Objects.Property.Property' at given index. Borrowed reference.
propListGet ::
    (B.CallStack.HasCallStack, MonadIO m, IsPropList a) =>
    a
    -- ^ /@propList@/: An IBusPropList.
    -> Word32
    -- ^ /@index@/: Index of an IBusPropList.
    -> m IBus.Property.Property
    -- ^ __Returns:__ t'GI.IBus.Objects.Property.Property' at given index, 'P.Nothing' if no such
    --     t'GI.IBus.Objects.Property.Property'.
propListGet :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPropList a) =>
a -> Word32 -> m Property
propListGet a
propList Word32
index = IO Property -> m Property
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
    Ptr PropList
propList' <- a -> IO (Ptr PropList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
propList
    Ptr Property
result <- Ptr PropList -> Word32 -> IO (Ptr Property)
ibus_prop_list_get Ptr PropList
propList' Word32
index
    Text -> Ptr Property -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"propListGet" 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
IBus.Property.Property) Ptr Property
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
propList
    Property -> IO Property
forall (m :: * -> *) a. Monad m => a -> m a
return Property
result'

#if defined(ENABLE_OVERLOADING)
data PropListGetMethodInfo
instance (signature ~ (Word32 -> m IBus.Property.Property), MonadIO m, IsPropList a) => O.OverloadedMethod PropListGetMethodInfo a signature where
    overloadedMethod = propListGet

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


#endif

-- method PropList::update_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop_list"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PropList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusPropList." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "IBusProperty to be update."
--                 , 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_prop_list_update_property" ibus_prop_list_update_property :: 
    Ptr PropList ->                         -- prop_list : TInterface (Name {namespace = "IBus", name = "PropList"})
    Ptr IBus.Property.Property ->           -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    IO CInt

-- | Update an IBusProperty in IBusPropList.
propListUpdateProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsPropList a, IBus.Property.IsProperty b) =>
    a
    -- ^ /@propList@/: An IBusPropList.
    -> b
    -- ^ /@prop@/: IBusProperty to be update.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if succeeded, 'P.False' otherwise.
propListUpdateProperty :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPropList a, IsProperty b) =>
a -> b -> m Bool
propListUpdateProperty a
propList b
prop = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr PropList
propList' <- a -> IO (Ptr PropList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
propList
    Ptr Property
prop' <- b -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
prop
    CInt
result <- Ptr PropList -> Ptr Property -> IO CInt
ibus_prop_list_update_property Ptr PropList
propList' 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
propList
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
prop
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PropListUpdatePropertyMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsPropList a, IBus.Property.IsProperty b) => O.OverloadedMethod PropListUpdatePropertyMethodInfo a signature where
    overloadedMethod = propListUpdateProperty

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


#endif