{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An IBusProxy is the base of all proxy objects,
-- which communicate the corresponding @/IBusServices/@ on the other end of
-- IBusConnection.
-- For example, IBus clients (such as editors, web browsers) invoke the proxy
-- object,
-- IBusInputContext to communicate with the InputContext service of the
-- ibus-daemon.
-- 
-- Almost all services have corresponding proxies, except very simple services.

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

module GI.IBus.Objects.Proxy
    ( 

-- * Exported types
    Proxy(..)                               ,
    IsProxy                                 ,
    toProxy                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [call]("GI.Gio.Objects.DBusProxy#g:method:call"), [callFinish]("GI.Gio.Objects.DBusProxy#g:method:callFinish"), [callSync]("GI.Gio.Objects.DBusProxy#g:method:callSync"), [callWithUnixFdList]("GI.Gio.Objects.DBusProxy#g:method:callWithUnixFdList"), [callWithUnixFdListFinish]("GI.Gio.Objects.DBusProxy#g:method:callWithUnixFdListFinish"), [callWithUnixFdListSync]("GI.Gio.Objects.DBusProxy#g:method:callWithUnixFdListSync"), [destroy]("GI.IBus.Objects.Proxy#g:method:destroy"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [init]("GI.Gio.Interfaces.Initable#g:method:init"), [initAsync]("GI.Gio.Interfaces.AsyncInitable#g:method:initAsync"), [initFinish]("GI.Gio.Interfaces.AsyncInitable#g:method:initFinish"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCachedProperty]("GI.Gio.Objects.DBusProxy#g:method:getCachedProperty"), [getCachedPropertyNames]("GI.Gio.Objects.DBusProxy#g:method:getCachedPropertyNames"), [getConnection]("GI.Gio.Objects.DBusProxy#g:method:getConnection"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDefaultTimeout]("GI.Gio.Objects.DBusProxy#g:method:getDefaultTimeout"), [getFlags]("GI.Gio.Objects.DBusProxy#g:method:getFlags"), [getInfo]("GI.Gio.Interfaces.DBusInterface#g:method:getInfo"), [getInterfaceInfo]("GI.Gio.Objects.DBusProxy#g:method:getInterfaceInfo"), [getInterfaceName]("GI.Gio.Objects.DBusProxy#g:method:getInterfaceName"), [getName]("GI.Gio.Objects.DBusProxy#g:method:getName"), [getNameOwner]("GI.Gio.Objects.DBusProxy#g:method:getNameOwner"), [getObject]("GI.Gio.Interfaces.DBusInterface#g:method:getObject"), [getObjectPath]("GI.Gio.Objects.DBusProxy#g:method:getObjectPath"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setCachedProperty]("GI.Gio.Objects.DBusProxy#g:method:setCachedProperty"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDefaultTimeout]("GI.Gio.Objects.DBusProxy#g:method:setDefaultTimeout"), [setInterfaceInfo]("GI.Gio.Objects.DBusProxy#g:method:setInterfaceInfo"), [setObject]("GI.Gio.Interfaces.DBusInterface#g:method:setObject"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveProxyMethod                      ,
#endif

-- ** destroy #method:destroy#

#if defined(ENABLE_OVERLOADING)
    ProxyDestroyMethodInfo                  ,
#endif
    proxyDestroy                            ,




 -- * Signals


-- ** destroy #signal:destroy#

    ProxyDestroyCallback                    ,
#if defined(ENABLE_OVERLOADING)
    ProxyDestroySignalInfo                  ,
#endif
    afterProxyDestroy                       ,
    onProxyDestroy                          ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.AsyncInitable as Gio.AsyncInitable
import qualified GI.Gio.Interfaces.DBusInterface as Gio.DBusInterface
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Objects.DBusProxy as Gio.DBusProxy

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

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

foreign import ccall "ibus_proxy_get_type"
    c_ibus_proxy_get_type :: IO B.Types.GType

instance B.Types.TypedObject Proxy where
    glibType :: IO GType
glibType = IO GType
c_ibus_proxy_get_type

instance B.Types.GObject Proxy

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

instance O.HasParentTypes Proxy
type instance O.ParentTypes Proxy = '[Gio.DBusProxy.DBusProxy, GObject.Object.Object, Gio.AsyncInitable.AsyncInitable, Gio.DBusInterface.DBusInterface, Gio.Initable.Initable]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveProxyMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveProxyMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveProxyMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveProxyMethod "call" o = Gio.DBusProxy.DBusProxyCallMethodInfo
    ResolveProxyMethod "callFinish" o = Gio.DBusProxy.DBusProxyCallFinishMethodInfo
    ResolveProxyMethod "callSync" o = Gio.DBusProxy.DBusProxyCallSyncMethodInfo
    ResolveProxyMethod "callWithUnixFdList" o = Gio.DBusProxy.DBusProxyCallWithUnixFdListMethodInfo
    ResolveProxyMethod "callWithUnixFdListFinish" o = Gio.DBusProxy.DBusProxyCallWithUnixFdListFinishMethodInfo
    ResolveProxyMethod "callWithUnixFdListSync" o = Gio.DBusProxy.DBusProxyCallWithUnixFdListSyncMethodInfo
    ResolveProxyMethod "destroy" o = ProxyDestroyMethodInfo
    ResolveProxyMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveProxyMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveProxyMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveProxyMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolveProxyMethod "initAsync" o = Gio.AsyncInitable.AsyncInitableInitAsyncMethodInfo
    ResolveProxyMethod "initFinish" o = Gio.AsyncInitable.AsyncInitableInitFinishMethodInfo
    ResolveProxyMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveProxyMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveProxyMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveProxyMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveProxyMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveProxyMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveProxyMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveProxyMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveProxyMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveProxyMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveProxyMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveProxyMethod "getCachedProperty" o = Gio.DBusProxy.DBusProxyGetCachedPropertyMethodInfo
    ResolveProxyMethod "getCachedPropertyNames" o = Gio.DBusProxy.DBusProxyGetCachedPropertyNamesMethodInfo
    ResolveProxyMethod "getConnection" o = Gio.DBusProxy.DBusProxyGetConnectionMethodInfo
    ResolveProxyMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveProxyMethod "getDefaultTimeout" o = Gio.DBusProxy.DBusProxyGetDefaultTimeoutMethodInfo
    ResolveProxyMethod "getFlags" o = Gio.DBusProxy.DBusProxyGetFlagsMethodInfo
    ResolveProxyMethod "getInfo" o = Gio.DBusInterface.DBusInterfaceGetInfoMethodInfo
    ResolveProxyMethod "getInterfaceInfo" o = Gio.DBusProxy.DBusProxyGetInterfaceInfoMethodInfo
    ResolveProxyMethod "getInterfaceName" o = Gio.DBusProxy.DBusProxyGetInterfaceNameMethodInfo
    ResolveProxyMethod "getName" o = Gio.DBusProxy.DBusProxyGetNameMethodInfo
    ResolveProxyMethod "getNameOwner" o = Gio.DBusProxy.DBusProxyGetNameOwnerMethodInfo
    ResolveProxyMethod "getObject" o = Gio.DBusInterface.DBusInterfaceGetObjectMethodInfo
    ResolveProxyMethod "getObjectPath" o = Gio.DBusProxy.DBusProxyGetObjectPathMethodInfo
    ResolveProxyMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveProxyMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveProxyMethod "setCachedProperty" o = Gio.DBusProxy.DBusProxySetCachedPropertyMethodInfo
    ResolveProxyMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveProxyMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveProxyMethod "setDefaultTimeout" o = Gio.DBusProxy.DBusProxySetDefaultTimeoutMethodInfo
    ResolveProxyMethod "setInterfaceInfo" o = Gio.DBusProxy.DBusProxySetInterfaceInfoMethodInfo
    ResolveProxyMethod "setObject" o = Gio.DBusInterface.DBusInterfaceSetObjectMethodInfo
    ResolveProxyMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveProxyMethod l o = O.MethodResolutionFailed l o

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

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

#endif

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

#endif

-- signal Proxy::destroy
-- | Destroy and free an IBusProxy
-- 
-- See also:  'GI.IBus.Objects.Proxy.proxyDestroy'.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>\<\/note>
type ProxyDestroyCallback =
    IO ()

type C_ProxyDestroyCallback =
    Ptr Proxy ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ProxyDestroyCallback :: 
    GObject a => (a -> ProxyDestroyCallback) ->
    C_ProxyDestroyCallback
wrap_ProxyDestroyCallback :: forall a. GObject a => (a -> IO ()) -> C_ProxyDestroyCallback
wrap_ProxyDestroyCallback a -> IO ()
gi'cb Ptr Proxy
gi'selfPtr Ptr ()
_ = do
    Ptr Proxy -> (Proxy -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Proxy
gi'selfPtr ((Proxy -> IO ()) -> IO ()) -> (Proxy -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Proxy
gi'self -> a -> IO ()
gi'cb (Proxy -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Proxy
gi'self) 


-- | Connect a signal handler for the [destroy](#signal:destroy) 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' proxy #destroy callback
-- @
-- 
-- 
onProxyDestroy :: (IsProxy a, MonadIO m) => a -> ((?self :: a) => ProxyDestroyCallback) -> m SignalHandlerId
onProxyDestroy :: forall a (m :: * -> *).
(IsProxy a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onProxyDestroy a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ProxyDestroyCallback
wrapped' = (a -> IO ()) -> C_ProxyDestroyCallback
forall a. GObject a => (a -> IO ()) -> C_ProxyDestroyCallback
wrap_ProxyDestroyCallback a -> IO ()
wrapped
    FunPtr C_ProxyDestroyCallback
wrapped'' <- C_ProxyDestroyCallback -> IO (FunPtr C_ProxyDestroyCallback)
mk_ProxyDestroyCallback C_ProxyDestroyCallback
wrapped'
    a
-> Text
-> FunPtr C_ProxyDestroyCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"destroy" FunPtr C_ProxyDestroyCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [destroy](#signal:destroy) 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' proxy #destroy callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterProxyDestroy :: (IsProxy a, MonadIO m) => a -> ((?self :: a) => ProxyDestroyCallback) -> m SignalHandlerId
afterProxyDestroy :: forall a (m :: * -> *).
(IsProxy a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterProxyDestroy a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ProxyDestroyCallback
wrapped' = (a -> IO ()) -> C_ProxyDestroyCallback
forall a. GObject a => (a -> IO ()) -> C_ProxyDestroyCallback
wrap_ProxyDestroyCallback a -> IO ()
wrapped
    FunPtr C_ProxyDestroyCallback
wrapped'' <- C_ProxyDestroyCallback -> IO (FunPtr C_ProxyDestroyCallback)
mk_ProxyDestroyCallback C_ProxyDestroyCallback
wrapped'
    a
-> Text
-> FunPtr C_ProxyDestroyCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"destroy" FunPtr C_ProxyDestroyCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ProxyDestroySignalInfo
instance SignalInfo ProxyDestroySignalInfo where
    type HaskellCallbackType ProxyDestroySignalInfo = ProxyDestroyCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ProxyDestroyCallback cb
        cb'' <- mk_ProxyDestroyCallback cb'
        connectSignalFunPtr obj "destroy" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Proxy::destroy"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.7/docs/GI-IBus-Objects-Proxy.html#g:signal:destroy"})

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Proxy
type instance O.AttributeList Proxy = ProxyAttributeList
type ProxyAttributeList = ('[ '("gBusType", Gio.DBusProxy.DBusProxyGBusTypePropertyInfo), '("gConnection", Gio.DBusProxy.DBusProxyGConnectionPropertyInfo), '("gDefaultTimeout", Gio.DBusProxy.DBusProxyGDefaultTimeoutPropertyInfo), '("gFlags", Gio.DBusProxy.DBusProxyGFlagsPropertyInfo), '("gInterfaceInfo", Gio.DBusProxy.DBusProxyGInterfaceInfoPropertyInfo), '("gInterfaceName", Gio.DBusProxy.DBusProxyGInterfaceNamePropertyInfo), '("gName", Gio.DBusProxy.DBusProxyGNamePropertyInfo), '("gNameOwner", Gio.DBusProxy.DBusProxyGNameOwnerPropertyInfo), '("gObjectPath", Gio.DBusProxy.DBusProxyGObjectPathPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Proxy = ProxySignalList
type ProxySignalList = ('[ '("destroy", ProxyDestroySignalInfo), '("gPropertiesChanged", Gio.DBusProxy.DBusProxyGPropertiesChangedSignalInfo), '("gSignal", Gio.DBusProxy.DBusProxyGSignalSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Proxy::destroy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "proxy"
--           , argType = TInterface Name { namespace = "IBus" , name = "Proxy" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusProxy" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_proxy_destroy" ibus_proxy_destroy :: 
    Ptr Proxy ->                            -- proxy : TInterface (Name {namespace = "IBus", name = "Proxy"})
    IO ()

-- | Dispose the proxy object. If the dbus connection is alive and the own
-- variable above is TRUE (which is the default),
-- org.freedesktop.IBus.Service.Destroy method will be called.
-- Note that \"destroy\" signal might be emitted when ibus_proxy_destroy is
-- called or the underlying dbus connection for the proxy is terminated.
-- In the callback of the destroy signal, you might have to call something
-- like \'g_object_unref(the_proxy);\'.
proxyDestroy ::
    (B.CallStack.HasCallStack, MonadIO m, IsProxy a) =>
    a
    -- ^ /@proxy@/: An t'GI.IBus.Objects.Proxy.Proxy'
    -> m ()
proxyDestroy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsProxy a) =>
a -> m ()
proxyDestroy a
proxy = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Proxy
proxy' <- a -> IO (Ptr Proxy)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
proxy
    Ptr Proxy -> IO ()
ibus_proxy_destroy Ptr Proxy
proxy'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
proxy
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ProxyDestroyMethodInfo
instance (signature ~ (m ()), MonadIO m, IsProxy a) => O.OverloadedMethod ProxyDestroyMethodInfo a signature where
    overloadedMethod = proxyDestroy

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


#endif