{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An IBusBus connects with IBus daemon.

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

module GI.IBus.Objects.Bus
    ( 

-- * Exported types
    Bus(..)                                 ,
    IsBus                                   ,
    toBus                                   ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveBusMethod                        ,
#endif


-- ** addMatch #method:addMatch#

#if defined(ENABLE_OVERLOADING)
    BusAddMatchMethodInfo                   ,
#endif
    busAddMatch                             ,


-- ** addMatchAsync #method:addMatchAsync#

#if defined(ENABLE_OVERLOADING)
    BusAddMatchAsyncMethodInfo              ,
#endif
    busAddMatchAsync                        ,


-- ** addMatchAsyncFinish #method:addMatchAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusAddMatchAsyncFinishMethodInfo        ,
#endif
    busAddMatchAsyncFinish                  ,


-- ** createInputContext #method:createInputContext#

#if defined(ENABLE_OVERLOADING)
    BusCreateInputContextMethodInfo         ,
#endif
    busCreateInputContext                   ,


-- ** createInputContextAsync #method:createInputContextAsync#

#if defined(ENABLE_OVERLOADING)
    BusCreateInputContextAsyncMethodInfo    ,
#endif
    busCreateInputContextAsync              ,


-- ** createInputContextAsyncFinish #method:createInputContextAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusCreateInputContextAsyncFinishMethodInfo,
#endif
    busCreateInputContextAsyncFinish        ,


-- ** currentInputContext #method:currentInputContext#

#if defined(ENABLE_OVERLOADING)
    BusCurrentInputContextMethodInfo        ,
#endif
    busCurrentInputContext                  ,


-- ** currentInputContextAsync #method:currentInputContextAsync#

#if defined(ENABLE_OVERLOADING)
    BusCurrentInputContextAsyncMethodInfo   ,
#endif
    busCurrentInputContextAsync             ,


-- ** currentInputContextAsyncFinish #method:currentInputContextAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusCurrentInputContextAsyncFinishMethodInfo,
#endif
    busCurrentInputContextAsyncFinish       ,


-- ** exit #method:exit#

#if defined(ENABLE_OVERLOADING)
    BusExitMethodInfo                       ,
#endif
    busExit                                 ,


-- ** exitAsync #method:exitAsync#

#if defined(ENABLE_OVERLOADING)
    BusExitAsyncMethodInfo                  ,
#endif
    busExitAsync                            ,


-- ** exitAsyncFinish #method:exitAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusExitAsyncFinishMethodInfo            ,
#endif
    busExitAsyncFinish                      ,


-- ** getConfig #method:getConfig#

#if defined(ENABLE_OVERLOADING)
    BusGetConfigMethodInfo                  ,
#endif
    busGetConfig                            ,


-- ** getConnection #method:getConnection#

#if defined(ENABLE_OVERLOADING)
    BusGetConnectionMethodInfo              ,
#endif
    busGetConnection                        ,


-- ** getEnginesByNames #method:getEnginesByNames#

#if defined(ENABLE_OVERLOADING)
    BusGetEnginesByNamesMethodInfo          ,
#endif
    busGetEnginesByNames                    ,


-- ** getGlobalEngine #method:getGlobalEngine#

#if defined(ENABLE_OVERLOADING)
    BusGetGlobalEngineMethodInfo            ,
#endif
    busGetGlobalEngine                      ,


-- ** getGlobalEngineAsync #method:getGlobalEngineAsync#

#if defined(ENABLE_OVERLOADING)
    BusGetGlobalEngineAsyncMethodInfo       ,
#endif
    busGetGlobalEngineAsync                 ,


-- ** getGlobalEngineAsyncFinish #method:getGlobalEngineAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusGetGlobalEngineAsyncFinishMethodInfo ,
#endif
    busGetGlobalEngineAsyncFinish           ,


-- ** getIbusProperty #method:getIbusProperty#

#if defined(ENABLE_OVERLOADING)
    BusGetIbusPropertyMethodInfo            ,
#endif
    busGetIbusProperty                      ,


-- ** getIbusPropertyAsync #method:getIbusPropertyAsync#

#if defined(ENABLE_OVERLOADING)
    BusGetIbusPropertyAsyncMethodInfo       ,
#endif
    busGetIbusPropertyAsync                 ,


-- ** getIbusPropertyAsyncFinish #method:getIbusPropertyAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusGetIbusPropertyAsyncFinishMethodInfo ,
#endif
    busGetIbusPropertyAsyncFinish           ,


-- ** getNameOwner #method:getNameOwner#

#if defined(ENABLE_OVERLOADING)
    BusGetNameOwnerMethodInfo               ,
#endif
    busGetNameOwner                         ,


-- ** getNameOwnerAsync #method:getNameOwnerAsync#

#if defined(ENABLE_OVERLOADING)
    BusGetNameOwnerAsyncMethodInfo          ,
#endif
    busGetNameOwnerAsync                    ,


-- ** getNameOwnerAsyncFinish #method:getNameOwnerAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusGetNameOwnerAsyncFinishMethodInfo    ,
#endif
    busGetNameOwnerAsyncFinish              ,


-- ** getServiceName #method:getServiceName#

#if defined(ENABLE_OVERLOADING)
    BusGetServiceNameMethodInfo             ,
#endif
    busGetServiceName                       ,


-- ** getUseGlobalEngine #method:getUseGlobalEngine#

#if defined(ENABLE_OVERLOADING)
    BusGetUseGlobalEngineMethodInfo         ,
#endif
    busGetUseGlobalEngine                   ,


-- ** getUseGlobalEngineAsync #method:getUseGlobalEngineAsync#

#if defined(ENABLE_OVERLOADING)
    BusGetUseGlobalEngineAsyncMethodInfo    ,
#endif
    busGetUseGlobalEngineAsync              ,


-- ** getUseGlobalEngineAsyncFinish #method:getUseGlobalEngineAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusGetUseGlobalEngineAsyncFinishMethodInfo,
#endif
    busGetUseGlobalEngineAsyncFinish        ,


-- ** getUseSysLayout #method:getUseSysLayout#

#if defined(ENABLE_OVERLOADING)
    BusGetUseSysLayoutMethodInfo            ,
#endif
    busGetUseSysLayout                      ,


-- ** getUseSysLayoutAsync #method:getUseSysLayoutAsync#

#if defined(ENABLE_OVERLOADING)
    BusGetUseSysLayoutAsyncMethodInfo       ,
#endif
    busGetUseSysLayoutAsync                 ,


-- ** getUseSysLayoutAsyncFinish #method:getUseSysLayoutAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusGetUseSysLayoutAsyncFinishMethodInfo ,
#endif
    busGetUseSysLayoutAsyncFinish           ,


-- ** hello #method:hello#

#if defined(ENABLE_OVERLOADING)
    BusHelloMethodInfo                      ,
#endif
    busHello                                ,


-- ** isConnected #method:isConnected#

#if defined(ENABLE_OVERLOADING)
    BusIsConnectedMethodInfo                ,
#endif
    busIsConnected                          ,


-- ** isGlobalEngineEnabled #method:isGlobalEngineEnabled#

#if defined(ENABLE_OVERLOADING)
    BusIsGlobalEngineEnabledMethodInfo      ,
#endif
    busIsGlobalEngineEnabled                ,


-- ** isGlobalEngineEnabledAsync #method:isGlobalEngineEnabledAsync#

#if defined(ENABLE_OVERLOADING)
    BusIsGlobalEngineEnabledAsyncMethodInfo ,
#endif
    busIsGlobalEngineEnabledAsync           ,


-- ** isGlobalEngineEnabledAsyncFinish #method:isGlobalEngineEnabledAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusIsGlobalEngineEnabledAsyncFinishMethodInfo,
#endif
    busIsGlobalEngineEnabledAsyncFinish     ,


-- ** listActiveEngines #method:listActiveEngines#

#if defined(ENABLE_OVERLOADING)
    BusListActiveEnginesMethodInfo          ,
#endif
    busListActiveEngines                    ,


-- ** listActiveEnginesAsync #method:listActiveEnginesAsync#

#if defined(ENABLE_OVERLOADING)
    BusListActiveEnginesAsyncMethodInfo     ,
#endif
    busListActiveEnginesAsync               ,


-- ** listActiveEnginesAsyncFinish #method:listActiveEnginesAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusListActiveEnginesAsyncFinishMethodInfo,
#endif
    busListActiveEnginesAsyncFinish         ,


-- ** listEngines #method:listEngines#

#if defined(ENABLE_OVERLOADING)
    BusListEnginesMethodInfo                ,
#endif
    busListEngines                          ,


-- ** listEnginesAsync #method:listEnginesAsync#

#if defined(ENABLE_OVERLOADING)
    BusListEnginesAsyncMethodInfo           ,
#endif
    busListEnginesAsync                     ,


-- ** listEnginesAsyncFinish #method:listEnginesAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusListEnginesAsyncFinishMethodInfo     ,
#endif
    busListEnginesAsyncFinish               ,


-- ** listNames #method:listNames#

#if defined(ENABLE_OVERLOADING)
    BusListNamesMethodInfo                  ,
#endif
    busListNames                            ,


-- ** listQueuedOwners #method:listQueuedOwners#

#if defined(ENABLE_OVERLOADING)
    BusListQueuedOwnersMethodInfo           ,
#endif
    busListQueuedOwners                     ,


-- ** nameHasOwner #method:nameHasOwner#

#if defined(ENABLE_OVERLOADING)
    BusNameHasOwnerMethodInfo               ,
#endif
    busNameHasOwner                         ,


-- ** nameHasOwnerAsync #method:nameHasOwnerAsync#

#if defined(ENABLE_OVERLOADING)
    BusNameHasOwnerAsyncMethodInfo          ,
#endif
    busNameHasOwnerAsync                    ,


-- ** nameHasOwnerAsyncFinish #method:nameHasOwnerAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusNameHasOwnerAsyncFinishMethodInfo    ,
#endif
    busNameHasOwnerAsyncFinish              ,


-- ** new #method:new#

    busNew                                  ,


-- ** newAsync #method:newAsync#

    busNewAsync                             ,


-- ** newAsyncClient #method:newAsyncClient#

    busNewAsyncClient                       ,


-- ** preloadEngines #method:preloadEngines#

#if defined(ENABLE_OVERLOADING)
    BusPreloadEnginesMethodInfo             ,
#endif
    busPreloadEngines                       ,


-- ** preloadEnginesAsync #method:preloadEnginesAsync#

#if defined(ENABLE_OVERLOADING)
    BusPreloadEnginesAsyncMethodInfo        ,
#endif
    busPreloadEnginesAsync                  ,


-- ** preloadEnginesAsyncFinish #method:preloadEnginesAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusPreloadEnginesAsyncFinishMethodInfo  ,
#endif
    busPreloadEnginesAsyncFinish            ,


-- ** registerComponent #method:registerComponent#

#if defined(ENABLE_OVERLOADING)
    BusRegisterComponentMethodInfo          ,
#endif
    busRegisterComponent                    ,


-- ** registerComponentAsync #method:registerComponentAsync#

#if defined(ENABLE_OVERLOADING)
    BusRegisterComponentAsyncMethodInfo     ,
#endif
    busRegisterComponentAsync               ,


-- ** registerComponentAsyncFinish #method:registerComponentAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusRegisterComponentAsyncFinishMethodInfo,
#endif
    busRegisterComponentAsyncFinish         ,


-- ** releaseName #method:releaseName#

#if defined(ENABLE_OVERLOADING)
    BusReleaseNameMethodInfo                ,
#endif
    busReleaseName                          ,


-- ** releaseNameAsync #method:releaseNameAsync#

#if defined(ENABLE_OVERLOADING)
    BusReleaseNameAsyncMethodInfo           ,
#endif
    busReleaseNameAsync                     ,


-- ** releaseNameAsyncFinish #method:releaseNameAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusReleaseNameAsyncFinishMethodInfo     ,
#endif
    busReleaseNameAsyncFinish               ,


-- ** removeMatch #method:removeMatch#

#if defined(ENABLE_OVERLOADING)
    BusRemoveMatchMethodInfo                ,
#endif
    busRemoveMatch                          ,


-- ** removeMatchAsync #method:removeMatchAsync#

#if defined(ENABLE_OVERLOADING)
    BusRemoveMatchAsyncMethodInfo           ,
#endif
    busRemoveMatchAsync                     ,


-- ** removeMatchAsyncFinish #method:removeMatchAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusRemoveMatchAsyncFinishMethodInfo     ,
#endif
    busRemoveMatchAsyncFinish               ,


-- ** requestName #method:requestName#

#if defined(ENABLE_OVERLOADING)
    BusRequestNameMethodInfo                ,
#endif
    busRequestName                          ,


-- ** requestNameAsync #method:requestNameAsync#

#if defined(ENABLE_OVERLOADING)
    BusRequestNameAsyncMethodInfo           ,
#endif
    busRequestNameAsync                     ,


-- ** requestNameAsyncFinish #method:requestNameAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusRequestNameAsyncFinishMethodInfo     ,
#endif
    busRequestNameAsyncFinish               ,


-- ** setGlobalEngine #method:setGlobalEngine#

#if defined(ENABLE_OVERLOADING)
    BusSetGlobalEngineMethodInfo            ,
#endif
    busSetGlobalEngine                      ,


-- ** setGlobalEngineAsync #method:setGlobalEngineAsync#

#if defined(ENABLE_OVERLOADING)
    BusSetGlobalEngineAsyncMethodInfo       ,
#endif
    busSetGlobalEngineAsync                 ,


-- ** setGlobalEngineAsyncFinish #method:setGlobalEngineAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusSetGlobalEngineAsyncFinishMethodInfo ,
#endif
    busSetGlobalEngineAsyncFinish           ,


-- ** setIbusProperty #method:setIbusProperty#

#if defined(ENABLE_OVERLOADING)
    BusSetIbusPropertyMethodInfo            ,
#endif
    busSetIbusProperty                      ,


-- ** setIbusPropertyAsync #method:setIbusPropertyAsync#

#if defined(ENABLE_OVERLOADING)
    BusSetIbusPropertyAsyncMethodInfo       ,
#endif
    busSetIbusPropertyAsync                 ,


-- ** setIbusPropertyAsyncFinish #method:setIbusPropertyAsyncFinish#

#if defined(ENABLE_OVERLOADING)
    BusSetIbusPropertyAsyncFinishMethodInfo ,
#endif
    busSetIbusPropertyAsyncFinish           ,


-- ** setWatchDbusSignal #method:setWatchDbusSignal#

#if defined(ENABLE_OVERLOADING)
    BusSetWatchDbusSignalMethodInfo         ,
#endif
    busSetWatchDbusSignal                   ,


-- ** setWatchIbusSignal #method:setWatchIbusSignal#

#if defined(ENABLE_OVERLOADING)
    BusSetWatchIbusSignalMethodInfo         ,
#endif
    busSetWatchIbusSignal                   ,




 -- * Properties
-- ** clientOnly #attr:clientOnly#
-- | Whether the t'GI.IBus.Objects.Bus.Bus' object is for client use only.

#if defined(ENABLE_OVERLOADING)
    BusClientOnlyPropertyInfo               ,
#endif
#if defined(ENABLE_OVERLOADING)
    busClientOnly                           ,
#endif
    constructBusClientOnly                  ,
    getBusClientOnly                        ,


-- ** connectAsync #attr:connectAsync#
-- | Whether the t'GI.IBus.Objects.Bus.Bus' object should connect asynchronously to the bus.

#if defined(ENABLE_OVERLOADING)
    BusConnectAsyncPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    busConnectAsync                         ,
#endif
    constructBusConnectAsync                ,
    getBusConnectAsync                      ,




 -- * Signals
-- ** connected #signal:connected#

    BusConnectedCallback                    ,
#if defined(ENABLE_OVERLOADING)
    BusConnectedSignalInfo                  ,
#endif
    C_BusConnectedCallback                  ,
    afterBusConnected                       ,
    genClosure_BusConnected                 ,
    mk_BusConnectedCallback                 ,
    noBusConnectedCallback                  ,
    onBusConnected                          ,
    wrap_BusConnectedCallback               ,


-- ** disconnected #signal:disconnected#

    BusDisconnectedCallback                 ,
#if defined(ENABLE_OVERLOADING)
    BusDisconnectedSignalInfo               ,
#endif
    C_BusDisconnectedCallback               ,
    afterBusDisconnected                    ,
    genClosure_BusDisconnected              ,
    mk_BusDisconnectedCallback              ,
    noBusDisconnectedCallback               ,
    onBusDisconnected                       ,
    wrap_BusDisconnectedCallback            ,


-- ** globalEngineChanged #signal:globalEngineChanged#

    BusGlobalEngineChangedCallback          ,
#if defined(ENABLE_OVERLOADING)
    BusGlobalEngineChangedSignalInfo        ,
#endif
    C_BusGlobalEngineChangedCallback        ,
    afterBusGlobalEngineChanged             ,
    genClosure_BusGlobalEngineChanged       ,
    mk_BusGlobalEngineChangedCallback       ,
    noBusGlobalEngineChangedCallback        ,
    onBusGlobalEngineChanged                ,
    wrap_BusGlobalEngineChangedCallback     ,


-- ** nameOwnerChanged #signal:nameOwnerChanged#

    BusNameOwnerChangedCallback             ,
#if defined(ENABLE_OVERLOADING)
    BusNameOwnerChangedSignalInfo           ,
#endif
    C_BusNameOwnerChangedCallback           ,
    afterBusNameOwnerChanged                ,
    genClosure_BusNameOwnerChanged          ,
    mk_BusNameOwnerChangedCallback          ,
    noBusNameOwnerChangedCallback           ,
    onBusNameOwnerChanged                   ,
    wrap_BusNameOwnerChangedCallback        ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.DBusConnection as Gio.DBusConnection
import {-# SOURCE #-} qualified GI.IBus.Objects.Component as IBus.Component
import {-# SOURCE #-} qualified GI.IBus.Objects.Config as IBus.Config
import {-# SOURCE #-} qualified GI.IBus.Objects.EngineDesc as IBus.EngineDesc
import {-# SOURCE #-} qualified GI.IBus.Objects.InputContext as IBus.InputContext
import {-# SOURCE #-} qualified GI.IBus.Objects.Object as IBus.Object

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

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

foreign import ccall "ibus_bus_get_type"
    c_ibus_bus_get_type :: IO B.Types.GType

instance B.Types.TypedObject Bus where
    glibType :: IO GType
glibType = IO GType
c_ibus_bus_get_type

instance B.Types.GObject Bus

-- | Convert 'Bus' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Bus where
    toGValue :: Bus -> IO GValue
toGValue Bus
o = do
        GType
gtype <- IO GType
c_ibus_bus_get_type
        Bus -> (Ptr Bus -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Bus
o (GType -> (GValue -> Ptr Bus -> IO ()) -> Ptr Bus -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Bus -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Bus
fromGValue GValue
gv = do
        Ptr Bus
ptr <- GValue -> IO (Ptr Bus)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Bus)
        (ManagedPtr Bus -> Bus) -> Ptr Bus -> IO Bus
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Bus -> Bus
Bus Ptr Bus
ptr
        
    

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveBusMethod (t :: Symbol) (o :: *) :: * where
    ResolveBusMethod "addMatch" o = BusAddMatchMethodInfo
    ResolveBusMethod "addMatchAsync" o = BusAddMatchAsyncMethodInfo
    ResolveBusMethod "addMatchAsyncFinish" o = BusAddMatchAsyncFinishMethodInfo
    ResolveBusMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveBusMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveBusMethod "createInputContext" o = BusCreateInputContextMethodInfo
    ResolveBusMethod "createInputContextAsync" o = BusCreateInputContextAsyncMethodInfo
    ResolveBusMethod "createInputContextAsyncFinish" o = BusCreateInputContextAsyncFinishMethodInfo
    ResolveBusMethod "currentInputContext" o = BusCurrentInputContextMethodInfo
    ResolveBusMethod "currentInputContextAsync" o = BusCurrentInputContextAsyncMethodInfo
    ResolveBusMethod "currentInputContextAsyncFinish" o = BusCurrentInputContextAsyncFinishMethodInfo
    ResolveBusMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    ResolveBusMethod "exit" o = BusExitMethodInfo
    ResolveBusMethod "exitAsync" o = BusExitAsyncMethodInfo
    ResolveBusMethod "exitAsyncFinish" o = BusExitAsyncFinishMethodInfo
    ResolveBusMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveBusMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveBusMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveBusMethod "hello" o = BusHelloMethodInfo
    ResolveBusMethod "isConnected" o = BusIsConnectedMethodInfo
    ResolveBusMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveBusMethod "isGlobalEngineEnabled" o = BusIsGlobalEngineEnabledMethodInfo
    ResolveBusMethod "isGlobalEngineEnabledAsync" o = BusIsGlobalEngineEnabledAsyncMethodInfo
    ResolveBusMethod "isGlobalEngineEnabledAsyncFinish" o = BusIsGlobalEngineEnabledAsyncFinishMethodInfo
    ResolveBusMethod "listActiveEngines" o = BusListActiveEnginesMethodInfo
    ResolveBusMethod "listActiveEnginesAsync" o = BusListActiveEnginesAsyncMethodInfo
    ResolveBusMethod "listActiveEnginesAsyncFinish" o = BusListActiveEnginesAsyncFinishMethodInfo
    ResolveBusMethod "listEngines" o = BusListEnginesMethodInfo
    ResolveBusMethod "listEnginesAsync" o = BusListEnginesAsyncMethodInfo
    ResolveBusMethod "listEnginesAsyncFinish" o = BusListEnginesAsyncFinishMethodInfo
    ResolveBusMethod "listNames" o = BusListNamesMethodInfo
    ResolveBusMethod "listQueuedOwners" o = BusListQueuedOwnersMethodInfo
    ResolveBusMethod "nameHasOwner" o = BusNameHasOwnerMethodInfo
    ResolveBusMethod "nameHasOwnerAsync" o = BusNameHasOwnerAsyncMethodInfo
    ResolveBusMethod "nameHasOwnerAsyncFinish" o = BusNameHasOwnerAsyncFinishMethodInfo
    ResolveBusMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveBusMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveBusMethod "preloadEngines" o = BusPreloadEnginesMethodInfo
    ResolveBusMethod "preloadEnginesAsync" o = BusPreloadEnginesAsyncMethodInfo
    ResolveBusMethod "preloadEnginesAsyncFinish" o = BusPreloadEnginesAsyncFinishMethodInfo
    ResolveBusMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveBusMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveBusMethod "registerComponent" o = BusRegisterComponentMethodInfo
    ResolveBusMethod "registerComponentAsync" o = BusRegisterComponentAsyncMethodInfo
    ResolveBusMethod "registerComponentAsyncFinish" o = BusRegisterComponentAsyncFinishMethodInfo
    ResolveBusMethod "releaseName" o = BusReleaseNameMethodInfo
    ResolveBusMethod "releaseNameAsync" o = BusReleaseNameAsyncMethodInfo
    ResolveBusMethod "releaseNameAsyncFinish" o = BusReleaseNameAsyncFinishMethodInfo
    ResolveBusMethod "removeMatch" o = BusRemoveMatchMethodInfo
    ResolveBusMethod "removeMatchAsync" o = BusRemoveMatchAsyncMethodInfo
    ResolveBusMethod "removeMatchAsyncFinish" o = BusRemoveMatchAsyncFinishMethodInfo
    ResolveBusMethod "requestName" o = BusRequestNameMethodInfo
    ResolveBusMethod "requestNameAsync" o = BusRequestNameAsyncMethodInfo
    ResolveBusMethod "requestNameAsyncFinish" o = BusRequestNameAsyncFinishMethodInfo
    ResolveBusMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveBusMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveBusMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveBusMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveBusMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveBusMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveBusMethod "getConfig" o = BusGetConfigMethodInfo
    ResolveBusMethod "getConnection" o = BusGetConnectionMethodInfo
    ResolveBusMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveBusMethod "getEnginesByNames" o = BusGetEnginesByNamesMethodInfo
    ResolveBusMethod "getGlobalEngine" o = BusGetGlobalEngineMethodInfo
    ResolveBusMethod "getGlobalEngineAsync" o = BusGetGlobalEngineAsyncMethodInfo
    ResolveBusMethod "getGlobalEngineAsyncFinish" o = BusGetGlobalEngineAsyncFinishMethodInfo
    ResolveBusMethod "getIbusProperty" o = BusGetIbusPropertyMethodInfo
    ResolveBusMethod "getIbusPropertyAsync" o = BusGetIbusPropertyAsyncMethodInfo
    ResolveBusMethod "getIbusPropertyAsyncFinish" o = BusGetIbusPropertyAsyncFinishMethodInfo
    ResolveBusMethod "getNameOwner" o = BusGetNameOwnerMethodInfo
    ResolveBusMethod "getNameOwnerAsync" o = BusGetNameOwnerAsyncMethodInfo
    ResolveBusMethod "getNameOwnerAsyncFinish" o = BusGetNameOwnerAsyncFinishMethodInfo
    ResolveBusMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveBusMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveBusMethod "getServiceName" o = BusGetServiceNameMethodInfo
    ResolveBusMethod "getUseGlobalEngine" o = BusGetUseGlobalEngineMethodInfo
    ResolveBusMethod "getUseGlobalEngineAsync" o = BusGetUseGlobalEngineAsyncMethodInfo
    ResolveBusMethod "getUseGlobalEngineAsyncFinish" o = BusGetUseGlobalEngineAsyncFinishMethodInfo
    ResolveBusMethod "getUseSysLayout" o = BusGetUseSysLayoutMethodInfo
    ResolveBusMethod "getUseSysLayoutAsync" o = BusGetUseSysLayoutAsyncMethodInfo
    ResolveBusMethod "getUseSysLayoutAsyncFinish" o = BusGetUseSysLayoutAsyncFinishMethodInfo
    ResolveBusMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveBusMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveBusMethod "setGlobalEngine" o = BusSetGlobalEngineMethodInfo
    ResolveBusMethod "setGlobalEngineAsync" o = BusSetGlobalEngineAsyncMethodInfo
    ResolveBusMethod "setGlobalEngineAsyncFinish" o = BusSetGlobalEngineAsyncFinishMethodInfo
    ResolveBusMethod "setIbusProperty" o = BusSetIbusPropertyMethodInfo
    ResolveBusMethod "setIbusPropertyAsync" o = BusSetIbusPropertyAsyncMethodInfo
    ResolveBusMethod "setIbusPropertyAsyncFinish" o = BusSetIbusPropertyAsyncFinishMethodInfo
    ResolveBusMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveBusMethod "setWatchDbusSignal" o = BusSetWatchDbusSignalMethodInfo
    ResolveBusMethod "setWatchIbusSignal" o = BusSetWatchIbusSignalMethodInfo
    ResolveBusMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal Bus::connected
-- | Emitted when t'GI.IBus.Objects.Bus.Bus' is connected to ibus-daemon.
type BusConnectedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `BusConnectedCallback`@.
noBusConnectedCallback :: Maybe BusConnectedCallback
noBusConnectedCallback :: Maybe (IO ())
noBusConnectedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_BusConnectedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_BusConnectedCallback`.
foreign import ccall "wrapper"
    mk_BusConnectedCallback :: C_BusConnectedCallback -> IO (FunPtr C_BusConnectedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_BusConnected :: MonadIO m => BusConnectedCallback -> m (GClosure C_BusConnectedCallback)
genClosure_BusConnected :: IO () -> m (GClosure C_BusConnectedCallback)
genClosure_BusConnected IO ()
cb = IO (GClosure C_BusConnectedCallback)
-> m (GClosure C_BusConnectedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_BusConnectedCallback)
 -> m (GClosure C_BusConnectedCallback))
-> IO (GClosure C_BusConnectedCallback)
-> m (GClosure C_BusConnectedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BusConnectedCallback
cb' = IO () -> C_BusConnectedCallback
wrap_BusConnectedCallback IO ()
cb
    C_BusConnectedCallback -> IO (FunPtr C_BusConnectedCallback)
mk_BusConnectedCallback C_BusConnectedCallback
cb' IO (FunPtr C_BusConnectedCallback)
-> (FunPtr C_BusConnectedCallback
    -> IO (GClosure C_BusConnectedCallback))
-> IO (GClosure C_BusConnectedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_BusConnectedCallback
-> IO (GClosure C_BusConnectedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `BusConnectedCallback` into a `C_BusConnectedCallback`.
wrap_BusConnectedCallback ::
    BusConnectedCallback ->
    C_BusConnectedCallback
wrap_BusConnectedCallback :: IO () -> C_BusConnectedCallback
wrap_BusConnectedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [connected](#signal:connected) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' bus #connected callback
-- @
-- 
-- 
onBusConnected :: (IsBus a, MonadIO m) => a -> BusConnectedCallback -> m SignalHandlerId
onBusConnected :: a -> IO () -> m SignalHandlerId
onBusConnected a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BusConnectedCallback
cb' = IO () -> C_BusConnectedCallback
wrap_BusConnectedCallback IO ()
cb
    FunPtr C_BusConnectedCallback
cb'' <- C_BusConnectedCallback -> IO (FunPtr C_BusConnectedCallback)
mk_BusConnectedCallback C_BusConnectedCallback
cb'
    a
-> Text
-> FunPtr C_BusConnectedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"connected" FunPtr C_BusConnectedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [connected](#signal:connected) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' bus #connected callback
-- @
-- 
-- 
afterBusConnected :: (IsBus a, MonadIO m) => a -> BusConnectedCallback -> m SignalHandlerId
afterBusConnected :: a -> IO () -> m SignalHandlerId
afterBusConnected a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BusConnectedCallback
cb' = IO () -> C_BusConnectedCallback
wrap_BusConnectedCallback IO ()
cb
    FunPtr C_BusConnectedCallback
cb'' <- C_BusConnectedCallback -> IO (FunPtr C_BusConnectedCallback)
mk_BusConnectedCallback C_BusConnectedCallback
cb'
    a
-> Text
-> FunPtr C_BusConnectedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"connected" FunPtr C_BusConnectedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data BusConnectedSignalInfo
instance SignalInfo BusConnectedSignalInfo where
    type HaskellCallbackType BusConnectedSignalInfo = BusConnectedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_BusConnectedCallback cb
        cb'' <- mk_BusConnectedCallback cb'
        connectSignalFunPtr obj "connected" cb'' connectMode detail

#endif

-- signal Bus::disconnected
-- | Emitted when t'GI.IBus.Objects.Bus.Bus' is disconnected from ibus-daemon.
type BusDisconnectedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `BusDisconnectedCallback`@.
noBusDisconnectedCallback :: Maybe BusDisconnectedCallback
noBusDisconnectedCallback :: Maybe (IO ())
noBusDisconnectedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_BusDisconnectedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_BusDisconnectedCallback`.
foreign import ccall "wrapper"
    mk_BusDisconnectedCallback :: C_BusDisconnectedCallback -> IO (FunPtr C_BusDisconnectedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_BusDisconnected :: MonadIO m => BusDisconnectedCallback -> m (GClosure C_BusDisconnectedCallback)
genClosure_BusDisconnected :: IO () -> m (GClosure C_BusConnectedCallback)
genClosure_BusDisconnected IO ()
cb = IO (GClosure C_BusConnectedCallback)
-> m (GClosure C_BusConnectedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_BusConnectedCallback)
 -> m (GClosure C_BusConnectedCallback))
-> IO (GClosure C_BusConnectedCallback)
-> m (GClosure C_BusConnectedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BusConnectedCallback
cb' = IO () -> C_BusConnectedCallback
wrap_BusDisconnectedCallback IO ()
cb
    C_BusConnectedCallback -> IO (FunPtr C_BusConnectedCallback)
mk_BusDisconnectedCallback C_BusConnectedCallback
cb' IO (FunPtr C_BusConnectedCallback)
-> (FunPtr C_BusConnectedCallback
    -> IO (GClosure C_BusConnectedCallback))
-> IO (GClosure C_BusConnectedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_BusConnectedCallback
-> IO (GClosure C_BusConnectedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `BusDisconnectedCallback` into a `C_BusDisconnectedCallback`.
wrap_BusDisconnectedCallback ::
    BusDisconnectedCallback ->
    C_BusDisconnectedCallback
wrap_BusDisconnectedCallback :: IO () -> C_BusConnectedCallback
wrap_BusDisconnectedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [disconnected](#signal:disconnected) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' bus #disconnected callback
-- @
-- 
-- 
onBusDisconnected :: (IsBus a, MonadIO m) => a -> BusDisconnectedCallback -> m SignalHandlerId
onBusDisconnected :: a -> IO () -> m SignalHandlerId
onBusDisconnected a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BusConnectedCallback
cb' = IO () -> C_BusConnectedCallback
wrap_BusDisconnectedCallback IO ()
cb
    FunPtr C_BusConnectedCallback
cb'' <- C_BusConnectedCallback -> IO (FunPtr C_BusConnectedCallback)
mk_BusDisconnectedCallback C_BusConnectedCallback
cb'
    a
-> Text
-> FunPtr C_BusConnectedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"disconnected" FunPtr C_BusConnectedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [disconnected](#signal:disconnected) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' bus #disconnected callback
-- @
-- 
-- 
afterBusDisconnected :: (IsBus a, MonadIO m) => a -> BusDisconnectedCallback -> m SignalHandlerId
afterBusDisconnected :: a -> IO () -> m SignalHandlerId
afterBusDisconnected a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BusConnectedCallback
cb' = IO () -> C_BusConnectedCallback
wrap_BusDisconnectedCallback IO ()
cb
    FunPtr C_BusConnectedCallback
cb'' <- C_BusConnectedCallback -> IO (FunPtr C_BusConnectedCallback)
mk_BusDisconnectedCallback C_BusConnectedCallback
cb'
    a
-> Text
-> FunPtr C_BusConnectedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"disconnected" FunPtr C_BusConnectedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data BusDisconnectedSignalInfo
instance SignalInfo BusDisconnectedSignalInfo where
    type HaskellCallbackType BusDisconnectedSignalInfo = BusDisconnectedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_BusDisconnectedCallback cb
        cb'' <- mk_BusDisconnectedCallback cb'
        connectSignalFunPtr obj "disconnected" cb'' connectMode detail

#endif

-- signal Bus::global-engine-changed
-- | Emitted when global engine is changed.
type BusGlobalEngineChangedCallback =
    T.Text
    -- ^ /@name@/: The name of the new global engine.
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `BusGlobalEngineChangedCallback`@.
noBusGlobalEngineChangedCallback :: Maybe BusGlobalEngineChangedCallback
noBusGlobalEngineChangedCallback :: Maybe BusGlobalEngineChangedCallback
noBusGlobalEngineChangedCallback = Maybe BusGlobalEngineChangedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_BusGlobalEngineChangedCallback =
    Ptr () ->                               -- object
    CString ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_BusGlobalEngineChangedCallback`.
foreign import ccall "wrapper"
    mk_BusGlobalEngineChangedCallback :: C_BusGlobalEngineChangedCallback -> IO (FunPtr C_BusGlobalEngineChangedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_BusGlobalEngineChanged :: MonadIO m => BusGlobalEngineChangedCallback -> m (GClosure C_BusGlobalEngineChangedCallback)
genClosure_BusGlobalEngineChanged :: BusGlobalEngineChangedCallback
-> m (GClosure C_BusGlobalEngineChangedCallback)
genClosure_BusGlobalEngineChanged BusGlobalEngineChangedCallback
cb = IO (GClosure C_BusGlobalEngineChangedCallback)
-> m (GClosure C_BusGlobalEngineChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_BusGlobalEngineChangedCallback)
 -> m (GClosure C_BusGlobalEngineChangedCallback))
-> IO (GClosure C_BusGlobalEngineChangedCallback)
-> m (GClosure C_BusGlobalEngineChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BusGlobalEngineChangedCallback
cb' = BusGlobalEngineChangedCallback -> C_BusGlobalEngineChangedCallback
wrap_BusGlobalEngineChangedCallback BusGlobalEngineChangedCallback
cb
    C_BusGlobalEngineChangedCallback
-> IO (FunPtr C_BusGlobalEngineChangedCallback)
mk_BusGlobalEngineChangedCallback C_BusGlobalEngineChangedCallback
cb' IO (FunPtr C_BusGlobalEngineChangedCallback)
-> (FunPtr C_BusGlobalEngineChangedCallback
    -> IO (GClosure C_BusGlobalEngineChangedCallback))
-> IO (GClosure C_BusGlobalEngineChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_BusGlobalEngineChangedCallback
-> IO (GClosure C_BusGlobalEngineChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `BusGlobalEngineChangedCallback` into a `C_BusGlobalEngineChangedCallback`.
wrap_BusGlobalEngineChangedCallback ::
    BusGlobalEngineChangedCallback ->
    C_BusGlobalEngineChangedCallback
wrap_BusGlobalEngineChangedCallback :: BusGlobalEngineChangedCallback -> C_BusGlobalEngineChangedCallback
wrap_BusGlobalEngineChangedCallback BusGlobalEngineChangedCallback
_cb Ptr ()
_ CString
name Ptr ()
_ = do
    Text
name' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
name
    BusGlobalEngineChangedCallback
_cb  Text
name'


-- | Connect a signal handler for the [globalEngineChanged](#signal:globalEngineChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' bus #globalEngineChanged callback
-- @
-- 
-- 
onBusGlobalEngineChanged :: (IsBus a, MonadIO m) => a -> BusGlobalEngineChangedCallback -> m SignalHandlerId
onBusGlobalEngineChanged :: a -> BusGlobalEngineChangedCallback -> m SignalHandlerId
onBusGlobalEngineChanged a
obj BusGlobalEngineChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BusGlobalEngineChangedCallback
cb' = BusGlobalEngineChangedCallback -> C_BusGlobalEngineChangedCallback
wrap_BusGlobalEngineChangedCallback BusGlobalEngineChangedCallback
cb
    FunPtr C_BusGlobalEngineChangedCallback
cb'' <- C_BusGlobalEngineChangedCallback
-> IO (FunPtr C_BusGlobalEngineChangedCallback)
mk_BusGlobalEngineChangedCallback C_BusGlobalEngineChangedCallback
cb'
    a
-> Text
-> FunPtr C_BusGlobalEngineChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"global-engine-changed" FunPtr C_BusGlobalEngineChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [globalEngineChanged](#signal:globalEngineChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' bus #globalEngineChanged callback
-- @
-- 
-- 
afterBusGlobalEngineChanged :: (IsBus a, MonadIO m) => a -> BusGlobalEngineChangedCallback -> m SignalHandlerId
afterBusGlobalEngineChanged :: a -> BusGlobalEngineChangedCallback -> m SignalHandlerId
afterBusGlobalEngineChanged a
obj BusGlobalEngineChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BusGlobalEngineChangedCallback
cb' = BusGlobalEngineChangedCallback -> C_BusGlobalEngineChangedCallback
wrap_BusGlobalEngineChangedCallback BusGlobalEngineChangedCallback
cb
    FunPtr C_BusGlobalEngineChangedCallback
cb'' <- C_BusGlobalEngineChangedCallback
-> IO (FunPtr C_BusGlobalEngineChangedCallback)
mk_BusGlobalEngineChangedCallback C_BusGlobalEngineChangedCallback
cb'
    a
-> Text
-> FunPtr C_BusGlobalEngineChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"global-engine-changed" FunPtr C_BusGlobalEngineChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data BusGlobalEngineChangedSignalInfo
instance SignalInfo BusGlobalEngineChangedSignalInfo where
    type HaskellCallbackType BusGlobalEngineChangedSignalInfo = BusGlobalEngineChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_BusGlobalEngineChangedCallback cb
        cb'' <- mk_BusGlobalEngineChangedCallback cb'
        connectSignalFunPtr obj "global-engine-changed" cb'' connectMode detail

#endif

-- signal Bus::name-owner-changed
-- | Emitted when D-Bus name owner is changed.
type BusNameOwnerChangedCallback =
    T.Text
    -- ^ /@name@/: The name which ower is changed.
    -> T.Text
    -- ^ /@oldOwner@/: The unique bus name of the old owner.
    -> T.Text
    -- ^ /@newOwner@/: The unique bus name of the new owner.
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `BusNameOwnerChangedCallback`@.
noBusNameOwnerChangedCallback :: Maybe BusNameOwnerChangedCallback
noBusNameOwnerChangedCallback :: Maybe BusNameOwnerChangedCallback
noBusNameOwnerChangedCallback = Maybe BusNameOwnerChangedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_BusNameOwnerChangedCallback =
    Ptr () ->                               -- object
    CString ->
    CString ->
    CString ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_BusNameOwnerChangedCallback`.
foreign import ccall "wrapper"
    mk_BusNameOwnerChangedCallback :: C_BusNameOwnerChangedCallback -> IO (FunPtr C_BusNameOwnerChangedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_BusNameOwnerChanged :: MonadIO m => BusNameOwnerChangedCallback -> m (GClosure C_BusNameOwnerChangedCallback)
genClosure_BusNameOwnerChanged :: BusNameOwnerChangedCallback
-> m (GClosure C_BusNameOwnerChangedCallback)
genClosure_BusNameOwnerChanged BusNameOwnerChangedCallback
cb = IO (GClosure C_BusNameOwnerChangedCallback)
-> m (GClosure C_BusNameOwnerChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_BusNameOwnerChangedCallback)
 -> m (GClosure C_BusNameOwnerChangedCallback))
-> IO (GClosure C_BusNameOwnerChangedCallback)
-> m (GClosure C_BusNameOwnerChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BusNameOwnerChangedCallback
cb' = BusNameOwnerChangedCallback -> C_BusNameOwnerChangedCallback
wrap_BusNameOwnerChangedCallback BusNameOwnerChangedCallback
cb
    C_BusNameOwnerChangedCallback
-> IO (FunPtr C_BusNameOwnerChangedCallback)
mk_BusNameOwnerChangedCallback C_BusNameOwnerChangedCallback
cb' IO (FunPtr C_BusNameOwnerChangedCallback)
-> (FunPtr C_BusNameOwnerChangedCallback
    -> IO (GClosure C_BusNameOwnerChangedCallback))
-> IO (GClosure C_BusNameOwnerChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_BusNameOwnerChangedCallback
-> IO (GClosure C_BusNameOwnerChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `BusNameOwnerChangedCallback` into a `C_BusNameOwnerChangedCallback`.
wrap_BusNameOwnerChangedCallback ::
    BusNameOwnerChangedCallback ->
    C_BusNameOwnerChangedCallback
wrap_BusNameOwnerChangedCallback :: BusNameOwnerChangedCallback -> C_BusNameOwnerChangedCallback
wrap_BusNameOwnerChangedCallback BusNameOwnerChangedCallback
_cb Ptr ()
_ CString
name CString
oldOwner CString
newOwner Ptr ()
_ = do
    Text
name' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
name
    Text
oldOwner' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
oldOwner
    Text
newOwner' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
newOwner
    BusNameOwnerChangedCallback
_cb  Text
name' Text
oldOwner' Text
newOwner'


-- | Connect a signal handler for the [nameOwnerChanged](#signal:nameOwnerChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' bus #nameOwnerChanged callback
-- @
-- 
-- 
onBusNameOwnerChanged :: (IsBus a, MonadIO m) => a -> BusNameOwnerChangedCallback -> m SignalHandlerId
onBusNameOwnerChanged :: a -> BusNameOwnerChangedCallback -> m SignalHandlerId
onBusNameOwnerChanged a
obj BusNameOwnerChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BusNameOwnerChangedCallback
cb' = BusNameOwnerChangedCallback -> C_BusNameOwnerChangedCallback
wrap_BusNameOwnerChangedCallback BusNameOwnerChangedCallback
cb
    FunPtr C_BusNameOwnerChangedCallback
cb'' <- C_BusNameOwnerChangedCallback
-> IO (FunPtr C_BusNameOwnerChangedCallback)
mk_BusNameOwnerChangedCallback C_BusNameOwnerChangedCallback
cb'
    a
-> Text
-> FunPtr C_BusNameOwnerChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"name-owner-changed" FunPtr C_BusNameOwnerChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [nameOwnerChanged](#signal:nameOwnerChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' bus #nameOwnerChanged callback
-- @
-- 
-- 
afterBusNameOwnerChanged :: (IsBus a, MonadIO m) => a -> BusNameOwnerChangedCallback -> m SignalHandlerId
afterBusNameOwnerChanged :: a -> BusNameOwnerChangedCallback -> m SignalHandlerId
afterBusNameOwnerChanged a
obj BusNameOwnerChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_BusNameOwnerChangedCallback
cb' = BusNameOwnerChangedCallback -> C_BusNameOwnerChangedCallback
wrap_BusNameOwnerChangedCallback BusNameOwnerChangedCallback
cb
    FunPtr C_BusNameOwnerChangedCallback
cb'' <- C_BusNameOwnerChangedCallback
-> IO (FunPtr C_BusNameOwnerChangedCallback)
mk_BusNameOwnerChangedCallback C_BusNameOwnerChangedCallback
cb'
    a
-> Text
-> FunPtr C_BusNameOwnerChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"name-owner-changed" FunPtr C_BusNameOwnerChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data BusNameOwnerChangedSignalInfo
instance SignalInfo BusNameOwnerChangedSignalInfo where
    type HaskellCallbackType BusNameOwnerChangedSignalInfo = BusNameOwnerChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_BusNameOwnerChangedCallback cb
        cb'' <- mk_BusNameOwnerChangedCallback cb'
        connectSignalFunPtr obj "name-owner-changed" cb'' connectMode detail

#endif

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

-- | Get the value of the “@client-only@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' bus #clientOnly
-- @
getBusClientOnly :: (MonadIO m, IsBus o) => o -> m Bool
getBusClientOnly :: o -> m Bool
getBusClientOnly o
obj = 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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"client-only"

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

#if defined(ENABLE_OVERLOADING)
data BusClientOnlyPropertyInfo
instance AttrInfo BusClientOnlyPropertyInfo where
    type AttrAllowedOps BusClientOnlyPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BusClientOnlyPropertyInfo = IsBus
    type AttrSetTypeConstraint BusClientOnlyPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint BusClientOnlyPropertyInfo = (~) Bool
    type AttrTransferType BusClientOnlyPropertyInfo = Bool
    type AttrGetType BusClientOnlyPropertyInfo = Bool
    type AttrLabel BusClientOnlyPropertyInfo = "client-only"
    type AttrOrigin BusClientOnlyPropertyInfo = Bus
    attrGet = getBusClientOnly
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructBusClientOnly
    attrClear = undefined
#endif

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

-- | Get the value of the “@connect-async@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' bus #connectAsync
-- @
getBusConnectAsync :: (MonadIO m, IsBus o) => o -> m Bool
getBusConnectAsync :: o -> m Bool
getBusConnectAsync o
obj = 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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"connect-async"

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

#if defined(ENABLE_OVERLOADING)
data BusConnectAsyncPropertyInfo
instance AttrInfo BusConnectAsyncPropertyInfo where
    type AttrAllowedOps BusConnectAsyncPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BusConnectAsyncPropertyInfo = IsBus
    type AttrSetTypeConstraint BusConnectAsyncPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint BusConnectAsyncPropertyInfo = (~) Bool
    type AttrTransferType BusConnectAsyncPropertyInfo = Bool
    type AttrGetType BusConnectAsyncPropertyInfo = Bool
    type AttrLabel BusConnectAsyncPropertyInfo = "connect-async"
    type AttrOrigin BusConnectAsyncPropertyInfo = Bus
    attrGet = getBusConnectAsync
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructBusConnectAsync
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Bus
type instance O.AttributeList Bus = BusAttributeList
type BusAttributeList = ('[ '("clientOnly", BusClientOnlyPropertyInfo), '("connectAsync", BusConnectAsyncPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
busClientOnly :: AttrLabelProxy "clientOnly"
busClientOnly = AttrLabelProxy

busConnectAsync :: AttrLabelProxy "connectAsync"
busConnectAsync = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Bus = BusSignalList
type BusSignalList = ('[ '("connected", BusConnectedSignalInfo), '("destroy", IBus.Object.ObjectDestroySignalInfo), '("disconnected", BusDisconnectedSignalInfo), '("globalEngineChanged", BusGlobalEngineChangedSignalInfo), '("nameOwnerChanged", BusNameOwnerChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "ibus_bus_new" ibus_bus_new :: 
    IO (Ptr Bus)

-- | Creates a new t'GI.IBus.Objects.Bus.Bus' instance.
busNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Bus
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.Bus.Bus' instance, and the instance is not
    -- floating.
busNew :: m Bus
busNew  = IO Bus -> m Bus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bus -> m Bus) -> IO Bus -> m Bus
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
result <- IO (Ptr Bus)
ibus_bus_new
    Text -> Ptr Bus -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busNew" Ptr Bus
result
    Bus
result' <- ((ManagedPtr Bus -> Bus) -> Ptr Bus -> IO Bus
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Bus -> Bus
Bus) Ptr Bus
result
    Bus -> IO Bus
forall (m :: * -> *) a. Monad m => a -> m a
return Bus
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "ibus_bus_new_async" ibus_bus_new_async :: 
    IO (Ptr Bus)

-- | Creates a new t'GI.IBus.Objects.Bus.Bus' instance. The instance will asynchronously connect
-- to the IBus daemon.
busNewAsync ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Bus
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.Bus.Bus' instance, and the instance is not
    -- floating.
busNewAsync :: m Bus
busNewAsync  = IO Bus -> m Bus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bus -> m Bus) -> IO Bus -> m Bus
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
result <- IO (Ptr Bus)
ibus_bus_new_async
    Text -> Ptr Bus -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busNewAsync" Ptr Bus
result
    Bus
result' <- ((ManagedPtr Bus -> Bus) -> Ptr Bus -> IO Bus
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Bus -> Bus
Bus) Ptr Bus
result
    Bus -> IO Bus
forall (m :: * -> *) a. Monad m => a -> m a
return Bus
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "ibus_bus_new_async_client" ibus_bus_new_async_client :: 
    IO (Ptr Bus)

-- | Creates a new t'GI.IBus.Objects.Bus.Bus' instance for client use only. It will possibly
-- be limited in what it can do.
-- 
-- The instance will asynchronously connect to the IBus daemon.
busNewAsyncClient ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Bus
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.Bus.Bus' instance, and the instance is not
    -- floating.
busNewAsyncClient :: m Bus
busNewAsyncClient  = IO Bus -> m Bus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bus -> m Bus) -> IO Bus -> m Bus
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
result <- IO (Ptr Bus)
ibus_bus_new_async_client
    Text -> Ptr Bus -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busNewAsyncClient" Ptr Bus
result
    Bus
result' <- ((ManagedPtr Bus -> Bus) -> Ptr Bus -> IO Bus
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Bus -> Bus
Bus) Ptr Bus
result
    Bus -> IO Bus
forall (m :: * -> *) a. Monad m => a -> m a
return Bus
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Bus::add_match
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rule"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Match rule." , 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_bus_add_match" ibus_bus_add_match :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- rule : TBasicType TUTF8
    IO CInt

-- | Add a match rule to an t'GI.IBus.Objects.Bus.Bus' synchronously.
busAddMatch ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@rule@/: Match rule.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the rule is added. 'P.False' otherwise.
busAddMatch :: a -> Text -> m Bool
busAddMatch a
bus Text
rule = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
rule' <- Text -> IO CString
textToCString Text
rule
    CInt
result <- Ptr Bus -> CString -> IO CInt
ibus_bus_add_match Ptr Bus
bus' CString
rule'
    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
bus
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
rule'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BusAddMatchMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsBus a) => O.MethodInfo BusAddMatchMethodInfo a signature where
    overloadedMethod = busAddMatch

#endif

-- method Bus::add_match_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rule"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Match rule." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied\n     or %NULL if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_add_match_async" ibus_bus_add_match_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- rule : TBasicType TUTF8
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Add a match rule to an t'GI.IBus.Objects.Bus.Bus' asynchronously.
busAddMatchAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@rule@/: Match rule.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    --      or 'P.Nothing' if you don\'t care about the result of the method invocation.
    -> m ()
busAddMatchAsync :: a -> Text -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busAddMatchAsync a
bus Text
rule Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
rule' <- Text -> IO CString
textToCString Text
rule
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> CString
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_add_match_async Ptr Bus
bus' CString
rule' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
rule'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusAddMatchAsyncMethodInfo
instance (signature ~ (T.Text -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusAddMatchAsyncMethodInfo a signature where
    overloadedMethod = busAddMatchAsync

#endif

-- method Bus::add_match_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_add_match_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_add_match_async_finish" ibus_bus_add_match_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busAddMatchAsync'.
busAddMatchAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busAddMatchAsync'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
busAddMatchAsyncFinish :: a -> b -> m ()
busAddMatchAsyncFinish a
bus b
res = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
ibus_bus_add_match_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusAddMatchAsyncFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusAddMatchAsyncFinishMethodInfo a signature where
    overloadedMethod = busAddMatchAsyncFinish

#endif

-- method Bus::create_input_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "client_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of client." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "IBus" , name = "InputContext" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_create_input_context" ibus_bus_create_input_context :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- client_name : TBasicType TUTF8
    IO (Ptr IBus.InputContext.InputContext)

-- | Create an input context for client synchronously.
busCreateInputContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@clientName@/: Name of client.
    -> m IBus.InputContext.InputContext
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.InputContext.InputContext' if the
    --      \"CreateInputContext\" call is succeeded, 'P.Nothing' otherwise.
busCreateInputContext :: a -> Text -> m InputContext
busCreateInputContext a
bus Text
clientName = IO InputContext -> m InputContext
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputContext -> m InputContext)
-> IO InputContext -> m InputContext
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
clientName' <- Text -> IO CString
textToCString Text
clientName
    Ptr InputContext
result <- Ptr Bus -> CString -> IO (Ptr InputContext)
ibus_bus_create_input_context Ptr Bus
bus' CString
clientName'
    Text -> Ptr InputContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busCreateInputContext" Ptr InputContext
result
    InputContext
result' <- ((ManagedPtr InputContext -> InputContext)
-> Ptr InputContext -> IO InputContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr InputContext -> InputContext
IBus.InputContext.InputContext) Ptr InputContext
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
clientName'
    InputContext -> IO InputContext
forall (m :: * -> *) a. Monad m => a -> m a
return InputContext
result'

#if defined(ENABLE_OVERLOADING)
data BusCreateInputContextMethodInfo
instance (signature ~ (T.Text -> m IBus.InputContext.InputContext), MonadIO m, IsBus a) => O.MethodInfo BusCreateInputContextMethodInfo a signature where
    overloadedMethod = busCreateInputContext

#endif

-- method Bus::create_input_context_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "client_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of client." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied.\n     It should not be %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_create_input_context_async" ibus_bus_create_input_context_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- client_name : TBasicType TUTF8
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Create an input context for client asynchronously.
busCreateInputContextAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@clientName@/: Name of client.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied.
    --      It should not be 'P.Nothing'.
    -> m ()
busCreateInputContextAsync :: a -> Text -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busCreateInputContextAsync a
bus Text
clientName Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
clientName' <- Text -> IO CString
textToCString Text
clientName
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> CString
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_create_input_context_async Ptr Bus
bus' CString
clientName' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
clientName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusCreateInputContextAsyncMethodInfo
instance (signature ~ (T.Text -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusCreateInputContextAsyncMethodInfo a signature where
    overloadedMethod = busCreateInputContextAsync

#endif

-- method Bus::create_input_context_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_create_input_context_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "IBus" , name = "InputContext" })
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_create_input_context_async_finish" ibus_bus_create_input_context_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr IBus.InputContext.InputContext)

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busCreateInputContextAsync'.
busCreateInputContextAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busCreateInputContextAsync'.
    -> m IBus.InputContext.InputContext
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.InputContext.InputContext' if the
    --      \"CreateInputContext\" call is succeeded, 'P.Nothing' otherwise. /(Can throw 'Data.GI.Base.GError.GError')/
busCreateInputContextAsyncFinish :: a -> b -> m InputContext
busCreateInputContextAsyncFinish a
bus b
res = IO InputContext -> m InputContext
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputContext -> m InputContext)
-> IO InputContext -> m InputContext
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO InputContext -> IO () -> IO InputContext
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr InputContext
result <- (Ptr (Ptr GError) -> IO (Ptr InputContext))
-> IO (Ptr InputContext)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr InputContext))
 -> IO (Ptr InputContext))
-> (Ptr (Ptr GError) -> IO (Ptr InputContext))
-> IO (Ptr InputContext)
forall a b. (a -> b) -> a -> b
$ Ptr Bus
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr InputContext)
ibus_bus_create_input_context_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        Text -> Ptr InputContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busCreateInputContextAsyncFinish" Ptr InputContext
result
        InputContext
result' <- ((ManagedPtr InputContext -> InputContext)
-> Ptr InputContext -> IO InputContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr InputContext -> InputContext
IBus.InputContext.InputContext) Ptr InputContext
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        InputContext -> IO InputContext
forall (m :: * -> *) a. Monad m => a -> m a
return InputContext
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusCreateInputContextAsyncFinishMethodInfo
instance (signature ~ (b -> m IBus.InputContext.InputContext), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusCreateInputContextAsyncFinishMethodInfo a signature where
    overloadedMethod = busCreateInputContextAsyncFinish

#endif

-- method Bus::current_input_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , 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_bus_current_input_context" ibus_bus_current_input_context :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    IO CString

-- | Get the current focused input context synchronously.
busCurrentInputContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> m T.Text
    -- ^ __Returns:__ Name of the currently focused t'GI.IBus.Objects.InputContext.InputContext' if the
    --          \"CurrentInputContext\" call succeeded, 'P.Nothing' otherwise. The return
    --          value must be freed with 'GI.GLib.Functions.free'.
busCurrentInputContext :: a -> m Text
busCurrentInputContext a
bus = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
result <- Ptr Bus -> IO CString
ibus_bus_current_input_context Ptr Bus
bus'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busCurrentInputContext" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data BusCurrentInputContextMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsBus a) => O.MethodInfo BusCurrentInputContextMethodInfo a signature where
    overloadedMethod = busCurrentInputContext

#endif

-- method Bus::current_input_context_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied\n     or %NULL if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_current_input_context_async" ibus_bus_current_input_context_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Get the current focused input context asynchronously.
busCurrentInputContextAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    --      or 'P.Nothing' if you don\'t care about the result of the method invocation.
    -> m ()
busCurrentInputContextAsync :: a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busCurrentInputContextAsync a
bus Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_current_input_context_async Ptr Bus
bus' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusCurrentInputContextAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusCurrentInputContextAsyncMethodInfo a signature where
    overloadedMethod = busCurrentInputContextAsync

#endif

-- method Bus::current_input_context_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_current_input_context_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_current_input_context_async_finish" ibus_bus_current_input_context_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CString

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busCurrentInputContextAsync'.
busCurrentInputContextAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busCurrentInputContextAsync'.
    -> m T.Text
    -- ^ __Returns:__ Name of the currently focused IBusInputContext if the
    --          \"CurrentInputContext\" call succeeded, 'P.Nothing' otherwise. The return
    --          value must be freed with 'GI.GLib.Functions.free'. /(Can throw 'Data.GI.Base.GError.GError')/
busCurrentInputContextAsyncFinish :: a -> b -> m Text
busCurrentInputContextAsyncFinish a
bus b
res = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO Text -> IO () -> IO Text
forall a b. IO a -> IO b -> IO a
onException (do
        CString
result <- (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CString) -> IO CString)
-> (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CString
ibus_bus_current_input_context_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busCurrentInputContextAsyncFinish" CString
result
        Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusCurrentInputContextAsyncFinishMethodInfo
instance (signature ~ (b -> m T.Text), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusCurrentInputContextAsyncFinishMethodInfo a signature where
    overloadedMethod = busCurrentInputContextAsyncFinish

#endif

-- method Bus::exit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "restart"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether restarting the ibus."
--                 , 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_bus_exit" ibus_bus_exit :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CInt ->                                 -- restart : TBasicType TBoolean
    IO CInt

-- | Exit or restart ibus-daemon synchronously.
busExit ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> Bool
    -- ^ /@restart@/: Whether restarting the ibus.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the \"Exit\" call is successful, 'P.False' otherwise.
busExit :: a -> Bool -> m Bool
busExit a
bus Bool
restart = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    let restart' :: CInt
restart' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
restart
    CInt
result <- Ptr Bus -> CInt -> IO CInt
ibus_bus_exit Ptr Bus
bus' CInt
restart'
    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
bus
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BusExitMethodInfo
instance (signature ~ (Bool -> m Bool), MonadIO m, IsBus a) => O.MethodInfo BusExitMethodInfo a signature where
    overloadedMethod = busExit

#endif

-- method Bus::exit_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "restart"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether restarting the ibus."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied\n     or %NULL if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_exit_async" ibus_bus_exit_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CInt ->                                 -- restart : TBasicType TBoolean
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Exit or restart ibus-daemon asynchronously.
busExitAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> Bool
    -- ^ /@restart@/: Whether restarting the ibus.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    --      or 'P.Nothing' if you don\'t care about the result of the method invocation.
    -> m ()
busExitAsync :: a -> Bool -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busExitAsync a
bus Bool
restart Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    let restart' :: CInt
restart' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
restart
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> CInt
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_exit_async Ptr Bus
bus' CInt
restart' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusExitAsyncMethodInfo
instance (signature ~ (Bool -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusExitAsyncMethodInfo a signature where
    overloadedMethod = busExitAsync

#endif

-- method Bus::exit_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_exit_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_exit_async_finish" ibus_bus_exit_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busExitAsync'.
busExitAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busExitAsync'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
busExitAsyncFinish :: a -> b -> m ()
busExitAsyncFinish a
bus b
res = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
ibus_bus_exit_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusExitAsyncFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusExitAsyncFinishMethodInfo a signature where
    overloadedMethod = busExitAsyncFinish

#endif

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

foreign import ccall "ibus_bus_get_config" ibus_bus_get_config :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    IO (Ptr IBus.Config.Config)

-- | Get the config instance from t'GI.IBus.Objects.Bus.Bus'.
busGetConfig ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> m IBus.Config.Config
    -- ^ __Returns:__ An t'GI.IBus.Objects.Config.Config' object which is configurable with
    -- /@bus@/.
busGetConfig :: a -> m Config
busGetConfig a
bus = IO Config -> m Config
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Config -> m Config) -> IO Config -> m Config
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr Config
result <- Ptr Bus -> IO (Ptr Config)
ibus_bus_get_config Ptr Bus
bus'
    Text -> Ptr Config -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busGetConfig" Ptr Config
result
    Config
result' <- ((ManagedPtr Config -> Config) -> Ptr Config -> IO Config
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Config -> Config
IBus.Config.Config) Ptr Config
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
result'

#if defined(ENABLE_OVERLOADING)
data BusGetConfigMethodInfo
instance (signature ~ (m IBus.Config.Config), MonadIO m, IsBus a) => O.MethodInfo BusGetConfigMethodInfo a signature where
    overloadedMethod = busGetConfig

#endif

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

foreign import ccall "ibus_bus_get_connection" ibus_bus_get_connection :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    IO (Ptr Gio.DBusConnection.DBusConnection)

-- | Gets a t'GI.Gio.Objects.DBusConnection.DBusConnection' of an t'GI.IBus.Objects.Bus.Bus' instance.
busGetConnection ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> m Gio.DBusConnection.DBusConnection
    -- ^ __Returns:__ A t'GI.Gio.Objects.DBusConnection.DBusConnection' of an t'GI.IBus.Objects.Bus.Bus' instance.
busGetConnection :: a -> m DBusConnection
busGetConnection a
bus = IO DBusConnection -> m DBusConnection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DBusConnection -> m DBusConnection)
-> IO DBusConnection -> m DBusConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr DBusConnection
result <- Ptr Bus -> IO (Ptr DBusConnection)
ibus_bus_get_connection Ptr Bus
bus'
    Text -> Ptr DBusConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busGetConnection" Ptr DBusConnection
result
    DBusConnection
result' <- ((ManagedPtr DBusConnection -> DBusConnection)
-> Ptr DBusConnection -> IO DBusConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DBusConnection -> DBusConnection
Gio.DBusConnection.DBusConnection) Ptr DBusConnection
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    DBusConnection -> IO DBusConnection
forall (m :: * -> *) a. Monad m => a -> m a
return DBusConnection
result'

#if defined(ENABLE_OVERLOADING)
data BusGetConnectionMethodInfo
instance (signature ~ (m Gio.DBusConnection.DBusConnection), MonadIO m, IsBus a) => O.MethodInfo BusGetConnectionMethodInfo a signature where
    overloadedMethod = busGetConnection

#endif

-- method Bus::get_engines_by_names
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "names"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A %NULL-terminated array of names."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TCArray
--                  True
--                  (-1)
--                  (-1)
--                  (TInterface Name { namespace = "IBus" , name = "EngineDesc" }))
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_get_engines_by_names" ibus_bus_get_engines_by_names :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr CString ->                          -- names : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO (Ptr (Ptr IBus.EngineDesc.EngineDesc))

-- | Get engines by given names synchronously. If some engine names do not exist,
-- this function will simply ignore them, and return rest of engines.
-- TODO(penghuang): add asynchronous version
busGetEnginesByNames ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> [T.Text]
    -- ^ /@names@/: A 'P.Nothing'-terminated array of names.
    -> m [IBus.EngineDesc.EngineDesc]
    -- ^ __Returns:__ 
    --         A 'P.Nothing'-terminated array of engines.
busGetEnginesByNames :: a -> [Text] -> m [EngineDesc]
busGetEnginesByNames a
bus [Text]
names = IO [EngineDesc] -> m [EngineDesc]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [EngineDesc] -> m [EngineDesc])
-> IO [EngineDesc] -> m [EngineDesc]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr CString
names' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
names
    Ptr (Ptr EngineDesc)
result <- Ptr Bus -> Ptr CString -> IO (Ptr (Ptr EngineDesc))
ibus_bus_get_engines_by_names Ptr Bus
bus' Ptr CString
names'
    Text -> Ptr (Ptr EngineDesc) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busGetEnginesByNames" Ptr (Ptr EngineDesc)
result
    [Ptr EngineDesc]
result' <- Ptr (Ptr EngineDesc) -> IO [Ptr EngineDesc]
forall a. Ptr (Ptr a) -> IO [Ptr a]
unpackZeroTerminatedPtrArray Ptr (Ptr EngineDesc)
result
    [EngineDesc]
result'' <- (Ptr EngineDesc -> IO EngineDesc)
-> [Ptr EngineDesc] -> IO [EngineDesc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr EngineDesc -> EngineDesc)
-> Ptr EngineDesc -> IO EngineDesc
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EngineDesc -> EngineDesc
IBus.EngineDesc.EngineDesc) [Ptr EngineDesc]
result'
    Ptr (Ptr EngineDesc) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr EngineDesc)
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
names'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
names'
    [EngineDesc] -> IO [EngineDesc]
forall (m :: * -> *) a. Monad m => a -> m a
return [EngineDesc]
result''

#if defined(ENABLE_OVERLOADING)
data BusGetEnginesByNamesMethodInfo
instance (signature ~ ([T.Text] -> m [IBus.EngineDesc.EngineDesc]), MonadIO m, IsBus a) => O.MethodInfo BusGetEnginesByNamesMethodInfo a signature where
    overloadedMethod = busGetEnginesByNames

#endif

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

foreign import ccall "ibus_bus_get_global_engine" ibus_bus_get_global_engine :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    IO (Ptr IBus.EngineDesc.EngineDesc)

-- | Get the description of current global engine synchronously.
busGetGlobalEngine ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> m IBus.EngineDesc.EngineDesc
    -- ^ __Returns:__ The description of current global engine,
    -- or 'P.Nothing' if there is no global engine.
busGetGlobalEngine :: a -> m EngineDesc
busGetGlobalEngine a
bus = IO EngineDesc -> m EngineDesc
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EngineDesc -> m EngineDesc) -> IO EngineDesc -> m EngineDesc
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr EngineDesc
result <- Ptr Bus -> IO (Ptr EngineDesc)
ibus_bus_get_global_engine Ptr Bus
bus'
    Text -> Ptr EngineDesc -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busGetGlobalEngine" Ptr EngineDesc
result
    EngineDesc
result' <- ((ManagedPtr EngineDesc -> EngineDesc)
-> Ptr EngineDesc -> IO EngineDesc
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EngineDesc -> EngineDesc
IBus.EngineDesc.EngineDesc) Ptr EngineDesc
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    EngineDesc -> IO EngineDesc
forall (m :: * -> *) a. Monad m => a -> m a
return EngineDesc
result'

#if defined(ENABLE_OVERLOADING)
data BusGetGlobalEngineMethodInfo
instance (signature ~ (m IBus.EngineDesc.EngineDesc), MonadIO m, IsBus a) => O.MethodInfo BusGetGlobalEngineMethodInfo a signature where
    overloadedMethod = busGetGlobalEngine

#endif

-- method Bus::get_global_engine_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied or %NULL\n     if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_get_global_engine_async" ibus_bus_get_global_engine_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Get the description of current global engine asynchronously.
busGetGlobalEngineAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied or 'P.Nothing'
    --      if you don\'t care about the result of the method invocation.
    -> m ()
busGetGlobalEngineAsync :: a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busGetGlobalEngineAsync a
bus Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_get_global_engine_async Ptr Bus
bus' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusGetGlobalEngineAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusGetGlobalEngineAsyncMethodInfo a signature where
    overloadedMethod = busGetGlobalEngineAsync

#endif

-- method Bus::get_global_engine_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_get_global_engine_async_finish()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "IBus" , name = "EngineDesc" })
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_get_global_engine_async_finish" ibus_bus_get_global_engine_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr IBus.EngineDesc.EngineDesc)

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busGetGlobalEngineAsyncFinish'.
busGetGlobalEngineAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busGetGlobalEngineAsyncFinish'.
    -> m IBus.EngineDesc.EngineDesc
    -- ^ __Returns:__ The description of current global engine,
    -- or 'P.Nothing' if there is no global engine. /(Can throw 'Data.GI.Base.GError.GError')/
busGetGlobalEngineAsyncFinish :: a -> b -> m EngineDesc
busGetGlobalEngineAsyncFinish a
bus b
res = IO EngineDesc -> m EngineDesc
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EngineDesc -> m EngineDesc) -> IO EngineDesc -> m EngineDesc
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO EngineDesc -> IO () -> IO EngineDesc
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr EngineDesc
result <- (Ptr (Ptr GError) -> IO (Ptr EngineDesc)) -> IO (Ptr EngineDesc)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr EngineDesc)) -> IO (Ptr EngineDesc))
-> (Ptr (Ptr GError) -> IO (Ptr EngineDesc)) -> IO (Ptr EngineDesc)
forall a b. (a -> b) -> a -> b
$ Ptr Bus
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr EngineDesc)
ibus_bus_get_global_engine_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        Text -> Ptr EngineDesc -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busGetGlobalEngineAsyncFinish" Ptr EngineDesc
result
        EngineDesc
result' <- ((ManagedPtr EngineDesc -> EngineDesc)
-> Ptr EngineDesc -> IO EngineDesc
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr EngineDesc -> EngineDesc
IBus.EngineDesc.EngineDesc) Ptr EngineDesc
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        EngineDesc -> IO EngineDesc
forall (m :: * -> *) a. Monad m => a -> m a
return EngineDesc
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusGetGlobalEngineAsyncFinishMethodInfo
instance (signature ~ (b -> m IBus.EngineDesc.EngineDesc), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusGetGlobalEngineAsyncFinishMethodInfo a signature where
    overloadedMethod = busGetGlobalEngineAsyncFinish

#endif

-- method Bus::get_ibus_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "property name in org.freedesktop.DBus.Properties.Get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_get_ibus_property" ibus_bus_get_ibus_property :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- property_name : TBasicType TUTF8
    IO (Ptr GVariant)

-- | Get org.freedesktop.DBus.Properties.
busGetIbusProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@propertyName@/: property name in org.freedesktop.DBus.Properties.Get
    -> m GVariant
    -- ^ __Returns:__ The value in org.freedesktop.DBus.Properties.Get
    --           The returned value must be freed with 'GI.GLib.Structs.Variant.variantUnref'.
busGetIbusProperty :: a -> Text -> m GVariant
busGetIbusProperty a
bus Text
propertyName = IO GVariant -> m GVariant
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GVariant
result <- Ptr Bus -> CString -> IO (Ptr GVariant)
ibus_bus_get_ibus_property Ptr Bus
bus' CString
propertyName'
    Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busGetIbusProperty" Ptr GVariant
result
    GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'

#if defined(ENABLE_OVERLOADING)
data BusGetIbusPropertyMethodInfo
instance (signature ~ (T.Text -> m GVariant), MonadIO m, IsBus a) => O.MethodInfo BusGetIbusPropertyMethodInfo a signature where
    overloadedMethod = busGetIbusProperty

#endif

-- method Bus::get_ibus_property_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "property name in org.freedesktop.DBus.Properties.Get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied\n     or %NULL if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_get_ibus_property_async" ibus_bus_get_ibus_property_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- property_name : TBasicType TUTF8
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Get org.freedesktop.DBus.Properties asynchronously.
busGetIbusPropertyAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@propertyName@/: property name in org.freedesktop.DBus.Properties.Get
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    --      or 'P.Nothing' if you don\'t care about the result of the method invocation.
    -> m ()
busGetIbusPropertyAsync :: a -> Text -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busGetIbusPropertyAsync a
bus Text
propertyName Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> CString
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_get_ibus_property_async Ptr Bus
bus' CString
propertyName' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusGetIbusPropertyAsyncMethodInfo
instance (signature ~ (T.Text -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusGetIbusPropertyAsyncMethodInfo a signature where
    overloadedMethod = busGetIbusPropertyAsync

#endif

-- method Bus::get_ibus_property_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_get_ibus_property_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_get_ibus_property_async_finish" ibus_bus_get_ibus_property_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GVariant)

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busGetIbusPropertyAsync'.
busGetIbusPropertyAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busGetIbusPropertyAsync'.
    -> m GVariant
    -- ^ __Returns:__ The value in org.freedesktop.DBus.Properties.Get
    --           The returned value must be freed with 'GI.GLib.Structs.Variant.variantUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
busGetIbusPropertyAsyncFinish :: a -> b -> m GVariant
busGetIbusPropertyAsyncFinish a
bus b
res = IO GVariant -> m GVariant
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO GVariant -> IO () -> IO GVariant
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr GVariant
result <- (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant))
-> (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr GVariant)
ibus_bus_get_ibus_property_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busGetIbusPropertyAsyncFinish" Ptr GVariant
result
        GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusGetIbusPropertyAsyncFinishMethodInfo
instance (signature ~ (b -> m GVariant), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusGetIbusPropertyAsyncFinishMethodInfo a signature where
    overloadedMethod = busGetIbusPropertyAsyncFinish

#endif

-- method Bus::get_name_owner
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , 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." , 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_bus_get_name_owner" ibus_bus_get_name_owner :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- name : TBasicType TUTF8
    IO CString

-- | Return the name owner synchronously.
busGetNameOwner ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@name@/: Name.
    -> m T.Text
    -- ^ __Returns:__ Owner of the name. The returned value must be freed with 'GI.GLib.Functions.free'.
busGetNameOwner :: a -> Text -> m Text
busGetNameOwner a
bus Text
name = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
result <- Ptr Bus -> CString -> IO CString
ibus_bus_get_name_owner Ptr Bus
bus' CString
name'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busGetNameOwner" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data BusGetNameOwnerMethodInfo
instance (signature ~ (T.Text -> m T.Text), MonadIO m, IsBus a) => O.MethodInfo BusGetNameOwnerMethodInfo a signature where
    overloadedMethod = busGetNameOwner

#endif

-- method Bus::get_name_owner_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , 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." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied\n     or %NULL if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_get_name_owner_async" ibus_bus_get_name_owner_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- name : TBasicType TUTF8
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Return the name owner asynchronously.
busGetNameOwnerAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@name@/: Name.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    --      or 'P.Nothing' if you don\'t care about the result of the method invocation.
    -> m ()
busGetNameOwnerAsync :: a -> Text -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busGetNameOwnerAsync a
bus Text
name Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> CString
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_get_name_owner_async Ptr Bus
bus' CString
name' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    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 BusGetNameOwnerAsyncMethodInfo
instance (signature ~ (T.Text -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusGetNameOwnerAsyncMethodInfo a signature where
    overloadedMethod = busGetNameOwnerAsync

#endif

-- method Bus::get_name_owner_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_get_name_owner_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_get_name_owner_async_finish" ibus_bus_get_name_owner_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CString

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busGetNameOwnerAsync'.
busGetNameOwnerAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busGetNameOwnerAsync'.
    -> m T.Text
    -- ^ __Returns:__ Owner of the name. The returned value must be freed with 'GI.GLib.Functions.free'. /(Can throw 'Data.GI.Base.GError.GError')/
busGetNameOwnerAsyncFinish :: a -> b -> m Text
busGetNameOwnerAsyncFinish a
bus b
res = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO Text -> IO () -> IO Text
forall a b. IO a -> IO b -> IO a
onException (do
        CString
result <- (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CString) -> IO CString)
-> (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CString
ibus_bus_get_name_owner_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busGetNameOwnerAsyncFinish" CString
result
        Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusGetNameOwnerAsyncFinishMethodInfo
instance (signature ~ (b -> m T.Text), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusGetNameOwnerAsyncFinishMethodInfo a signature where
    overloadedMethod = busGetNameOwnerAsyncFinish

#endif

-- method Bus::get_service_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , 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_bus_get_service_name" ibus_bus_get_service_name :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    IO CString

-- | Return the main service name to use for calls on the ibus connection.
busGetServiceName ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> m T.Text
    -- ^ __Returns:__ at dbus name.
busGetServiceName :: a -> m Text
busGetServiceName a
bus = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
result <- Ptr Bus -> IO CString
ibus_bus_get_service_name Ptr Bus
bus'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busGetServiceName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data BusGetServiceNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsBus a) => O.MethodInfo BusGetServiceNameMethodInfo a signature where
    overloadedMethod = busGetServiceName

#endif

-- method Bus::get_use_global_engine
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , 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_bus_get_use_global_engine" ibus_bus_get_use_global_engine :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    IO CInt

{-# DEPRECATED busGetUseGlobalEngine ["(Since version 1.5.3)","Currently global engine is always used."] #-}
-- | Check if the bus\'s \"use_global_engine\" option is enabled or not
-- synchronously.
busGetUseGlobalEngine ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> m Bool
    -- ^ __Returns:__ TRUE if \"use_global_engine\" option is enabled.
busGetUseGlobalEngine :: a -> m Bool
busGetUseGlobalEngine a
bus = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CInt
result <- Ptr Bus -> IO CInt
ibus_bus_get_use_global_engine Ptr Bus
bus'
    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
bus
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BusGetUseGlobalEngineMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsBus a) => O.MethodInfo BusGetUseGlobalEngineMethodInfo a signature where
    overloadedMethod = busGetUseGlobalEngine

#endif

-- method Bus::get_use_global_engine_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied\n     or %NULL if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_get_use_global_engine_async" ibus_bus_get_use_global_engine_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

{-# DEPRECATED busGetUseGlobalEngineAsync ["(Since version 1.5.3)","Currently global engine is always used."] #-}
-- | Check if the bus\'s \"use_global_engine\" option is enabled or not asynchronously.
busGetUseGlobalEngineAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    --      or 'P.Nothing' if you don\'t care about the result of the method invocation.
    -> m ()
busGetUseGlobalEngineAsync :: a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busGetUseGlobalEngineAsync a
bus Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_get_use_global_engine_async Ptr Bus
bus' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusGetUseGlobalEngineAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusGetUseGlobalEngineAsyncMethodInfo a signature where
    overloadedMethod = busGetUseGlobalEngineAsync

#endif

-- method Bus::get_use_global_engine_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_get_use_global_engine_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_get_use_global_engine_async_finish" ibus_bus_get_use_global_engine_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED busGetUseGlobalEngineAsyncFinish ["(Since version 1.5.3)","Currently global engine is always used."] #-}
-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busGetUseGlobalEngineAsync'.
busGetUseGlobalEngineAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busGetUseGlobalEngineAsync'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
busGetUseGlobalEngineAsyncFinish :: a -> b -> m ()
busGetUseGlobalEngineAsyncFinish a
bus b
res = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
ibus_bus_get_use_global_engine_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusGetUseGlobalEngineAsyncFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusGetUseGlobalEngineAsyncFinishMethodInfo a signature where
    overloadedMethod = busGetUseGlobalEngineAsyncFinish

#endif

-- method Bus::get_use_sys_layout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , 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_bus_get_use_sys_layout" ibus_bus_get_use_sys_layout :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    IO CInt

{-# DEPRECATED busGetUseSysLayout ["(Since version 1.5.3)","Read dconf value","\\/desktop\\/ibus\\/general\\/use_system_keyboard_layout instead."] #-}
-- | Check if the bus\'s \"use_sys_layout\" option is enabled or not synchronously.
busGetUseSysLayout ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if \"use_sys_layout\" option is enabled.
busGetUseSysLayout :: a -> m Bool
busGetUseSysLayout a
bus = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CInt
result <- Ptr Bus -> IO CInt
ibus_bus_get_use_sys_layout Ptr Bus
bus'
    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
bus
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BusGetUseSysLayoutMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsBus a) => O.MethodInfo BusGetUseSysLayoutMethodInfo a signature where
    overloadedMethod = busGetUseSysLayout

#endif

-- method Bus::get_use_sys_layout_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied\n     or %NULL if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_get_use_sys_layout_async" ibus_bus_get_use_sys_layout_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

{-# DEPRECATED busGetUseSysLayoutAsync ["(Since version 1.5.3)","Read dconf value","\\/desktop\\/ibus\\/general\\/use_system_keyboard_layout instead."] #-}
-- | Check if the bus\'s \"use_sys_layout\" option is enabled or not asynchronously.
busGetUseSysLayoutAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    --      or 'P.Nothing' if you don\'t care about the result of the method invocation.
    -> m ()
busGetUseSysLayoutAsync :: a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busGetUseSysLayoutAsync a
bus Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_get_use_sys_layout_async Ptr Bus
bus' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusGetUseSysLayoutAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusGetUseSysLayoutAsyncMethodInfo a signature where
    overloadedMethod = busGetUseSysLayoutAsync

#endif

-- method Bus::get_use_sys_layout_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_get_use_sys_layout_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_get_use_sys_layout_async_finish" ibus_bus_get_use_sys_layout_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED busGetUseSysLayoutAsyncFinish ["(Since version 1.5.3)","Read dconf value","\\/desktop\\/ibus\\/general\\/use_system_keyboard_layout instead."] #-}
-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busGetUseSysLayoutAsync'.
busGetUseSysLayoutAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busGetUseSysLayoutAsync'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
busGetUseSysLayoutAsyncFinish :: a -> b -> m ()
busGetUseSysLayoutAsyncFinish a
bus b
res = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
ibus_bus_get_use_sys_layout_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusGetUseSysLayoutAsyncFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusGetUseSysLayoutAsyncFinishMethodInfo a signature where
    overloadedMethod = busGetUseSysLayoutAsyncFinish

#endif

-- method Bus::hello
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , 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_bus_hello" ibus_bus_hello :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    IO CString

-- | This function sends a \"HELLO\" message to DBus daemon,
-- which replies the unique name of current IBus process.
busHello ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> m T.Text
    -- ^ __Returns:__ The unique name of IBus process in DBus.
busHello :: a -> m Text
busHello a
bus = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
result <- Ptr Bus -> IO CString
ibus_bus_hello Ptr Bus
bus'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"busHello" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data BusHelloMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsBus a) => O.MethodInfo BusHelloMethodInfo a signature where
    overloadedMethod = busHello

#endif

-- method Bus::is_connected
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , 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_bus_is_connected" ibus_bus_is_connected :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    IO CInt

-- | Return 'P.True' if /@bus@/ is connected to IBus daemon.
busIsConnected ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@bus@/ is connected, 'P.False' otherwise.
busIsConnected :: a -> m Bool
busIsConnected a
bus = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CInt
result <- Ptr Bus -> IO CInt
ibus_bus_is_connected Ptr Bus
bus'
    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
bus
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BusIsConnectedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsBus a) => O.MethodInfo BusIsConnectedMethodInfo a signature where
    overloadedMethod = busIsConnected

#endif

-- method Bus::is_global_engine_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , 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_bus_is_global_engine_enabled" ibus_bus_is_global_engine_enabled :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    IO CInt

{-# DEPRECATED busIsGlobalEngineEnabled ["(Since version 1.5.3)","Probably this would be used for Chrome OS only.","Currently global engine is always used and 'GI.IBus.Objects.Bus.busGetGlobalEngine'","returns NULL until the first global engine is assigned.","You can use 'GI.IBus.Functions.setLogHandler' to disable a warning when","'GI.IBus.Objects.Bus.busGetGlobalEngine' returns NULL."] #-}
-- | Check if the current global engine is enabled or not synchronously.
busIsGlobalEngineEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the current global engine is enabled.
busIsGlobalEngineEnabled :: a -> m Bool
busIsGlobalEngineEnabled a
bus = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CInt
result <- Ptr Bus -> IO CInt
ibus_bus_is_global_engine_enabled Ptr Bus
bus'
    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
bus
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BusIsGlobalEngineEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsBus a) => O.MethodInfo BusIsGlobalEngineEnabledMethodInfo a signature where
    overloadedMethod = busIsGlobalEngineEnabled

#endif

-- method Bus::is_global_engine_enabled_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied\n     or %NULL if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_is_global_engine_enabled_async" ibus_bus_is_global_engine_enabled_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

{-# DEPRECATED busIsGlobalEngineEnabledAsync ["(Since version 1.5.3)","Probably this would be used for Chrome OS only.","Currently global engine is always used and 'GI.IBus.Objects.Bus.busGetGlobalEngine'","returns NULL until the first global engine is assigned.","You can use 'GI.IBus.Functions.setLogHandler' to disable a warning when","'GI.IBus.Objects.Bus.busGetGlobalEngine' returns NULL."] #-}
-- | Check if the current global engine is enabled or not asynchronously.
busIsGlobalEngineEnabledAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    --      or 'P.Nothing' if you don\'t care about the result of the method invocation.
    -> m ()
busIsGlobalEngineEnabledAsync :: a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busIsGlobalEngineEnabledAsync a
bus Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_is_global_engine_enabled_async Ptr Bus
bus' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusIsGlobalEngineEnabledAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusIsGlobalEngineEnabledAsyncMethodInfo a signature where
    overloadedMethod = busIsGlobalEngineEnabledAsync

#endif

-- method Bus::is_global_engine_enabled_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_is_global_engine_enabled_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_is_global_engine_enabled_async_finish" ibus_bus_is_global_engine_enabled_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED busIsGlobalEngineEnabledAsyncFinish ["(Since version 1.5.3)","Probably this would be used for Chrome OS only.","Currently global engine is always used and 'GI.IBus.Objects.Bus.busGetGlobalEngine'","returns NULL until the first global engine is assigned.","You can use 'GI.IBus.Functions.setLogHandler' to disable a warning when","'GI.IBus.Objects.Bus.busGetGlobalEngine' returns NULL."] #-}
-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busIsGlobalEngineEnabledAsync'.
busIsGlobalEngineEnabledAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busIsGlobalEngineEnabledAsync'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
busIsGlobalEngineEnabledAsyncFinish :: a -> b -> m ()
busIsGlobalEngineEnabledAsyncFinish a
bus b
res = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
ibus_bus_is_global_engine_enabled_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusIsGlobalEngineEnabledAsyncFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusIsGlobalEngineEnabledAsyncFinishMethodInfo a signature where
    overloadedMethod = busIsGlobalEngineEnabledAsyncFinish

#endif

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

foreign import ccall "ibus_bus_list_active_engines" ibus_bus_list_active_engines :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    IO (Ptr (GList (Ptr IBus.EngineDesc.EngineDesc)))

{-# DEPRECATED busListActiveEngines ["(Since version 1.5.3)","Read dconf value","\\/desktop\\/ibus\\/general\\/preload-engines instead."] #-}
-- | List active engines synchronously.
busListActiveEngines ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> m [IBus.EngineDesc.EngineDesc]
    -- ^ __Returns:__ 
    --        A List of active engines.
busListActiveEngines :: a -> m [EngineDesc]
busListActiveEngines a
bus = IO [EngineDesc] -> m [EngineDesc]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [EngineDesc] -> m [EngineDesc])
-> IO [EngineDesc] -> m [EngineDesc]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr (GList (Ptr EngineDesc))
result <- Ptr Bus -> IO (Ptr (GList (Ptr EngineDesc)))
ibus_bus_list_active_engines Ptr Bus
bus'
    [Ptr EngineDesc]
result' <- Ptr (GList (Ptr EngineDesc)) -> IO [Ptr EngineDesc]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr EngineDesc))
result
    [EngineDesc]
result'' <- (Ptr EngineDesc -> IO EngineDesc)
-> [Ptr EngineDesc] -> IO [EngineDesc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr EngineDesc -> EngineDesc)
-> Ptr EngineDesc -> IO EngineDesc
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EngineDesc -> EngineDesc
IBus.EngineDesc.EngineDesc) [Ptr EngineDesc]
result'
    Ptr (GList (Ptr EngineDesc)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr EngineDesc))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    [EngineDesc] -> IO [EngineDesc]
forall (m :: * -> *) a. Monad m => a -> m a
return [EngineDesc]
result''

#if defined(ENABLE_OVERLOADING)
data BusListActiveEnginesMethodInfo
instance (signature ~ (m [IBus.EngineDesc.EngineDesc]), MonadIO m, IsBus a) => O.MethodInfo BusListActiveEnginesMethodInfo a signature where
    overloadedMethod = busListActiveEngines

#endif

-- method Bus::list_active_engines_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied or %NULL\n     if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_list_active_engines_async" ibus_bus_list_active_engines_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

{-# DEPRECATED busListActiveEnginesAsync ["(Since version 1.5.3)","Read dconf value","\\/desktop\\/ibus\\/general\\/preload-engines instead."] #-}
-- | List active engines asynchronously.
busListActiveEnginesAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied or 'P.Nothing'
    --      if you don\'t care about the result of the method invocation.
    -> m ()
busListActiveEnginesAsync :: a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busListActiveEnginesAsync a
bus Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_list_active_engines_async Ptr Bus
bus' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusListActiveEnginesAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusListActiveEnginesAsyncMethodInfo a signature where
    overloadedMethod = busListActiveEnginesAsync

#endif

-- method Bus::list_active_engines_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_list_active_engines_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "IBus" , name = "EngineDesc" }))
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_list_active_engines_async_finish" ibus_bus_list_active_engines_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr (GList (Ptr IBus.EngineDesc.EngineDesc)))

{-# DEPRECATED busListActiveEnginesAsyncFinish ["(Since version 1.5.3)","Read dconf value","\\/desktop\\/ibus\\/general\\/preload-engines instead."] #-}
-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busListActiveEnginesAsync'.
busListActiveEnginesAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busListActiveEnginesAsync'.
    -> m [IBus.EngineDesc.EngineDesc]
    -- ^ __Returns:__ 
    --         A List of active engines. /(Can throw 'Data.GI.Base.GError.GError')/
busListActiveEnginesAsyncFinish :: a -> b -> m [EngineDesc]
busListActiveEnginesAsyncFinish a
bus b
res = IO [EngineDesc] -> m [EngineDesc]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [EngineDesc] -> m [EngineDesc])
-> IO [EngineDesc] -> m [EngineDesc]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO [EngineDesc] -> IO () -> IO [EngineDesc]
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr (GList (Ptr EngineDesc))
result <- (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr EngineDesc))))
-> IO (Ptr (GList (Ptr EngineDesc)))
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr (GList (Ptr EngineDesc))))
 -> IO (Ptr (GList (Ptr EngineDesc))))
-> (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr EngineDesc))))
-> IO (Ptr (GList (Ptr EngineDesc)))
forall a b. (a -> b) -> a -> b
$ Ptr Bus
-> Ptr AsyncResult
-> Ptr (Ptr GError)
-> IO (Ptr (GList (Ptr EngineDesc)))
ibus_bus_list_active_engines_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        [Ptr EngineDesc]
result' <- Ptr (GList (Ptr EngineDesc)) -> IO [Ptr EngineDesc]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr EngineDesc))
result
        [EngineDesc]
result'' <- (Ptr EngineDesc -> IO EngineDesc)
-> [Ptr EngineDesc] -> IO [EngineDesc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr EngineDesc -> EngineDesc)
-> Ptr EngineDesc -> IO EngineDesc
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EngineDesc -> EngineDesc
IBus.EngineDesc.EngineDesc) [Ptr EngineDesc]
result'
        Ptr (GList (Ptr EngineDesc)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr EngineDesc))
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        [EngineDesc] -> IO [EngineDesc]
forall (m :: * -> *) a. Monad m => a -> m a
return [EngineDesc]
result''
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusListActiveEnginesAsyncFinishMethodInfo
instance (signature ~ (b -> m [IBus.EngineDesc.EngineDesc]), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusListActiveEnginesAsyncFinishMethodInfo a signature where
    overloadedMethod = busListActiveEnginesAsyncFinish

#endif

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

foreign import ccall "ibus_bus_list_engines" ibus_bus_list_engines :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    IO (Ptr (GList (Ptr IBus.EngineDesc.EngineDesc)))

-- | List engines synchronously.
busListEngines ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> m [IBus.EngineDesc.EngineDesc]
    -- ^ __Returns:__ 
    --         A List of engines.
busListEngines :: a -> m [EngineDesc]
busListEngines a
bus = IO [EngineDesc] -> m [EngineDesc]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [EngineDesc] -> m [EngineDesc])
-> IO [EngineDesc] -> m [EngineDesc]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr (GList (Ptr EngineDesc))
result <- Ptr Bus -> IO (Ptr (GList (Ptr EngineDesc)))
ibus_bus_list_engines Ptr Bus
bus'
    [Ptr EngineDesc]
result' <- Ptr (GList (Ptr EngineDesc)) -> IO [Ptr EngineDesc]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr EngineDesc))
result
    [EngineDesc]
result'' <- (Ptr EngineDesc -> IO EngineDesc)
-> [Ptr EngineDesc] -> IO [EngineDesc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr EngineDesc -> EngineDesc)
-> Ptr EngineDesc -> IO EngineDesc
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EngineDesc -> EngineDesc
IBus.EngineDesc.EngineDesc) [Ptr EngineDesc]
result'
    Ptr (GList (Ptr EngineDesc)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr EngineDesc))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    [EngineDesc] -> IO [EngineDesc]
forall (m :: * -> *) a. Monad m => a -> m a
return [EngineDesc]
result''

#if defined(ENABLE_OVERLOADING)
data BusListEnginesMethodInfo
instance (signature ~ (m [IBus.EngineDesc.EngineDesc]), MonadIO m, IsBus a) => O.MethodInfo BusListEnginesMethodInfo a signature where
    overloadedMethod = busListEngines

#endif

-- method Bus::list_engines_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied or %NULL\n     if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_list_engines_async" ibus_bus_list_engines_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | List engines asynchronously.
busListEnginesAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied or 'P.Nothing'
    --      if you don\'t care about the result of the method invocation.
    -> m ()
busListEnginesAsync :: a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busListEnginesAsync a
bus Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_list_engines_async Ptr Bus
bus' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusListEnginesAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusListEnginesAsyncMethodInfo a signature where
    overloadedMethod = busListEnginesAsync

#endif

-- method Bus::list_engines_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_list_engines_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "IBus" , name = "EngineDesc" }))
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_list_engines_async_finish" ibus_bus_list_engines_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr (GList (Ptr IBus.EngineDesc.EngineDesc)))

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busListEnginesAsync'.
busListEnginesAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busListEnginesAsync'.
    -> m [IBus.EngineDesc.EngineDesc]
    -- ^ __Returns:__ 
    --         A List of engines. /(Can throw 'Data.GI.Base.GError.GError')/
busListEnginesAsyncFinish :: a -> b -> m [EngineDesc]
busListEnginesAsyncFinish a
bus b
res = IO [EngineDesc] -> m [EngineDesc]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [EngineDesc] -> m [EngineDesc])
-> IO [EngineDesc] -> m [EngineDesc]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO [EngineDesc] -> IO () -> IO [EngineDesc]
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr (GList (Ptr EngineDesc))
result <- (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr EngineDesc))))
-> IO (Ptr (GList (Ptr EngineDesc)))
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr (GList (Ptr EngineDesc))))
 -> IO (Ptr (GList (Ptr EngineDesc))))
-> (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr EngineDesc))))
-> IO (Ptr (GList (Ptr EngineDesc)))
forall a b. (a -> b) -> a -> b
$ Ptr Bus
-> Ptr AsyncResult
-> Ptr (Ptr GError)
-> IO (Ptr (GList (Ptr EngineDesc)))
ibus_bus_list_engines_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        [Ptr EngineDesc]
result' <- Ptr (GList (Ptr EngineDesc)) -> IO [Ptr EngineDesc]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr EngineDesc))
result
        [EngineDesc]
result'' <- (Ptr EngineDesc -> IO EngineDesc)
-> [Ptr EngineDesc] -> IO [EngineDesc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr EngineDesc -> EngineDesc)
-> Ptr EngineDesc -> IO EngineDesc
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EngineDesc -> EngineDesc
IBus.EngineDesc.EngineDesc) [Ptr EngineDesc]
result'
        Ptr (GList (Ptr EngineDesc)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr EngineDesc))
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        [EngineDesc] -> IO [EngineDesc]
forall (m :: * -> *) a. Monad m => a -> m a
return [EngineDesc]
result''
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusListEnginesAsyncFinishMethodInfo
instance (signature ~ (b -> m [IBus.EngineDesc.EngineDesc]), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusListEnginesAsyncFinishMethodInfo a signature where
    overloadedMethod = busListEnginesAsyncFinish

#endif

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

foreign import ccall "ibus_bus_list_names" ibus_bus_list_names :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    IO (Ptr (GList CString))

-- | Return lists that attached to /@bus@/.
-- \<note>\<para>[FixMe] Not implemented yet, only return 'P.Nothing'.\<\/para>\<\/note>
-- \<note>\<para>[FixMe] Add async version.\<\/para>\<\/note>
busListNames ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> m [T.Text]
    -- ^ __Returns:__ Lists that attached to /@bus@/.
busListNames :: a -> m [Text]
busListNames a
bus = IO [Text] -> m [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr (GList CString)
result <- Ptr Bus -> IO (Ptr (GList CString))
ibus_bus_list_names Ptr Bus
bus'
    [CString]
result' <- Ptr (GList CString) -> IO [CString]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList CString)
result
    [Text]
result'' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
result'
    (CString -> IO ()) -> Ptr (GList CString) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
mapGList CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (GList CString)
result
    Ptr (GList CString) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList CString)
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''

#if defined(ENABLE_OVERLOADING)
data BusListNamesMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsBus a) => O.MethodInfo BusListNamesMethodInfo a signature where
    overloadedMethod = busListNames

#endif

-- method Bus::list_queued_owners
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusBus." , 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 to be queried."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TGList (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_list_queued_owners" ibus_bus_list_queued_owners :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr (GList CString))

-- | Lists the unique bus names of connections currently queued for a bus name.
-- FIXME add an asynchronous version.
busListQueuedOwners ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An IBusBus.
    -> T.Text
    -- ^ /@name@/: Name to be queried.
    -> m [T.Text]
    -- ^ __Returns:__ 
    --           The unique bus names of connections currently queued for /@name@/.
busListQueuedOwners :: a -> Text -> m [Text]
busListQueuedOwners a
bus Text
name = IO [Text] -> m [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr (GList CString)
result <- Ptr Bus -> CString -> IO (Ptr (GList CString))
ibus_bus_list_queued_owners Ptr Bus
bus' CString
name'
    [CString]
result' <- Ptr (GList CString) -> IO [CString]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList CString)
result
    [Text]
result'' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
result'
    (CString -> IO ()) -> Ptr (GList CString) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
mapGList CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (GList CString)
result
    Ptr (GList CString) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList CString)
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''

#if defined(ENABLE_OVERLOADING)
data BusListQueuedOwnersMethodInfo
instance (signature ~ (T.Text -> m [T.Text]), MonadIO m, IsBus a) => O.MethodInfo BusListQueuedOwnersMethodInfo a signature where
    overloadedMethod = busListQueuedOwners

#endif

-- method Bus::name_has_owner
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , 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 to be checked."
--                 , 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_bus_name_has_owner" ibus_bus_name_has_owner :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- name : TBasicType TUTF8
    IO CInt

-- | Checks whether the name has owner synchronously.
busNameHasOwner ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@name@/: Name to be checked.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the name has owner, 'P.False' otherwise.
busNameHasOwner :: a -> Text -> m Bool
busNameHasOwner a
bus Text
name = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
name' <- Text -> IO CString
textToCString Text
name
    CInt
result <- Ptr Bus -> CString -> IO CInt
ibus_bus_name_has_owner Ptr Bus
bus' CString
name'
    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
bus
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BusNameHasOwnerMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsBus a) => O.MethodInfo BusNameHasOwnerMethodInfo a signature where
    overloadedMethod = busNameHasOwner

#endif

-- method Bus::name_has_owner_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , 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 to be checked."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied\n     or %NULL if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_name_has_owner_async" ibus_bus_name_has_owner_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- name : TBasicType TUTF8
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Checks whether the name has owner asynchronously.
busNameHasOwnerAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@name@/: Name to be checked.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    --      or 'P.Nothing' if you don\'t care about the result of the method invocation.
    -> m ()
busNameHasOwnerAsync :: a -> Text -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busNameHasOwnerAsync a
bus Text
name Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> CString
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_name_has_owner_async Ptr Bus
bus' CString
name' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    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 BusNameHasOwnerAsyncMethodInfo
instance (signature ~ (T.Text -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusNameHasOwnerAsyncMethodInfo a signature where
    overloadedMethod = busNameHasOwnerAsync

#endif

-- method Bus::name_has_owner_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_name_has_owner_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_name_has_owner_async_finish" ibus_bus_name_has_owner_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busNameHasOwnerAsync'.
busNameHasOwnerAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busNameHasOwnerAsync'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
busNameHasOwnerAsyncFinish :: a -> b -> m ()
busNameHasOwnerAsyncFinish a
bus b
res = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
ibus_bus_name_has_owner_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusNameHasOwnerAsyncFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusNameHasOwnerAsyncFinishMethodInfo a signature where
    overloadedMethod = busNameHasOwnerAsyncFinish

#endif

-- method Bus::preload_engines
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "names"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A %NULL-terminated array of engine names."
--                 , 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_bus_preload_engines" ibus_bus_preload_engines :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr CString ->                          -- names : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO CInt

-- | Start bus components by engine names synchronously.
busPreloadEngines ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> [T.Text]
    -- ^ /@names@/: A 'P.Nothing'-terminated array of engine names.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if components start. 'P.False' otherwise.
busPreloadEngines :: a -> [Text] -> m Bool
busPreloadEngines a
bus [Text]
names = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr CString
names' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
names
    CInt
result <- Ptr Bus -> Ptr CString -> IO CInt
ibus_bus_preload_engines Ptr Bus
bus' Ptr CString
names'
    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
bus
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
names'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
names'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BusPreloadEnginesMethodInfo
instance (signature ~ ([T.Text] -> m Bool), MonadIO m, IsBus a) => O.MethodInfo BusPreloadEnginesMethodInfo a signature where
    overloadedMethod = busPreloadEngines

#endif

-- method Bus::preload_engines_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "names"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A %NULL-terminated array of engine names."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied\n     or %NULL if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_preload_engines_async" ibus_bus_preload_engines_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr CString ->                          -- names : TCArray True (-1) (-1) (TBasicType TUTF8)
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Start bus components by engine names asynchronously.
busPreloadEnginesAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> [T.Text]
    -- ^ /@names@/: A 'P.Nothing'-terminated array of engine names.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    --      or 'P.Nothing' if you don\'t care about the result of the method invocation.
    -> m ()
busPreloadEnginesAsync :: a -> [Text] -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busPreloadEnginesAsync a
bus [Text]
names Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr CString
names' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
names
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> Ptr CString
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_preload_engines_async Ptr Bus
bus' Ptr CString
names' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
names'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
names'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusPreloadEnginesAsyncMethodInfo
instance (signature ~ ([T.Text] -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusPreloadEnginesAsyncMethodInfo a signature where
    overloadedMethod = busPreloadEnginesAsync

#endif

-- method Bus::preload_engines_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_preload_engines_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_preload_engines_async_finish" ibus_bus_preload_engines_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busPreloadEnginesAsync'.
busPreloadEnginesAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busPreloadEnginesAsync'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
busPreloadEnginesAsyncFinish :: a -> b -> m ()
busPreloadEnginesAsyncFinish a
bus b
res = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
ibus_bus_preload_engines_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusPreloadEnginesAsyncFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusPreloadEnginesAsyncFinishMethodInfo a signature where
    overloadedMethod = busPreloadEnginesAsyncFinish

#endif

-- method Bus::register_component
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "component"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Component" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A input engine component."
--                 , 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_bus_register_component" ibus_bus_register_component :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr IBus.Component.Component ->         -- component : TInterface (Name {namespace = "IBus", name = "Component"})
    IO CInt

-- | Register a component to an t'GI.IBus.Objects.Bus.Bus' synchronously.
busRegisterComponent ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, IBus.Component.IsComponent b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@component@/: A input engine component.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the \"RegisterComponent\" call is successful, 'P.False' otherwise.
busRegisterComponent :: a -> b -> m Bool
busRegisterComponent a
bus b
component = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr Component
component' <- b -> IO (Ptr Component)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
component
    CInt
result <- Ptr Bus -> Ptr Component -> IO CInt
ibus_bus_register_component Ptr Bus
bus' Ptr Component
component'
    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
bus
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
component
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BusRegisterComponentMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsBus a, IBus.Component.IsComponent b) => O.MethodInfo BusRegisterComponentMethodInfo a signature where
    overloadedMethod = busRegisterComponent

#endif

-- method Bus::register_component_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "component"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Component" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A input engine component."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied\n     or %NULL if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_register_component_async" ibus_bus_register_component_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr IBus.Component.Component ->         -- component : TInterface (Name {namespace = "IBus", name = "Component"})
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Register a component to an t'GI.IBus.Objects.Bus.Bus' asynchronously.
busRegisterComponentAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, IBus.Component.IsComponent b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@component@/: A input engine component.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (c)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    --      or 'P.Nothing' if you don\'t care about the result of the method invocation.
    -> m ()
busRegisterComponentAsync :: a -> b -> Int32 -> Maybe c -> Maybe AsyncReadyCallback -> m ()
busRegisterComponentAsync a
bus b
component Int32
timeoutMsec Maybe c
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr Component
component' <- b -> IO (Ptr Component)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
component
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> Ptr Component
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_register_component_async Ptr Bus
bus' Ptr Component
component' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
component
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusRegisterComponentAsyncMethodInfo
instance (signature ~ (b -> Int32 -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, IBus.Component.IsComponent b, Gio.Cancellable.IsCancellable c) => O.MethodInfo BusRegisterComponentAsyncMethodInfo a signature where
    overloadedMethod = busRegisterComponentAsync

#endif

-- method Bus::register_component_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_register_component_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_register_component_async_finish" ibus_bus_register_component_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busRegisterComponentAsync'.
busRegisterComponentAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busRegisterComponentAsync'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
busRegisterComponentAsyncFinish :: a -> b -> m ()
busRegisterComponentAsyncFinish a
bus b
res = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
ibus_bus_register_component_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusRegisterComponentAsyncFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusRegisterComponentAsyncFinishMethodInfo a signature where
    overloadedMethod = busRegisterComponentAsyncFinish

#endif

-- method Bus::release_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , 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 to be released."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_release_name" ibus_bus_release_name :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- name : TBasicType TUTF8
    IO Word32

-- | Release a name to IBus daemon synchronously.
busReleaseName ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@name@/: Name to be released.
    -> m Word32
    -- ^ __Returns:__ 0 if failed; positive number otherwise.
busReleaseName :: a -> Text -> m Word32
busReleaseName a
bus Text
name = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
name' <- Text -> IO CString
textToCString Text
name
    Word32
result <- Ptr Bus -> CString -> IO Word32
ibus_bus_release_name Ptr Bus
bus' CString
name'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data BusReleaseNameMethodInfo
instance (signature ~ (T.Text -> m Word32), MonadIO m, IsBus a) => O.MethodInfo BusReleaseNameMethodInfo a signature where
    overloadedMethod = busReleaseName

#endif

-- method Bus::release_name_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , 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 to be released."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied\n     or %NULL if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_release_name_async" ibus_bus_release_name_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- name : TBasicType TUTF8
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Release a name to IBus daemon asynchronously.
busReleaseNameAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@name@/: Name to be released.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    --      or 'P.Nothing' if you don\'t care about the result of the method invocation.
    -> m ()
busReleaseNameAsync :: a -> Text -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busReleaseNameAsync a
bus Text
name Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> CString
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_release_name_async Ptr Bus
bus' CString
name' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    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 BusReleaseNameAsyncMethodInfo
instance (signature ~ (T.Text -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusReleaseNameAsyncMethodInfo a signature where
    overloadedMethod = busReleaseNameAsync

#endif

-- method Bus::release_name_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_release_name_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_release_name_async_finish" ibus_bus_release_name_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO Word32

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busReleaseNameAsync'.
busReleaseNameAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busReleaseNameAsync'.
    -> m Word32
    -- ^ __Returns:__ 0 if failed; positive number otherwise. /(Can throw 'Data.GI.Base.GError.GError')/
busReleaseNameAsyncFinish :: a -> b -> m Word32
busReleaseNameAsyncFinish a
bus b
res = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO Word32 -> IO () -> IO Word32
forall a b. IO a -> IO b -> IO a
onException (do
        Word32
result <- (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Word32) -> IO Word32)
-> (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO Word32
ibus_bus_release_name_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusReleaseNameAsyncFinishMethodInfo
instance (signature ~ (b -> m Word32), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusReleaseNameAsyncFinishMethodInfo a signature where
    overloadedMethod = busReleaseNameAsyncFinish

#endif

-- method Bus::remove_match
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rule"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Match rule." , 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_bus_remove_match" ibus_bus_remove_match :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- rule : TBasicType TUTF8
    IO CInt

-- | Remove a match rule to an t'GI.IBus.Objects.Bus.Bus' synchronously.
busRemoveMatch ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@rule@/: Match rule.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the rule is removed. 'P.False' otherwise.
busRemoveMatch :: a -> Text -> m Bool
busRemoveMatch a
bus Text
rule = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
rule' <- Text -> IO CString
textToCString Text
rule
    CInt
result <- Ptr Bus -> CString -> IO CInt
ibus_bus_remove_match Ptr Bus
bus' CString
rule'
    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
bus
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
rule'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BusRemoveMatchMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsBus a) => O.MethodInfo BusRemoveMatchMethodInfo a signature where
    overloadedMethod = busRemoveMatch

#endif

-- method Bus::remove_match_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rule"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Match rule." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied\n     or %NULL if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_remove_match_async" ibus_bus_remove_match_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- rule : TBasicType TUTF8
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Remove a match rule to an IBusBus asynchronously.
busRemoveMatchAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@rule@/: Match rule.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    --      or 'P.Nothing' if you don\'t care about the result of the method invocation.
    -> m ()
busRemoveMatchAsync :: a -> Text -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busRemoveMatchAsync a
bus Text
rule Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
rule' <- Text -> IO CString
textToCString Text
rule
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> CString
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_remove_match_async Ptr Bus
bus' CString
rule' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
rule'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusRemoveMatchAsyncMethodInfo
instance (signature ~ (T.Text -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusRemoveMatchAsyncMethodInfo a signature where
    overloadedMethod = busRemoveMatchAsync

#endif

-- method Bus::remove_match_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_remove_match_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_remove_match_async_finish" ibus_bus_remove_match_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busRemoveMatchAsync'.
busRemoveMatchAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busRemoveMatchAsync'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
busRemoveMatchAsyncFinish :: a -> b -> m ()
busRemoveMatchAsyncFinish a
bus b
res = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
ibus_bus_remove_match_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusRemoveMatchAsyncFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusRemoveMatchAsyncFinishMethodInfo a signature where
    overloadedMethod = busRemoveMatchAsyncFinish

#endif

-- method Bus::request_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the IBusBus instance to be processed."
--                 , 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 to be requested."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "IBusBusNameFlag." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_request_name" ibus_bus_request_name :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- name : TBasicType TUTF8
    Word32 ->                               -- flags : TBasicType TUInt32
    IO Word32

-- | Request a name from IBus daemon synchronously.
busRequestName ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: the IBusBus instance to be processed.
    -> T.Text
    -- ^ /@name@/: Name to be requested.
    -> Word32
    -- ^ /@flags@/: IBusBusNameFlag.
    -> m Word32
    -- ^ __Returns:__ 0 if failed; IBusBusRequestNameReply otherwise.
busRequestName :: a -> Text -> Word32 -> m Word32
busRequestName a
bus Text
name Word32
flags = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
name' <- Text -> IO CString
textToCString Text
name
    Word32
result <- Ptr Bus -> CString -> Word32 -> IO Word32
ibus_bus_request_name Ptr Bus
bus' CString
name' Word32
flags
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data BusRequestNameMethodInfo
instance (signature ~ (T.Text -> Word32 -> m Word32), MonadIO m, IsBus a) => O.MethodInfo BusRequestNameMethodInfo a signature where
    overloadedMethod = busRequestName

#endif

-- method Bus::request_name_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , 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 to be requested."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags (FixMe)." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied or %NULL\n     if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_request_name_async" ibus_bus_request_name_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- name : TBasicType TUTF8
    Word32 ->                               -- flags : TBasicType TUInt
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Request a name from IBus daemon asynchronously.
busRequestNameAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@name@/: Name to be requested.
    -> Word32
    -- ^ /@flags@/: Flags (FixMe).
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied or 'P.Nothing'
    --      if you don\'t care about the result of the method invocation.
    -> m ()
busRequestNameAsync :: a
-> Text
-> Word32
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
busRequestNameAsync a
bus Text
name Word32
flags Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> CString
-> Word32
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_request_name_async Ptr Bus
bus' CString
name' Word32
flags Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    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 BusRequestNameAsyncMethodInfo
instance (signature ~ (T.Text -> Word32 -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusRequestNameAsyncMethodInfo a signature where
    overloadedMethod = busRequestNameAsync

#endif

-- method Bus::request_name_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_request_name_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_request_name_async_finish" ibus_bus_request_name_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO Word32

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busRequestNameAsync'.
busRequestNameAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busRequestNameAsync'.
    -> m Word32
    -- ^ __Returns:__ 0 if failed; positive number otherwise. /(Can throw 'Data.GI.Base.GError.GError')/
busRequestNameAsyncFinish :: a -> b -> m Word32
busRequestNameAsyncFinish a
bus b
res = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO Word32 -> IO () -> IO Word32
forall a b. IO a -> IO b -> IO a
onException (do
        Word32
result <- (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Word32) -> IO Word32)
-> (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO Word32
ibus_bus_request_name_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusRequestNameAsyncFinishMethodInfo
instance (signature ~ (b -> m Word32), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusRequestNameAsyncFinishMethodInfo a signature where
    overloadedMethod = busRequestNameAsyncFinish

#endif

-- method Bus::set_global_engine
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "global_engine"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A new engine name." , 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_bus_set_global_engine" ibus_bus_set_global_engine :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- global_engine : TBasicType TUTF8
    IO CInt

-- | Set current global engine synchronously.
busSetGlobalEngine ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@globalEngine@/: A new engine name.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the global engine was set successfully.
busSetGlobalEngine :: a -> Text -> m Bool
busSetGlobalEngine a
bus Text
globalEngine = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
globalEngine' <- Text -> IO CString
textToCString Text
globalEngine
    CInt
result <- Ptr Bus -> CString -> IO CInt
ibus_bus_set_global_engine Ptr Bus
bus' CString
globalEngine'
    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
bus
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
globalEngine'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BusSetGlobalEngineMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsBus a) => O.MethodInfo BusSetGlobalEngineMethodInfo a signature where
    overloadedMethod = busSetGlobalEngine

#endif

-- method Bus::set_global_engine_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "global_engine"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A new engine name." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied\n     or %NULL if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_set_global_engine_async" ibus_bus_set_global_engine_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- global_engine : TBasicType TUTF8
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Set current global engine asynchronously.
busSetGlobalEngineAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@globalEngine@/: A new engine name.
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    --      or 'P.Nothing' if you don\'t care about the result of the method invocation.
    -> m ()
busSetGlobalEngineAsync :: a -> Text -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
busSetGlobalEngineAsync a
bus Text
globalEngine Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
globalEngine' <- Text -> IO CString
textToCString Text
globalEngine
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> CString
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_set_global_engine_async Ptr Bus
bus' CString
globalEngine' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
globalEngine'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusSetGlobalEngineAsyncMethodInfo
instance (signature ~ (T.Text -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusSetGlobalEngineAsyncMethodInfo a signature where
    overloadedMethod = busSetGlobalEngineAsync

#endif

-- method Bus::set_global_engine_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_set_global_engine_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_set_global_engine_async_finish" ibus_bus_set_global_engine_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busSetGlobalEngineAsync'.
busSetGlobalEngineAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busSetGlobalEngineAsync'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
busSetGlobalEngineAsyncFinish :: a -> b -> m ()
busSetGlobalEngineAsyncFinish a
bus b
res = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
ibus_bus_set_global_engine_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusSetGlobalEngineAsyncFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusSetGlobalEngineAsyncFinishMethodInfo a signature where
    overloadedMethod = busSetGlobalEngineAsyncFinish

#endif

-- method Bus::set_ibus_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "property name in org.freedesktop.DBus.Properties.Set"
--                 , 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 "value in org.freedesktop.DBus.Properties.Set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_set_ibus_property" ibus_bus_set_ibus_property :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr GVariant ->                         -- value : TVariant
    IO ()

-- | Set org.freedesktop.DBus.Properties.
busSetIbusProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@propertyName@/: property name in org.freedesktop.DBus.Properties.Set
    -> GVariant
    -- ^ /@value@/: value in org.freedesktop.DBus.Properties.Set
    -> m ()
busSetIbusProperty :: a -> Text -> GVariant -> m ()
busSetIbusProperty a
bus Text
propertyName 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GVariant
value' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
value
    Ptr Bus -> CString -> Ptr GVariant -> IO ()
ibus_bus_set_ibus_property Ptr Bus
bus' CString
propertyName' Ptr GVariant
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusSetIbusPropertyMethodInfo
instance (signature ~ (T.Text -> GVariant -> m ()), MonadIO m, IsBus a) => O.MethodInfo BusSetIbusPropertyMethodInfo a signature where
    overloadedMethod = busSetIbusProperty

#endif

-- method Bus::set_ibus_property_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "property name in org.freedesktop.DBus.Properties.Set"
--                 , 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 "value in org.freedesktop.DBus.Properties.Set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The timeout in milliseconds or -1 to use the default timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncReadyCallback to call when the request is satisfied\n     or %NULL if you don't care about the result of the method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The data to pass to callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_set_ibus_property_async" ibus_bus_set_ibus_property_async :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr GVariant ->                         -- value : TVariant
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Set org.freedesktop.DBus.Properties asynchronously.
busSetIbusPropertyAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> T.Text
    -- ^ /@propertyName@/: property name in org.freedesktop.DBus.Properties.Set
    -> GVariant
    -- ^ /@value@/: value in org.freedesktop.DBus.Properties.Set
    -> Int32
    -- ^ /@timeoutMsec@/: The timeout in milliseconds or -1 to use the default timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: A t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    --      or 'P.Nothing' if you don\'t care about the result of the method invocation.
    -> m ()
busSetIbusPropertyAsync :: a
-> Text
-> GVariant
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
busSetIbusPropertyAsync a
bus Text
propertyName GVariant
value Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GVariant
value' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
value
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Bus
-> CString
-> Ptr GVariant
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ibus_bus_set_ibus_property_async Ptr Bus
bus' CString
propertyName' Ptr GVariant
value' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
value
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusSetIbusPropertyAsyncMethodInfo
instance (signature ~ (T.Text -> GVariant -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsBus a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BusSetIbusPropertyAsyncMethodInfo a signature where
    overloadedMethod = busSetIbusPropertyAsync

#endif

-- method Bus::set_ibus_property_async_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GAsyncResult obtained from the #GAsyncReadyCallback passed to\n  ibus_bus_set_ibus_property_async()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ibus_bus_set_ibus_property_async_finish" ibus_bus_set_ibus_property_async_finish :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an operation started with 'GI.IBus.Objects.Bus.busSetIbusPropertyAsync'.
busSetIbusPropertyAsyncFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> b
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to
    --   'GI.IBus.Objects.Bus.busSetIbusPropertyAsync'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
busSetIbusPropertyAsyncFinish :: a -> b -> m ()
busSetIbusPropertyAsyncFinish a
bus b
res = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Bus -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
ibus_bus_set_ibus_property_async_finish Ptr Bus
bus' Ptr AsyncResult
res'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BusSetIbusPropertyAsyncFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsBus a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo BusSetIbusPropertyAsyncFinishMethodInfo a signature where
    overloadedMethod = busSetIbusPropertyAsyncFinish

#endif

-- method Bus::set_watch_dbus_signal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "watch"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "%TRUE if you want ibusbus to emit \"name-owner-changed\" signal when\nibus-daemon emits the NameOwnerChanged DBus signal."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_set_watch_dbus_signal" ibus_bus_set_watch_dbus_signal :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CInt ->                                 -- watch : TBasicType TBoolean
    IO ()

-- | Start or stop watching the NameOwnerChanged DBus signal.
busSetWatchDbusSignal ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> Bool
    -- ^ /@watch@/: 'P.True' if you want ibusbus to emit \"name-owner-changed\" signal when
    -- ibus-daemon emits the NameOwnerChanged DBus signal.
    -> m ()
busSetWatchDbusSignal :: a -> Bool -> m ()
busSetWatchDbusSignal a
bus Bool
watch = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    let watch' :: CInt
watch' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
watch
    Ptr Bus -> CInt -> IO ()
ibus_bus_set_watch_dbus_signal Ptr Bus
bus' CInt
watch'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusSetWatchDbusSignalMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsBus a) => O.MethodInfo BusSetWatchDbusSignalMethodInfo a signature where
    overloadedMethod = busSetWatchDbusSignal

#endif

-- method Bus::set_watch_ibus_signal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "bus"
--           , argType = TInterface Name { namespace = "IBus" , name = "Bus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusBus." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "watch"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "%TRUE if you want ibusbus to emit \"global-engine-changed\" signal when\nibus-daemon emits the GlobalEngineChanged IBus signal."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_bus_set_watch_ibus_signal" ibus_bus_set_watch_ibus_signal :: 
    Ptr Bus ->                              -- bus : TInterface (Name {namespace = "IBus", name = "Bus"})
    CInt ->                                 -- watch : TBasicType TBoolean
    IO ()

-- | Start or stop watching the GlobalEngineChanged IBus signal.
busSetWatchIbusSignal ::
    (B.CallStack.HasCallStack, MonadIO m, IsBus a) =>
    a
    -- ^ /@bus@/: An t'GI.IBus.Objects.Bus.Bus'.
    -> Bool
    -- ^ /@watch@/: 'P.True' if you want ibusbus to emit \"global-engine-changed\" signal when
    -- ibus-daemon emits the GlobalEngineChanged IBus signal.
    -> m ()
busSetWatchIbusSignal :: a -> Bool -> m ()
busSetWatchIbusSignal a
bus Bool
watch = 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 Bus
bus' <- a -> IO (Ptr Bus)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bus
    let watch' :: CInt
watch' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
watch
    Ptr Bus -> CInt -> IO ()
ibus_bus_set_watch_ibus_signal Ptr Bus
bus' CInt
watch'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bus
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BusSetWatchIbusSignalMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsBus a) => O.MethodInfo BusSetWatchIbusSignalMethodInfo a signature where
    overloadedMethod = busSetWatchIbusSignal

#endif