{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An IBusConfigService is a base class for other configuration services such as GConf.
-- Currently, directly known sub class is IBusConfigGConf.
-- 
-- IBusConfigServiceClass has following member functions:
-- \<itemizedlist>
--     \<listitem>
--         \<para>gboolean set_value(IBusConfigService *config, const gchar *section, const gchar *name,
--             const GValue *value, IBusError **error)
--         \<\/para>
--         \<variablelist>
--             \<varlistentry>
--                 \<term>config:\<\/term>
--                 \<listitem>A configure service\<\/listitem>
--             \<\/varlistentry>
--             \<varlistentry>
--                 \<term>section:\<\/term>
--                 \<listitem>Section name of the configuration option.\<\/listitem>
--             \<\/varlistentry>
--             \<varlistentry>
--                 \<term>name:\<\/term>
--                 \<listitem>Name of the configuration option.\<\/listitem>
--             \<\/varlistentry>
--             \<varlistentry>
--                 \<term>value:\<\/term>
--                 \<listitem>GValue that holds the value.\<\/listitem>
--             \<\/varlistentry>
--             \<varlistentry>
--                 \<term>error:\<\/term>
--                 \<listitem>Error outputs here.\<\/listitem>
--             \<\/varlistentry>
--             \<varlistentry>
--                 \<term>Returns:\<\/term>
--                 \<listitem>TRUE if succeed; FALSE otherwise.\<\/listitem>
--             \<\/varlistentry>
--         \<\/variablelist>
--         \<para>Set a value to a configuration option.
--         \<\/para>
--     \<\/listitem>
--     \<listitem>
--         \<para>gboolean get_value(IBusConfigService *config, const gchar *section, const gchar *name,
--             GValue *value, IBusError **error)
--         \<\/para>
--         \<variablelist>
--             \<varlistentry>
--                 \<term>config:\<\/term>
--                 \<listitem>A configure service\<\/listitem>
--             \<\/varlistentry>
--             \<varlistentry>
--                 \<term>section:\<\/term>
--                 \<listitem>Section name of the configuration option.\<\/listitem>
--             \<\/varlistentry>
--             \<varlistentry>
--                 \<term>name:\<\/term>
--                 \<listitem>Name of the configuration option.\<\/listitem>
--             \<\/varlistentry>
--             \<varlistentry>
--                 \<term>value:\<\/term>
--                 \<listitem>GValue that holds the value.\<\/listitem>
--             \<\/varlistentry>
--             \<varlistentry>
--                 \<term>error:\<\/term>
--                 \<listitem>Error outputs here.\<\/listitem>
--             \<\/varlistentry>
--             \<varlistentry>
--                 \<term>Returns:\<\/term>
--                 \<listitem>TRUE if succeed; FALSE otherwise.\<\/listitem>
--             \<\/varlistentry>
--        \<\/variablelist>
--        \<para>Get value of a configuration option.
--        \<\/para>
--     \<\/listitem>
--     \<listitem>
--         \<para>gboolean unset(IBusConfigService *config, const gchar *section, const gchar *name,
--             IBusError **error)
--         \<\/para>
--         \<variablelist>
--             \<varlistentry>
--                 \<term>config:\<\/term>
--                 \<listitem>A configure service\<\/listitem>
--             \<\/varlistentry>
--             \<varlistentry>
--                 \<term>section:\<\/term>
--                 \<listitem>Section name of the configuration option.\<\/listitem>
--             \<\/varlistentry>
--             \<varlistentry>
--                 \<term>name:\<\/term>
--                 \<listitem>Name of the configuration option.\<\/listitem>
--             \<\/varlistentry>
--             \<varlistentry>
--                 \<term>error:\<\/term>
--                 \<listitem>Error outputs here.\<\/listitem>
--             \<\/varlistentry>
--             \<varlistentry>
--                 \<term>Returns:\<\/term>
--                 \<listitem>TRUE if succeed; FALSE otherwise.\<\/listitem>
--             \<\/varlistentry>
--         \<\/variablelist>
--         \<para>Remove an entry to a configuration option.
--         \<\/para>
--     \<\/listitem>
-- \<\/itemizedlist>

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

module GI.IBus.Objects.ConfigService
    ( 

-- * Exported types
    ConfigService(..)                       ,
    IsConfigService                         ,
    toConfigService                         ,


 -- * 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"), [destroy]("GI.IBus.Objects.Object#g:method:destroy"), [emitSignal]("GI.IBus.Objects.Service#g:method:emitSignal"), [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"), [register]("GI.IBus.Objects.Service#g:method:register"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [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"), [unregister]("GI.IBus.Objects.Service#g:method:unregister"), [valueChanged]("GI.IBus.Objects.ConfigService#g:method:valueChanged"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getConnection]("GI.IBus.Objects.Service#g:method:getConnection"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getObjectPath]("GI.IBus.Objects.Service#g:method:getObjectPath"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [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").

#if defined(ENABLE_OVERLOADING)
    ResolveConfigServiceMethod              ,
#endif

-- ** new #method:new#

    configServiceNew                        ,


-- ** valueChanged #method:valueChanged#

#if defined(ENABLE_OVERLOADING)
    ConfigServiceValueChangedMethodInfo     ,
#endif
    configServiceValueChanged               ,




    ) 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 qualified GI.Gio.Objects.DBusConnection as Gio.DBusConnection
import {-# SOURCE #-} qualified GI.IBus.Objects.Object as IBus.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Service as IBus.Service

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

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

foreign import ccall "ibus_config_service_get_type"
    c_ibus_config_service_get_type :: IO B.Types.GType

instance B.Types.TypedObject ConfigService where
    glibType :: IO GType
glibType = IO GType
c_ibus_config_service_get_type

instance B.Types.GObject ConfigService

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

instance O.HasParentTypes ConfigService
type instance O.ParentTypes ConfigService = '[IBus.Service.Service, IBus.Object.Object, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveConfigServiceMethod (t :: Symbol) (o :: *) :: * where
    ResolveConfigServiceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveConfigServiceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveConfigServiceMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    ResolveConfigServiceMethod "emitSignal" o = IBus.Service.ServiceEmitSignalMethodInfo
    ResolveConfigServiceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveConfigServiceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveConfigServiceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveConfigServiceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveConfigServiceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveConfigServiceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveConfigServiceMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveConfigServiceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveConfigServiceMethod "register" o = IBus.Service.ServiceRegisterMethodInfo
    ResolveConfigServiceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveConfigServiceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveConfigServiceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveConfigServiceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveConfigServiceMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveConfigServiceMethod "unregister" o = IBus.Service.ServiceUnregisterMethodInfo
    ResolveConfigServiceMethod "valueChanged" o = ConfigServiceValueChangedMethodInfo
    ResolveConfigServiceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveConfigServiceMethod "getConnection" o = IBus.Service.ServiceGetConnectionMethodInfo
    ResolveConfigServiceMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveConfigServiceMethod "getObjectPath" o = IBus.Service.ServiceGetObjectPathMethodInfo
    ResolveConfigServiceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveConfigServiceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveConfigServiceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveConfigServiceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveConfigServiceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveConfigServiceMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ConfigService
type instance O.AttributeList ConfigService = ConfigServiceAttributeList
type ConfigServiceAttributeList = ('[ '("connection", IBus.Service.ServiceConnectionPropertyInfo), '("objectPath", IBus.Service.ServiceObjectPathPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method ConfigService::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #GDBusConnection."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "IBus" , name = "ConfigService" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_config_service_new" ibus_config_service_new :: 
    Ptr Gio.DBusConnection.DBusConnection -> -- connection : TInterface (Name {namespace = "Gio", name = "DBusConnection"})
    IO (Ptr ConfigService)

-- | Creates an new t'GI.IBus.Objects.ConfigService.ConfigService' from an t'GI.Gio.Objects.DBusConnection.DBusConnection'.
configServiceNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.DBusConnection.IsDBusConnection a) =>
    a
    -- ^ /@connection@/: An t'GI.Gio.Objects.DBusConnection.DBusConnection'.
    -> m ConfigService
    -- ^ __Returns:__ A newly allocated @/IBusConfigServices/@.
configServiceNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusConnection a) =>
a -> m ConfigService
configServiceNew a
connection = IO ConfigService -> m ConfigService
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ConfigService -> m ConfigService)
-> IO ConfigService -> m ConfigService
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusConnection
connection' <- a -> IO (Ptr DBusConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
    Ptr ConfigService
result <- Ptr DBusConnection -> IO (Ptr ConfigService)
ibus_config_service_new Ptr DBusConnection
connection'
    Text -> Ptr ConfigService -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"configServiceNew" Ptr ConfigService
result
    ConfigService
result' <- ((ManagedPtr ConfigService -> ConfigService)
-> Ptr ConfigService -> IO ConfigService
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ConfigService -> ConfigService
ConfigService) Ptr ConfigService
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
    ConfigService -> IO ConfigService
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigService
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ConfigService::value_changed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "ConfigService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusConfigService."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "section"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Section name of the configuration option."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of the configure option."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GVariant that holds the value."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_config_service_value_changed" ibus_config_service_value_changed :: 
    Ptr ConfigService ->                    -- config : TInterface (Name {namespace = "IBus", name = "ConfigService"})
    CString ->                              -- section : TBasicType TUTF8
    CString ->                              -- name : TBasicType TUTF8
    Ptr GVariant ->                         -- value : TVariant
    IO ()

-- | Change a value of a configuration option
-- by sending a \"ValueChanged\" message to IBus service.
configServiceValueChanged ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfigService a) =>
    a
    -- ^ /@config@/: An IBusConfigService.
    -> T.Text
    -- ^ /@section@/: Section name of the configuration option.
    -> T.Text
    -- ^ /@name@/: Name of the configure option.
    -> GVariant
    -- ^ /@value@/: GVariant that holds the value.
    -> m ()
configServiceValueChanged :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsConfigService a) =>
a -> Text -> Text -> GVariant -> m ()
configServiceValueChanged a
config Text
section Text
name GVariant
value = 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 ConfigService
config' <- a -> IO (Ptr ConfigService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    CString
section' <- Text -> IO CString
textToCString Text
section
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GVariant
value' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
value
    Ptr ConfigService -> CString -> CString -> Ptr GVariant -> IO ()
ibus_config_service_value_changed Ptr ConfigService
config' CString
section' CString
name' Ptr GVariant
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
section'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ConfigServiceValueChangedMethodInfo
instance (signature ~ (T.Text -> T.Text -> GVariant -> m ()), MonadIO m, IsConfigService a) => O.OverloadedMethod ConfigServiceValueChangedMethodInfo a signature where
    overloadedMethod = configServiceValueChanged

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


#endif