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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GDBusObjectManagerClient@ is used to create, monitor and delete object
-- proxies for remote objects exported by a t'GI.Gio.Objects.DBusObjectManagerServer.DBusObjectManagerServer'
-- (or any code implementing the
-- <http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-objectmanager org.freedesktop.DBus.ObjectManager>
-- interface).
-- 
-- Once an instance of this type has been created, you can connect to
-- the [DBusObjectManager::objectAdded]("GI.Gio.Interfaces.DBusObjectManager#g:signal:objectAdded") and
-- [signal/@gio@/.DBusObjectManager[objectRemoved](#g:signal:objectRemoved) signals] and inspect the
-- t'GI.Gio.Objects.DBusObjectProxy.DBusObjectProxy' objects returned by
-- 'GI.Gio.Interfaces.DBusObjectManager.dBusObjectManagerGetObjects'.
-- 
-- If the name for a @GDBusObjectManagerClient@ is not owned by anyone at
-- object construction time, the default behavior is to request the
-- message bus to launch an owner for the name. This behavior can be
-- disabled using the @G_DBUS_OBJECT_MANAGER_CLIENT_FLAGS_DO_NOT_AUTO_START@
-- flag. It’s also worth noting that this only works if the name of
-- interest is activatable in the first place. E.g. in some cases it
-- is not possible to launch an owner for the requested name. In this
-- case, @GDBusObjectManagerClient@ object construction still succeeds but
-- there will be no object proxies
-- (e.g. 'GI.Gio.Interfaces.DBusObjectManager.dBusObjectManagerGetObjects' returns the empty list) and
-- the [DBusObjectManagerClient:nameOwner]("GI.Gio.Objects.DBusObjectManagerClient#g:attr:nameOwner") property is @NULL@.
-- 
-- The owner of the requested name can come and go (for example
-- consider a system service being restarted) – @GDBusObjectManagerClient@
-- handles this case too; simply connect to the [Object::notify]("GI.GObject.Objects.Object#g:signal:notify")
-- signal to watch for changes on the
-- [DBusObjectManagerClient:nameOwner]("GI.Gio.Objects.DBusObjectManagerClient#g:attr:nameOwner") property. When the name
-- owner vanishes, the behavior is that
-- [DBusObjectManagerClient:nameOwner]("GI.Gio.Objects.DBusObjectManagerClient#g:attr:nameOwner") is set to @NULL@ (this
-- includes emission of the [Object::notify]("GI.GObject.Objects.Object#g:signal:notify") signal) and then
-- [DBusObjectManager::objectRemoved]("GI.Gio.Interfaces.DBusObjectManager#g:signal:objectRemoved") signals are synthesized
-- for all currently existing object proxies. Since
-- [DBusObjectManagerClient:nameOwner]("GI.Gio.Objects.DBusObjectManagerClient#g:attr:nameOwner") is @NULL@ when this
-- happens, you can use this information to disambiguate a synthesized signal
-- from a genuine signal caused by object removal on the remote
-- t'GI.Gio.Interfaces.DBusObjectManager.DBusObjectManager'. Similarly, when a new name owner appears,
-- [DBusObjectManager::objectAdded]("GI.Gio.Interfaces.DBusObjectManager#g:signal:objectAdded") signals are synthesized
-- while [DBusObjectManagerClient:nameOwner]("GI.Gio.Objects.DBusObjectManagerClient#g:attr:nameOwner") is still @NULL@. Only
-- when all object proxies have been added, the
-- [DBusObjectManagerClient:nameOwner]("GI.Gio.Objects.DBusObjectManagerClient#g:attr:nameOwner") is set to the new name
-- owner (this includes emission of the [Object::notify]("GI.GObject.Objects.Object#g:signal:notify") signal).
-- Furthermore, you are guaranteed that
-- [DBusObjectManagerClient:nameOwner]("GI.Gio.Objects.DBusObjectManagerClient#g:attr:nameOwner") will alternate between a
-- name owner (e.g. @:1.42@) and @NULL@ even in the case where
-- the name of interest is atomically replaced
-- 
-- Ultimately, @GDBusObjectManagerClient@ is used to obtain
-- t'GI.Gio.Objects.DBusProxy.DBusProxy' instances. All signals (including the
-- @org.freedesktop.DBus.Properties::PropertiesChanged@ signal)
-- delivered to t'GI.Gio.Objects.DBusProxy.DBusProxy' instances are guaranteed to originate
-- from the name owner. This guarantee along with the behavior
-- described above, means that certain race conditions including the
-- “half the proxy is from the old owner and the other half is from
-- the new owner” problem cannot happen.
-- 
-- To avoid having the application connect to signals on the returned
-- t'GI.Gio.Objects.DBusObjectProxy.DBusObjectProxy' and t'GI.Gio.Objects.DBusProxy.DBusProxy' objects, the
-- [DBusObject::interfaceAdded]("GI.Gio.Interfaces.DBusObject#g:signal:interfaceAdded"),
-- [DBusObject::interfaceRemoved]("GI.Gio.Interfaces.DBusObject#g:signal:interfaceRemoved"),
-- [DBusProxy::gPropertiesChanged]("GI.Gio.Objects.DBusProxy#g:signal:gPropertiesChanged") and
-- [DBusProxy::gSignal]("GI.Gio.Objects.DBusProxy#g:signal:gSignal") signals
-- are also emitted on the @GDBusObjectManagerClient@ instance managing these
-- objects. The signals emitted are
-- [DBusObjectManager::interfaceAdded]("GI.Gio.Interfaces.DBusObjectManager#g:signal:interfaceAdded"),
-- [DBusObjectManager::interfaceRemoved]("GI.Gio.Interfaces.DBusObjectManager#g:signal:interfaceRemoved"),
-- [DBusObjectManagerClient::interfaceProxyPropertiesChanged]("GI.Gio.Objects.DBusObjectManagerClient#g:signal:interfaceProxyPropertiesChanged") and
-- [DBusObjectManagerClient::interfaceProxySignal]("GI.Gio.Objects.DBusObjectManagerClient#g:signal:interfaceProxySignal").
-- 
-- Note that all callbacks and signals are emitted in the
-- thread-default main context (see
-- 'GI.GLib.Structs.MainContext.mainContextPushThreadDefault') that the
-- @GDBusObjectManagerClient@ object was constructed in. Additionally, the
-- t'GI.Gio.Objects.DBusObjectProxy.DBusObjectProxy' and t'GI.Gio.Objects.DBusProxy.DBusProxy' objects
-- originating from the @GDBusObjectManagerClient@ object will be created in
-- the same context and, consequently, will deliver signals in the
-- same main loop.
-- 
-- /Since: 2.30/

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

module GI.Gio.Objects.DBusObjectManagerClient
    ( 

-- * Exported types
    DBusObjectManagerClient(..)             ,
    IsDBusObjectManagerClient               ,
    toDBusObjectManagerClient               ,


 -- * 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"), [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
-- [getConnection]("GI.Gio.Objects.DBusObjectManagerClient#g:method:getConnection"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFlags]("GI.Gio.Objects.DBusObjectManagerClient#g:method:getFlags"), [getInterface]("GI.Gio.Interfaces.DBusObjectManager#g:method:getInterface"), [getName]("GI.Gio.Objects.DBusObjectManagerClient#g:method:getName"), [getNameOwner]("GI.Gio.Objects.DBusObjectManagerClient#g:method:getNameOwner"), [getObject]("GI.Gio.Interfaces.DBusObjectManager#g:method:getObject"), [getObjectPath]("GI.Gio.Interfaces.DBusObjectManager#g:method:getObjectPath"), [getObjects]("GI.Gio.Interfaces.DBusObjectManager#g:method:getObjects"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveDBusObjectManagerClientMethod    ,
#endif

-- ** getConnection #method:getConnection#

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerClientGetConnectionMethodInfo,
#endif
    dBusObjectManagerClientGetConnection    ,


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerClientGetFlagsMethodInfo,
#endif
    dBusObjectManagerClientGetFlags         ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerClientGetNameMethodInfo,
#endif
    dBusObjectManagerClientGetName          ,


-- ** getNameOwner #method:getNameOwner#

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerClientGetNameOwnerMethodInfo,
#endif
    dBusObjectManagerClientGetNameOwner     ,


-- ** new #method:new#

    dBusObjectManagerClientNew              ,


-- ** newFinish #method:newFinish#

    dBusObjectManagerClientNewFinish        ,


-- ** newForBus #method:newForBus#

    dBusObjectManagerClientNewForBus        ,


-- ** newForBusFinish #method:newForBusFinish#

    dBusObjectManagerClientNewForBusFinish  ,


-- ** newForBusSync #method:newForBusSync#

    dBusObjectManagerClientNewForBusSync    ,


-- ** newSync #method:newSync#

    dBusObjectManagerClientNewSync          ,




 -- * Properties


-- ** busType #attr:busType#
-- | If this property is not 'GI.Gio.Enums.BusTypeNone', then
-- [DBusObjectManagerClient:connection]("GI.Gio.Objects.DBusObjectManagerClient#g:attr:connection") must be 'P.Nothing' and will be set to the
-- t'GI.Gio.Objects.DBusConnection.DBusConnection' obtained by calling 'GI.Gio.Functions.busGet' with the value
-- of this property.
-- 
-- /Since: 2.30/

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerClientBusTypePropertyInfo,
#endif
    constructDBusObjectManagerClientBusType ,
#if defined(ENABLE_OVERLOADING)
    dBusObjectManagerClientBusType          ,
#endif


-- ** connection #attr:connection#
-- | The t'GI.Gio.Objects.DBusConnection.DBusConnection' to use.
-- 
-- /Since: 2.30/

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerClientConnectionPropertyInfo,
#endif
    constructDBusObjectManagerClientConnection,
#if defined(ENABLE_OVERLOADING)
    dBusObjectManagerClientConnection       ,
#endif
    getDBusObjectManagerClientConnection    ,


-- ** flags #attr:flags#
-- | Flags from the t'GI.Gio.Flags.DBusObjectManagerClientFlags' enumeration.
-- 
-- /Since: 2.30/

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerClientFlagsPropertyInfo,
#endif
    constructDBusObjectManagerClientFlags   ,
#if defined(ENABLE_OVERLOADING)
    dBusObjectManagerClientFlags            ,
#endif
    getDBusObjectManagerClientFlags         ,


-- ** getProxyTypeDestroyNotify #attr:getProxyTypeDestroyNotify#
-- | A t'GI.GLib.Callbacks.DestroyNotify' for the @/gpointer/@ user_data in [DBusObjectManagerClient:getProxyTypeUserData]("GI.Gio.Objects.DBusObjectManagerClient#g:attr:getProxyTypeUserData").
-- 
-- /Since: 2.30/

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo,
#endif
    constructDBusObjectManagerClientGetProxyTypeDestroyNotify,
#if defined(ENABLE_OVERLOADING)
    dBusObjectManagerClientGetProxyTypeDestroyNotify,
#endif
    getDBusObjectManagerClientGetProxyTypeDestroyNotify,


-- ** getProxyTypeFunc #attr:getProxyTypeFunc#
-- | The t'GI.Gio.Callbacks.DBusProxyTypeFunc' to use when determining what t'GType' to
-- use for interface proxies or 'P.Nothing'.
-- 
-- /Since: 2.30/

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerClientGetProxyTypeFuncPropertyInfo,
#endif
    constructDBusObjectManagerClientGetProxyTypeFunc,
#if defined(ENABLE_OVERLOADING)
    dBusObjectManagerClientGetProxyTypeFunc ,
#endif
    getDBusObjectManagerClientGetProxyTypeFunc,


-- ** getProxyTypeUserData #attr:getProxyTypeUserData#
-- | The @/gpointer/@ user_data to pass to [DBusObjectManagerClient:getProxyTypeFunc]("GI.Gio.Objects.DBusObjectManagerClient#g:attr:getProxyTypeFunc").
-- 
-- /Since: 2.30/

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo,
#endif
    constructDBusObjectManagerClientGetProxyTypeUserData,
#if defined(ENABLE_OVERLOADING)
    dBusObjectManagerClientGetProxyTypeUserData,
#endif
    getDBusObjectManagerClientGetProxyTypeUserData,


-- ** name #attr:name#
-- | The well-known name or unique name that the manager is for.
-- 
-- /Since: 2.30/

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerClientNamePropertyInfo ,
#endif
    constructDBusObjectManagerClientName    ,
#if defined(ENABLE_OVERLOADING)
    dBusObjectManagerClientName             ,
#endif
    getDBusObjectManagerClientName          ,


-- ** nameOwner #attr:nameOwner#
-- | The unique name that owns [DBusObjectManagerClient:name]("GI.Gio.Objects.DBusObjectManagerClient#g:attr:name") or 'P.Nothing' if
-- no-one is currently owning the name. Connect to the
-- [Object::notify]("GI.GObject.Objects.Object#g:signal:notify") signal to track changes to this property.
-- 
-- /Since: 2.30/

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerClientNameOwnerPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    dBusObjectManagerClientNameOwner        ,
#endif
    getDBusObjectManagerClientNameOwner     ,


-- ** objectPath #attr:objectPath#
-- | The object path the manager is for.
-- 
-- /Since: 2.30/

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerClientObjectPathPropertyInfo,
#endif
    constructDBusObjectManagerClientObjectPath,
#if defined(ENABLE_OVERLOADING)
    dBusObjectManagerClientObjectPath       ,
#endif
    getDBusObjectManagerClientObjectPath    ,




 -- * Signals


-- ** interfaceProxyPropertiesChanged #signal:interfaceProxyPropertiesChanged#

    DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback,
#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerClientInterfaceProxyPropertiesChangedSignalInfo,
#endif
    afterDBusObjectManagerClientInterfaceProxyPropertiesChanged,
    onDBusObjectManagerClientInterfaceProxyPropertiesChanged,


-- ** interfaceProxySignal #signal:interfaceProxySignal#

    DBusObjectManagerClientInterfaceProxySignalCallback,
#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerClientInterfaceProxySignalSignalInfo,
#endif
    afterDBusObjectManagerClientInterfaceProxySignal,
    onDBusObjectManagerClientInterfaceProxySignal,




    ) 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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.PollFD as GLib.PollFD
import qualified GI.GLib.Structs.Source as GLib.Source
import qualified GI.GLib.Structs.String as GLib.String
import qualified GI.GLib.Structs.VariantType as GLib.VariantType
import qualified GI.GObject.Callbacks as GObject.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.GObject.Structs.Parameter as GObject.Parameter
import qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Flags as Gio.Flags
import {-# SOURCE #-} qualified GI.Gio.Interfaces.ActionGroup as Gio.ActionGroup
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncInitable as Gio.AsyncInitable
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Interfaces.DBusInterface as Gio.DBusInterface
import {-# SOURCE #-} qualified GI.Gio.Interfaces.DBusObject as Gio.DBusObject
import {-# SOURCE #-} qualified GI.Gio.Interfaces.DBusObjectManager as Gio.DBusObjectManager
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Initable as Gio.Initable
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gio.Objects.Credentials as Gio.Credentials
import {-# SOURCE #-} qualified GI.Gio.Objects.DBusAuthObserver as Gio.DBusAuthObserver
import {-# SOURCE #-} qualified GI.Gio.Objects.DBusConnection as Gio.DBusConnection
import {-# SOURCE #-} qualified GI.Gio.Objects.DBusMessage as Gio.DBusMessage
import {-# SOURCE #-} qualified GI.Gio.Objects.DBusObjectProxy as Gio.DBusObjectProxy
import {-# SOURCE #-} qualified GI.Gio.Objects.DBusProxy as Gio.DBusProxy
import {-# SOURCE #-} qualified GI.Gio.Objects.IOStream as Gio.IOStream
import {-# SOURCE #-} qualified GI.Gio.Objects.InputStream as Gio.InputStream
import {-# SOURCE #-} qualified GI.Gio.Objects.MenuAttributeIter as Gio.MenuAttributeIter
import {-# SOURCE #-} qualified GI.Gio.Objects.MenuLinkIter as Gio.MenuLinkIter
import {-# SOURCE #-} qualified GI.Gio.Objects.MenuModel as Gio.MenuModel
import {-# SOURCE #-} qualified GI.Gio.Objects.OutputStream as Gio.OutputStream
import {-# SOURCE #-} qualified GI.Gio.Objects.UnixFDList as Gio.UnixFDList
import {-# SOURCE #-} qualified GI.Gio.Structs.DBusAnnotationInfo as Gio.DBusAnnotationInfo
import {-# SOURCE #-} qualified GI.Gio.Structs.DBusArgInfo as Gio.DBusArgInfo
import {-# SOURCE #-} qualified GI.Gio.Structs.DBusInterfaceInfo as Gio.DBusInterfaceInfo
import {-# SOURCE #-} qualified GI.Gio.Structs.DBusMethodInfo as Gio.DBusMethodInfo
import {-# SOURCE #-} qualified GI.Gio.Structs.DBusPropertyInfo as Gio.DBusPropertyInfo
import {-# SOURCE #-} qualified GI.Gio.Structs.DBusSignalInfo as Gio.DBusSignalInfo
import {-# SOURCE #-} qualified GI.Gio.Structs.DBusSubtreeVTable as Gio.DBusSubtreeVTable
import {-# SOURCE #-} qualified GI.Gio.Structs.OutputVector as Gio.OutputVector

#else
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Flags as Gio.Flags
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncInitable as Gio.AsyncInitable
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Interfaces.DBusObjectManager as Gio.DBusObjectManager
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Initable as Gio.Initable
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gio.Objects.DBusConnection as Gio.DBusConnection
import {-# SOURCE #-} qualified GI.Gio.Objects.DBusObjectProxy as Gio.DBusObjectProxy
import {-# SOURCE #-} qualified GI.Gio.Objects.DBusProxy as Gio.DBusProxy

#endif

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

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

foreign import ccall "g_dbus_object_manager_client_get_type"
    c_g_dbus_object_manager_client_get_type :: IO B.Types.GType

instance B.Types.TypedObject DBusObjectManagerClient where
    glibType :: IO GType
glibType = IO GType
c_g_dbus_object_manager_client_get_type

instance B.Types.GObject DBusObjectManagerClient

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

instance O.HasParentTypes DBusObjectManagerClient
type instance O.ParentTypes DBusObjectManagerClient = '[GObject.Object.Object, Gio.AsyncInitable.AsyncInitable, Gio.DBusObjectManager.DBusObjectManager, Gio.Initable.Initable]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDBusObjectManagerClientMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveDBusObjectManagerClientMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDBusObjectManagerClientMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDBusObjectManagerClientMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDBusObjectManagerClientMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDBusObjectManagerClientMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDBusObjectManagerClientMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolveDBusObjectManagerClientMethod "initAsync" o = Gio.AsyncInitable.AsyncInitableInitAsyncMethodInfo
    ResolveDBusObjectManagerClientMethod "initFinish" o = Gio.AsyncInitable.AsyncInitableInitFinishMethodInfo
    ResolveDBusObjectManagerClientMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDBusObjectManagerClientMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDBusObjectManagerClientMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDBusObjectManagerClientMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDBusObjectManagerClientMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDBusObjectManagerClientMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDBusObjectManagerClientMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDBusObjectManagerClientMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDBusObjectManagerClientMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDBusObjectManagerClientMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDBusObjectManagerClientMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDBusObjectManagerClientMethod "getConnection" o = DBusObjectManagerClientGetConnectionMethodInfo
    ResolveDBusObjectManagerClientMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDBusObjectManagerClientMethod "getFlags" o = DBusObjectManagerClientGetFlagsMethodInfo
    ResolveDBusObjectManagerClientMethod "getInterface" o = Gio.DBusObjectManager.DBusObjectManagerGetInterfaceMethodInfo
    ResolveDBusObjectManagerClientMethod "getName" o = DBusObjectManagerClientGetNameMethodInfo
    ResolveDBusObjectManagerClientMethod "getNameOwner" o = DBusObjectManagerClientGetNameOwnerMethodInfo
    ResolveDBusObjectManagerClientMethod "getObject" o = Gio.DBusObjectManager.DBusObjectManagerGetObjectMethodInfo
    ResolveDBusObjectManagerClientMethod "getObjectPath" o = Gio.DBusObjectManager.DBusObjectManagerGetObjectPathMethodInfo
    ResolveDBusObjectManagerClientMethod "getObjects" o = Gio.DBusObjectManager.DBusObjectManagerGetObjectsMethodInfo
    ResolveDBusObjectManagerClientMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDBusObjectManagerClientMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDBusObjectManagerClientMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDBusObjectManagerClientMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDBusObjectManagerClientMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDBusObjectManagerClientMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal DBusObjectManagerClient::interface-proxy-properties-changed
-- | Emitted when one or more D-Bus properties on proxy changes. The
-- local cache has already been updated when this signal fires. Note
-- that both /@changedProperties@/ and /@invalidatedProperties@/ are
-- guaranteed to never be 'P.Nothing' (either may be empty though).
-- 
-- This signal exists purely as a convenience to avoid having to
-- connect signals to all interface proxies managed by /@manager@/.
-- 
-- This signal is emitted in the
-- [thread-default main context][g-main-context-push-thread-default]
-- that /@manager@/ was constructed in.
-- 
-- /Since: 2.30/
type DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback =
    Gio.DBusObjectProxy.DBusObjectProxy
    -- ^ /@objectProxy@/: The t'GI.Gio.Objects.DBusObjectProxy.DBusObjectProxy' on which an interface has properties that are changing.
    -> Gio.DBusProxy.DBusProxy
    -- ^ /@interfaceProxy@/: The t'GI.Gio.Objects.DBusProxy.DBusProxy' that has properties that are changing.
    -> GVariant
    -- ^ /@changedProperties@/: A t'GVariant' containing the properties that changed (type: @a{sv}@).
    -> [T.Text]
    -- ^ /@invalidatedProperties@/: A 'P.Nothing' terminated
    --   array of properties that were invalidated.
    -> IO ()

type C_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback =
    Ptr DBusObjectManagerClient ->          -- object
    Ptr Gio.DBusObjectProxy.DBusObjectProxy ->
    Ptr Gio.DBusProxy.DBusProxy ->
    Ptr GVariant ->
    Ptr CString ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback :: 
    GObject a => (a -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback) ->
    C_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
wrap_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback :: forall a.
GObject a =>
(a
 -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback)
-> C_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
wrap_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback a -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
gi'cb Ptr DBusObjectManagerClient
gi'selfPtr Ptr DBusObjectProxy
objectProxy Ptr DBusProxy
interfaceProxy Ptr GVariant
changedProperties Ptr CString
invalidatedProperties Ptr ()
_ = do
    objectProxy' <- ((ManagedPtr DBusObjectProxy -> DBusObjectProxy)
-> Ptr DBusObjectProxy -> IO DBusObjectProxy
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DBusObjectProxy -> DBusObjectProxy
Gio.DBusObjectProxy.DBusObjectProxy) Ptr DBusObjectProxy
objectProxy
    interfaceProxy' <- (newObject Gio.DBusProxy.DBusProxy) interfaceProxy
    changedProperties' <- B.GVariant.newGVariantFromPtr changedProperties
    invalidatedProperties' <- unpackZeroTerminatedUTF8CArray invalidatedProperties
    B.ManagedPtr.withNewObject gi'selfPtr $ \DBusObjectManagerClient
gi'self -> a -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
gi'cb (DBusObjectManagerClient -> a
forall a b. Coercible a b => a -> b
Coerce.coerce DBusObjectManagerClient
gi'self)  DBusObjectProxy
objectProxy' DBusProxy
interfaceProxy' GVariant
changedProperties' [Text]
invalidatedProperties'


-- | Connect a signal handler for the [interfaceProxyPropertiesChanged](#signal:interfaceProxyPropertiesChanged) 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' dBusObjectManagerClient #interfaceProxyPropertiesChanged callback
-- @
-- 
-- 
onDBusObjectManagerClientInterfaceProxyPropertiesChanged :: (IsDBusObjectManagerClient a, MonadIO m) => a -> ((?self :: a) => DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback) -> m SignalHandlerId
onDBusObjectManagerClientInterfaceProxyPropertiesChanged :: forall a (m :: * -> *).
(IsDBusObjectManagerClient a, MonadIO m) =>
a
-> ((?self::a) =>
    DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback)
-> m SignalHandlerId
onDBusObjectManagerClientInterfaceProxyPropertiesChanged a
obj (?self::a) =>
DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
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 -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) =>
DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
cb
    let wrapped' :: C_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
wrapped' = (a
 -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback)
-> C_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
forall a.
GObject a =>
(a
 -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback)
-> C_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
wrap_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback a -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
wrapped
    wrapped'' <- C_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
-> IO
     (FunPtr
        C_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback)
mk_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback C_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
wrapped'
    connectSignalFunPtr obj "interface-proxy-properties-changed" wrapped'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [interfaceProxyPropertiesChanged](#signal:interfaceProxyPropertiesChanged) 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' dBusObjectManagerClient #interfaceProxyPropertiesChanged 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.
-- 
afterDBusObjectManagerClientInterfaceProxyPropertiesChanged :: (IsDBusObjectManagerClient a, MonadIO m) => a -> ((?self :: a) => DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback) -> m SignalHandlerId
afterDBusObjectManagerClientInterfaceProxyPropertiesChanged :: forall a (m :: * -> *).
(IsDBusObjectManagerClient a, MonadIO m) =>
a
-> ((?self::a) =>
    DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback)
-> m SignalHandlerId
afterDBusObjectManagerClientInterfaceProxyPropertiesChanged a
obj (?self::a) =>
DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
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 -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) =>
DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
cb
    let wrapped' :: C_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
wrapped' = (a
 -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback)
-> C_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
forall a.
GObject a =>
(a
 -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback)
-> C_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
wrap_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback a -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
wrapped
    wrapped'' <- C_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
-> IO
     (FunPtr
        C_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback)
mk_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback C_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
wrapped'
    connectSignalFunPtr obj "interface-proxy-properties-changed" wrapped'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerClientInterfaceProxyPropertiesChangedSignalInfo
instance SignalInfo DBusObjectManagerClientInterfaceProxyPropertiesChangedSignalInfo where
    type HaskellCallbackType DBusObjectManagerClientInterfaceProxyPropertiesChangedSignalInfo = DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback cb
        cb'' <- mk_DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback cb'
        connectSignalFunPtr obj "interface-proxy-properties-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectManagerClient::interface-proxy-properties-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DBusObjectManagerClient.html#g:signal:interfaceProxyPropertiesChanged"})

#endif

-- signal DBusObjectManagerClient::interface-proxy-signal
-- | Emitted when a D-Bus signal is received on /@interfaceProxy@/.
-- 
-- This signal exists purely as a convenience to avoid having to
-- connect signals to all interface proxies managed by /@manager@/.
-- 
-- This signal is emitted in the
-- [thread-default main context][g-main-context-push-thread-default]
-- that /@manager@/ was constructed in.
-- 
-- /Since: 2.30/
type DBusObjectManagerClientInterfaceProxySignalCallback =
    Gio.DBusObjectProxy.DBusObjectProxy
    -- ^ /@objectProxy@/: The t'GI.Gio.Objects.DBusObjectProxy.DBusObjectProxy' on which an interface is emitting a D-Bus signal.
    -> Gio.DBusProxy.DBusProxy
    -- ^ /@interfaceProxy@/: The t'GI.Gio.Objects.DBusProxy.DBusProxy' that is emitting a D-Bus signal.
    -> T.Text
    -- ^ /@senderName@/: The sender of the signal or NULL if the connection is not a bus connection.
    -> T.Text
    -- ^ /@signalName@/: The signal name.
    -> GVariant
    -- ^ /@parameters@/: A t'GVariant' tuple with parameters for the signal.
    -> IO ()

type C_DBusObjectManagerClientInterfaceProxySignalCallback =
    Ptr DBusObjectManagerClient ->          -- object
    Ptr Gio.DBusObjectProxy.DBusObjectProxy ->
    Ptr Gio.DBusProxy.DBusProxy ->
    CString ->
    CString ->
    Ptr GVariant ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_DBusObjectManagerClientInterfaceProxySignalCallback :: 
    GObject a => (a -> DBusObjectManagerClientInterfaceProxySignalCallback) ->
    C_DBusObjectManagerClientInterfaceProxySignalCallback
wrap_DBusObjectManagerClientInterfaceProxySignalCallback :: forall a.
GObject a =>
(a -> DBusObjectManagerClientInterfaceProxySignalCallback)
-> C_DBusObjectManagerClientInterfaceProxySignalCallback
wrap_DBusObjectManagerClientInterfaceProxySignalCallback a -> DBusObjectManagerClientInterfaceProxySignalCallback
gi'cb Ptr DBusObjectManagerClient
gi'selfPtr Ptr DBusObjectProxy
objectProxy Ptr DBusProxy
interfaceProxy CString
senderName CString
signalName Ptr GVariant
parameters Ptr ()
_ = do
    objectProxy' <- ((ManagedPtr DBusObjectProxy -> DBusObjectProxy)
-> Ptr DBusObjectProxy -> IO DBusObjectProxy
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DBusObjectProxy -> DBusObjectProxy
Gio.DBusObjectProxy.DBusObjectProxy) Ptr DBusObjectProxy
objectProxy
    interfaceProxy' <- (newObject Gio.DBusProxy.DBusProxy) interfaceProxy
    senderName' <- cstringToText senderName
    signalName' <- cstringToText signalName
    parameters' <- B.GVariant.newGVariantFromPtr parameters
    B.ManagedPtr.withNewObject gi'selfPtr $ \DBusObjectManagerClient
gi'self -> a -> DBusObjectManagerClientInterfaceProxySignalCallback
gi'cb (DBusObjectManagerClient -> a
forall a b. Coercible a b => a -> b
Coerce.coerce DBusObjectManagerClient
gi'self)  DBusObjectProxy
objectProxy' DBusProxy
interfaceProxy' Text
senderName' Text
signalName' GVariant
parameters'


-- | Connect a signal handler for the [interfaceProxySignal](#signal:interfaceProxySignal) 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' dBusObjectManagerClient #interfaceProxySignal callback
-- @
-- 
-- 
onDBusObjectManagerClientInterfaceProxySignal :: (IsDBusObjectManagerClient a, MonadIO m) => a -> ((?self :: a) => DBusObjectManagerClientInterfaceProxySignalCallback) -> m SignalHandlerId
onDBusObjectManagerClientInterfaceProxySignal :: forall a (m :: * -> *).
(IsDBusObjectManagerClient a, MonadIO m) =>
a
-> ((?self::a) =>
    DBusObjectManagerClientInterfaceProxySignalCallback)
-> m SignalHandlerId
onDBusObjectManagerClientInterfaceProxySignal a
obj (?self::a) => DBusObjectManagerClientInterfaceProxySignalCallback
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 -> DBusObjectManagerClientInterfaceProxySignalCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusObjectManagerClientInterfaceProxySignalCallback
DBusObjectManagerClientInterfaceProxySignalCallback
cb
    let wrapped' :: C_DBusObjectManagerClientInterfaceProxySignalCallback
wrapped' = (a -> DBusObjectManagerClientInterfaceProxySignalCallback)
-> C_DBusObjectManagerClientInterfaceProxySignalCallback
forall a.
GObject a =>
(a -> DBusObjectManagerClientInterfaceProxySignalCallback)
-> C_DBusObjectManagerClientInterfaceProxySignalCallback
wrap_DBusObjectManagerClientInterfaceProxySignalCallback a -> DBusObjectManagerClientInterfaceProxySignalCallback
wrapped
    wrapped'' <- C_DBusObjectManagerClientInterfaceProxySignalCallback
-> IO
     (FunPtr C_DBusObjectManagerClientInterfaceProxySignalCallback)
mk_DBusObjectManagerClientInterfaceProxySignalCallback C_DBusObjectManagerClientInterfaceProxySignalCallback
wrapped'
    connectSignalFunPtr obj "interface-proxy-signal" wrapped'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [interfaceProxySignal](#signal:interfaceProxySignal) 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' dBusObjectManagerClient #interfaceProxySignal 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.
-- 
afterDBusObjectManagerClientInterfaceProxySignal :: (IsDBusObjectManagerClient a, MonadIO m) => a -> ((?self :: a) => DBusObjectManagerClientInterfaceProxySignalCallback) -> m SignalHandlerId
afterDBusObjectManagerClientInterfaceProxySignal :: forall a (m :: * -> *).
(IsDBusObjectManagerClient a, MonadIO m) =>
a
-> ((?self::a) =>
    DBusObjectManagerClientInterfaceProxySignalCallback)
-> m SignalHandlerId
afterDBusObjectManagerClientInterfaceProxySignal a
obj (?self::a) => DBusObjectManagerClientInterfaceProxySignalCallback
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 -> DBusObjectManagerClientInterfaceProxySignalCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusObjectManagerClientInterfaceProxySignalCallback
DBusObjectManagerClientInterfaceProxySignalCallback
cb
    let wrapped' :: C_DBusObjectManagerClientInterfaceProxySignalCallback
wrapped' = (a -> DBusObjectManagerClientInterfaceProxySignalCallback)
-> C_DBusObjectManagerClientInterfaceProxySignalCallback
forall a.
GObject a =>
(a -> DBusObjectManagerClientInterfaceProxySignalCallback)
-> C_DBusObjectManagerClientInterfaceProxySignalCallback
wrap_DBusObjectManagerClientInterfaceProxySignalCallback a -> DBusObjectManagerClientInterfaceProxySignalCallback
wrapped
    wrapped'' <- C_DBusObjectManagerClientInterfaceProxySignalCallback
-> IO
     (FunPtr C_DBusObjectManagerClientInterfaceProxySignalCallback)
mk_DBusObjectManagerClientInterfaceProxySignalCallback C_DBusObjectManagerClientInterfaceProxySignalCallback
wrapped'
    connectSignalFunPtr obj "interface-proxy-signal" wrapped'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerClientInterfaceProxySignalSignalInfo
instance SignalInfo DBusObjectManagerClientInterfaceProxySignalSignalInfo where
    type HaskellCallbackType DBusObjectManagerClientInterfaceProxySignalSignalInfo = DBusObjectManagerClientInterfaceProxySignalCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DBusObjectManagerClientInterfaceProxySignalCallback cb
        cb'' <- mk_DBusObjectManagerClientInterfaceProxySignalCallback cb'
        connectSignalFunPtr obj "interface-proxy-signal" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectManagerClient::interface-proxy-signal"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DBusObjectManagerClient.html#g:signal:interfaceProxySignal"})

#endif

-- VVV Prop "bus-type"
   -- Type: TInterface (Name {namespace = "Gio", name = "BusType"})
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@bus-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDBusObjectManagerClientBusType :: (IsDBusObjectManagerClient o, MIO.MonadIO m) => Gio.Enums.BusType -> m (GValueConstruct o)
constructDBusObjectManagerClientBusType :: forall o (m :: * -> *).
(IsDBusObjectManagerClient o, MonadIO m) =>
BusType -> m (GValueConstruct o)
constructDBusObjectManagerClientBusType BusType
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> BusType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"bus-type" BusType
val

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerClientBusTypePropertyInfo
instance AttrInfo DBusObjectManagerClientBusTypePropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientBusTypePropertyInfo = '[ 'AttrConstruct]
    type AttrBaseTypeConstraint DBusObjectManagerClientBusTypePropertyInfo = IsDBusObjectManagerClient
    type AttrSetTypeConstraint DBusObjectManagerClientBusTypePropertyInfo = (~) Gio.Enums.BusType
    type AttrTransferTypeConstraint DBusObjectManagerClientBusTypePropertyInfo = (~) Gio.Enums.BusType
    type AttrTransferType DBusObjectManagerClientBusTypePropertyInfo = Gio.Enums.BusType
    type AttrGetType DBusObjectManagerClientBusTypePropertyInfo = ()
    type AttrLabel DBusObjectManagerClientBusTypePropertyInfo = "bus-type"
    type AttrOrigin DBusObjectManagerClientBusTypePropertyInfo = DBusObjectManagerClient
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDBusObjectManagerClientBusType
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectManagerClient.busType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DBusObjectManagerClient.html#g:attr:busType"
        })
#endif

-- VVV Prop "connection"
   -- Type: TInterface (Name {namespace = "Gio", name = "DBusConnection"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@connection@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDBusObjectManagerClientConnection :: (IsDBusObjectManagerClient o, MIO.MonadIO m, Gio.DBusConnection.IsDBusConnection a) => a -> m (GValueConstruct o)
constructDBusObjectManagerClientConnection :: forall o (m :: * -> *) a.
(IsDBusObjectManagerClient o, MonadIO m, IsDBusConnection a) =>
a -> m (GValueConstruct o)
constructDBusObjectManagerClientConnection a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"connection" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerClientConnectionPropertyInfo
instance AttrInfo DBusObjectManagerClientConnectionPropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientConnectionPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DBusObjectManagerClientConnectionPropertyInfo = IsDBusObjectManagerClient
    type AttrSetTypeConstraint DBusObjectManagerClientConnectionPropertyInfo = Gio.DBusConnection.IsDBusConnection
    type AttrTransferTypeConstraint DBusObjectManagerClientConnectionPropertyInfo = Gio.DBusConnection.IsDBusConnection
    type AttrTransferType DBusObjectManagerClientConnectionPropertyInfo = Gio.DBusConnection.DBusConnection
    type AttrGetType DBusObjectManagerClientConnectionPropertyInfo = Gio.DBusConnection.DBusConnection
    type AttrLabel DBusObjectManagerClientConnectionPropertyInfo = "connection"
    type AttrOrigin DBusObjectManagerClientConnectionPropertyInfo = DBusObjectManagerClient
    attrGet = getDBusObjectManagerClientConnection
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.DBusConnection.DBusConnection v
    attrConstruct = constructDBusObjectManagerClientConnection
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectManagerClient.connection"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DBusObjectManagerClient.html#g:attr:connection"
        })
#endif

-- VVV Prop "flags"
   -- Type: TInterface (Name {namespace = "Gio", name = "DBusObjectManagerClientFlags"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusObjectManagerClient #flags
-- @
getDBusObjectManagerClientFlags :: (MonadIO m, IsDBusObjectManagerClient o) => o -> m [Gio.Flags.DBusObjectManagerClientFlags]
getDBusObjectManagerClientFlags :: forall (m :: * -> *) o.
(MonadIO m, IsDBusObjectManagerClient o) =>
o -> m [DBusObjectManagerClientFlags]
getDBusObjectManagerClientFlags o
obj = IO [DBusObjectManagerClientFlags]
-> m [DBusObjectManagerClientFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [DBusObjectManagerClientFlags]
 -> m [DBusObjectManagerClientFlags])
-> IO [DBusObjectManagerClientFlags]
-> m [DBusObjectManagerClientFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [DBusObjectManagerClientFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"flags"

-- | Construct a `GValueConstruct` with valid value for the “@flags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDBusObjectManagerClientFlags :: (IsDBusObjectManagerClient o, MIO.MonadIO m) => [Gio.Flags.DBusObjectManagerClientFlags] -> m (GValueConstruct o)
constructDBusObjectManagerClientFlags :: forall o (m :: * -> *).
(IsDBusObjectManagerClient o, MonadIO m) =>
[DBusObjectManagerClientFlags] -> m (GValueConstruct o)
constructDBusObjectManagerClientFlags [DBusObjectManagerClientFlags]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [DBusObjectManagerClientFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"flags" [DBusObjectManagerClientFlags]
val

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerClientFlagsPropertyInfo
instance AttrInfo DBusObjectManagerClientFlagsPropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientFlagsPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DBusObjectManagerClientFlagsPropertyInfo = IsDBusObjectManagerClient
    type AttrSetTypeConstraint DBusObjectManagerClientFlagsPropertyInfo = (~) [Gio.Flags.DBusObjectManagerClientFlags]
    type AttrTransferTypeConstraint DBusObjectManagerClientFlagsPropertyInfo = (~) [Gio.Flags.DBusObjectManagerClientFlags]
    type AttrTransferType DBusObjectManagerClientFlagsPropertyInfo = [Gio.Flags.DBusObjectManagerClientFlags]
    type AttrGetType DBusObjectManagerClientFlagsPropertyInfo = [Gio.Flags.DBusObjectManagerClientFlags]
    type AttrLabel DBusObjectManagerClientFlagsPropertyInfo = "flags"
    type AttrOrigin DBusObjectManagerClientFlagsPropertyInfo = DBusObjectManagerClient
    attrGet = getDBusObjectManagerClientFlags
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDBusObjectManagerClientFlags
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectManagerClient.flags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DBusObjectManagerClient.html#g:attr:flags"
        })
#endif

-- VVV Prop "get-proxy-type-destroy-notify"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@get-proxy-type-destroy-notify@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusObjectManagerClient #getProxyTypeDestroyNotify
-- @
getDBusObjectManagerClientGetProxyTypeDestroyNotify :: (MonadIO m, IsDBusObjectManagerClient o) => o -> m (Ptr ())
getDBusObjectManagerClientGetProxyTypeDestroyNotify :: forall (m :: * -> *) o.
(MonadIO m, IsDBusObjectManagerClient o) =>
o -> m (Ptr ())
getDBusObjectManagerClientGetProxyTypeDestroyNotify o
obj = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Ptr ())
forall a b. GObject a => a -> String -> IO (Ptr b)
B.Properties.getObjectPropertyPtr o
obj String
"get-proxy-type-destroy-notify"

-- | Construct a `GValueConstruct` with valid value for the “@get-proxy-type-destroy-notify@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDBusObjectManagerClientGetProxyTypeDestroyNotify :: (IsDBusObjectManagerClient o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructDBusObjectManagerClientGetProxyTypeDestroyNotify :: forall o (m :: * -> *).
(IsDBusObjectManagerClient o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructDBusObjectManagerClientGetProxyTypeDestroyNotify Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"get-proxy-type-destroy-notify" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo
instance AttrInfo DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = IsDBusObjectManagerClient
    type AttrSetTypeConstraint DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = (~) (Ptr ())
    type AttrTransferType DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = Ptr ()
    type AttrGetType DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = (Ptr ())
    type AttrLabel DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = "get-proxy-type-destroy-notify"
    type AttrOrigin DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = DBusObjectManagerClient
    attrGet = getDBusObjectManagerClientGetProxyTypeDestroyNotify
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDBusObjectManagerClientGetProxyTypeDestroyNotify
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectManagerClient.getProxyTypeDestroyNotify"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DBusObjectManagerClient.html#g:attr:getProxyTypeDestroyNotify"
        })
#endif

-- VVV Prop "get-proxy-type-func"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@get-proxy-type-func@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusObjectManagerClient #getProxyTypeFunc
-- @
getDBusObjectManagerClientGetProxyTypeFunc :: (MonadIO m, IsDBusObjectManagerClient o) => o -> m (Ptr ())
getDBusObjectManagerClientGetProxyTypeFunc :: forall (m :: * -> *) o.
(MonadIO m, IsDBusObjectManagerClient o) =>
o -> m (Ptr ())
getDBusObjectManagerClientGetProxyTypeFunc o
obj = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Ptr ())
forall a b. GObject a => a -> String -> IO (Ptr b)
B.Properties.getObjectPropertyPtr o
obj String
"get-proxy-type-func"

-- | Construct a `GValueConstruct` with valid value for the “@get-proxy-type-func@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDBusObjectManagerClientGetProxyTypeFunc :: (IsDBusObjectManagerClient o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructDBusObjectManagerClientGetProxyTypeFunc :: forall o (m :: * -> *).
(IsDBusObjectManagerClient o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructDBusObjectManagerClientGetProxyTypeFunc Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"get-proxy-type-func" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerClientGetProxyTypeFuncPropertyInfo
instance AttrInfo DBusObjectManagerClientGetProxyTypeFuncPropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = IsDBusObjectManagerClient
    type AttrSetTypeConstraint DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = (~) (Ptr ())
    type AttrTransferType DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = Ptr ()
    type AttrGetType DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = (Ptr ())
    type AttrLabel DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = "get-proxy-type-func"
    type AttrOrigin DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = DBusObjectManagerClient
    attrGet = getDBusObjectManagerClientGetProxyTypeFunc
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDBusObjectManagerClientGetProxyTypeFunc
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectManagerClient.getProxyTypeFunc"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DBusObjectManagerClient.html#g:attr:getProxyTypeFunc"
        })
#endif

-- VVV Prop "get-proxy-type-user-data"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@get-proxy-type-user-data@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusObjectManagerClient #getProxyTypeUserData
-- @
getDBusObjectManagerClientGetProxyTypeUserData :: (MonadIO m, IsDBusObjectManagerClient o) => o -> m (Ptr ())
getDBusObjectManagerClientGetProxyTypeUserData :: forall (m :: * -> *) o.
(MonadIO m, IsDBusObjectManagerClient o) =>
o -> m (Ptr ())
getDBusObjectManagerClientGetProxyTypeUserData o
obj = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Ptr ())
forall a b. GObject a => a -> String -> IO (Ptr b)
B.Properties.getObjectPropertyPtr o
obj String
"get-proxy-type-user-data"

-- | Construct a `GValueConstruct` with valid value for the “@get-proxy-type-user-data@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDBusObjectManagerClientGetProxyTypeUserData :: (IsDBusObjectManagerClient o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructDBusObjectManagerClientGetProxyTypeUserData :: forall o (m :: * -> *).
(IsDBusObjectManagerClient o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructDBusObjectManagerClientGetProxyTypeUserData Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"get-proxy-type-user-data" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo
instance AttrInfo DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = IsDBusObjectManagerClient
    type AttrSetTypeConstraint DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = (~) (Ptr ())
    type AttrTransferType DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = Ptr ()
    type AttrGetType DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = (Ptr ())
    type AttrLabel DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = "get-proxy-type-user-data"
    type AttrOrigin DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = DBusObjectManagerClient
    attrGet = getDBusObjectManagerClientGetProxyTypeUserData
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDBusObjectManagerClientGetProxyTypeUserData
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectManagerClient.getProxyTypeUserData"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DBusObjectManagerClient.html#g:attr:getProxyTypeUserData"
        })
#endif

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

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

-- | Construct a `GValueConstruct` with valid value for the “@name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDBusObjectManagerClientName :: (IsDBusObjectManagerClient o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDBusObjectManagerClientName :: forall o (m :: * -> *).
(IsDBusObjectManagerClient o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDBusObjectManagerClientName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerClientNamePropertyInfo
instance AttrInfo DBusObjectManagerClientNamePropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DBusObjectManagerClientNamePropertyInfo = IsDBusObjectManagerClient
    type AttrSetTypeConstraint DBusObjectManagerClientNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DBusObjectManagerClientNamePropertyInfo = (~) T.Text
    type AttrTransferType DBusObjectManagerClientNamePropertyInfo = T.Text
    type AttrGetType DBusObjectManagerClientNamePropertyInfo = T.Text
    type AttrLabel DBusObjectManagerClientNamePropertyInfo = "name"
    type AttrOrigin DBusObjectManagerClientNamePropertyInfo = DBusObjectManagerClient
    attrGet = getDBusObjectManagerClientName
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDBusObjectManagerClientName
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectManagerClient.name"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DBusObjectManagerClient.html#g:attr:name"
        })
#endif

-- VVV Prop "name-owner"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@name-owner@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusObjectManagerClient #nameOwner
-- @
getDBusObjectManagerClientNameOwner :: (MonadIO m, IsDBusObjectManagerClient o) => o -> m (Maybe T.Text)
getDBusObjectManagerClientNameOwner :: forall (m :: * -> *) o.
(MonadIO m, IsDBusObjectManagerClient o) =>
o -> m (Maybe Text)
getDBusObjectManagerClientNameOwner o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"name-owner"

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerClientNameOwnerPropertyInfo
instance AttrInfo DBusObjectManagerClientNameOwnerPropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientNameOwnerPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DBusObjectManagerClientNameOwnerPropertyInfo = IsDBusObjectManagerClient
    type AttrSetTypeConstraint DBusObjectManagerClientNameOwnerPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DBusObjectManagerClientNameOwnerPropertyInfo = (~) ()
    type AttrTransferType DBusObjectManagerClientNameOwnerPropertyInfo = ()
    type AttrGetType DBusObjectManagerClientNameOwnerPropertyInfo = (Maybe T.Text)
    type AttrLabel DBusObjectManagerClientNameOwnerPropertyInfo = "name-owner"
    type AttrOrigin DBusObjectManagerClientNameOwnerPropertyInfo = DBusObjectManagerClient
    attrGet = getDBusObjectManagerClientNameOwner
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectManagerClient.nameOwner"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DBusObjectManagerClient.html#g:attr:nameOwner"
        })
#endif

-- VVV Prop "object-path"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@object-path@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusObjectManagerClient #objectPath
-- @
getDBusObjectManagerClientObjectPath :: (MonadIO m, IsDBusObjectManagerClient o) => o -> m (Maybe T.Text)
getDBusObjectManagerClientObjectPath :: forall (m :: * -> *) o.
(MonadIO m, IsDBusObjectManagerClient o) =>
o -> m (Maybe Text)
getDBusObjectManagerClientObjectPath o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"object-path"

-- | Construct a `GValueConstruct` with valid value for the “@object-path@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDBusObjectManagerClientObjectPath :: (IsDBusObjectManagerClient o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDBusObjectManagerClientObjectPath :: forall o (m :: * -> *).
(IsDBusObjectManagerClient o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDBusObjectManagerClientObjectPath Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"object-path" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerClientObjectPathPropertyInfo
instance AttrInfo DBusObjectManagerClientObjectPathPropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientObjectPathPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DBusObjectManagerClientObjectPathPropertyInfo = IsDBusObjectManagerClient
    type AttrSetTypeConstraint DBusObjectManagerClientObjectPathPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DBusObjectManagerClientObjectPathPropertyInfo = (~) T.Text
    type AttrTransferType DBusObjectManagerClientObjectPathPropertyInfo = T.Text
    type AttrGetType DBusObjectManagerClientObjectPathPropertyInfo = (Maybe T.Text)
    type AttrLabel DBusObjectManagerClientObjectPathPropertyInfo = "object-path"
    type AttrOrigin DBusObjectManagerClientObjectPathPropertyInfo = DBusObjectManagerClient
    attrGet = getDBusObjectManagerClientObjectPath
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDBusObjectManagerClientObjectPath
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectManagerClient.objectPath"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DBusObjectManagerClient.html#g:attr:objectPath"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DBusObjectManagerClient
type instance O.AttributeList DBusObjectManagerClient = DBusObjectManagerClientAttributeList
type DBusObjectManagerClientAttributeList = ('[ '("busType", DBusObjectManagerClientBusTypePropertyInfo), '("connection", DBusObjectManagerClientConnectionPropertyInfo), '("flags", DBusObjectManagerClientFlagsPropertyInfo), '("getProxyTypeDestroyNotify", DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo), '("getProxyTypeFunc", DBusObjectManagerClientGetProxyTypeFuncPropertyInfo), '("getProxyTypeUserData", DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo), '("name", DBusObjectManagerClientNamePropertyInfo), '("nameOwner", DBusObjectManagerClientNameOwnerPropertyInfo), '("objectPath", DBusObjectManagerClientObjectPathPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
dBusObjectManagerClientBusType :: AttrLabelProxy "busType"
dBusObjectManagerClientBusType = AttrLabelProxy

dBusObjectManagerClientConnection :: AttrLabelProxy "connection"
dBusObjectManagerClientConnection = AttrLabelProxy

dBusObjectManagerClientFlags :: AttrLabelProxy "flags"
dBusObjectManagerClientFlags = AttrLabelProxy

dBusObjectManagerClientGetProxyTypeDestroyNotify :: AttrLabelProxy "getProxyTypeDestroyNotify"
dBusObjectManagerClientGetProxyTypeDestroyNotify = AttrLabelProxy

dBusObjectManagerClientGetProxyTypeFunc :: AttrLabelProxy "getProxyTypeFunc"
dBusObjectManagerClientGetProxyTypeFunc = AttrLabelProxy

dBusObjectManagerClientGetProxyTypeUserData :: AttrLabelProxy "getProxyTypeUserData"
dBusObjectManagerClientGetProxyTypeUserData = AttrLabelProxy

dBusObjectManagerClientName :: AttrLabelProxy "name"
dBusObjectManagerClientName = AttrLabelProxy

dBusObjectManagerClientNameOwner :: AttrLabelProxy "nameOwner"
dBusObjectManagerClientNameOwner = AttrLabelProxy

dBusObjectManagerClientObjectPath :: AttrLabelProxy "objectPath"
dBusObjectManagerClientObjectPath = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DBusObjectManagerClient = DBusObjectManagerClientSignalList
type DBusObjectManagerClientSignalList = ('[ '("interfaceAdded", Gio.DBusObjectManager.DBusObjectManagerInterfaceAddedSignalInfo), '("interfaceProxyPropertiesChanged", DBusObjectManagerClientInterfaceProxyPropertiesChangedSignalInfo), '("interfaceProxySignal", DBusObjectManagerClientInterfaceProxySignalSignalInfo), '("interfaceRemoved", Gio.DBusObjectManager.DBusObjectManagerInterfaceRemovedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("objectAdded", Gio.DBusObjectManager.DBusObjectManagerObjectAddedSignalInfo), '("objectRemoved", Gio.DBusObjectManager.DBusObjectManagerObjectRemovedSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method DBusObjectManagerClient::new_finish
-- method type : Constructor
-- Args: [ 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 g_dbus_object_manager_client_new()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "DBusObjectManagerClient" })
-- throws : True
-- Skip return : False

foreign import ccall "g_dbus_object_manager_client_new_finish" g_dbus_object_manager_client_new_finish :: 
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr DBusObjectManagerClient)

-- | Finishes an operation started with 'GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientNew'.
-- 
-- /Since: 2.30/
dBusObjectManagerClientNewFinish ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
    a
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to 'GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientNew'.
    -> m DBusObjectManagerClient
    -- ^ __Returns:__ A
    --   t'GI.Gio.Objects.DBusObjectManagerClient.DBusObjectManagerClient' object or 'P.Nothing' if /@error@/ is set. Free
    --   with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
dBusObjectManagerClientNewFinish :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m DBusObjectManagerClient
dBusObjectManagerClientNewFinish a
res = IO DBusObjectManagerClient -> m DBusObjectManagerClient
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DBusObjectManagerClient -> m DBusObjectManagerClient)
-> IO DBusObjectManagerClient -> m DBusObjectManagerClient
forall a b. (a -> b) -> a -> b
$ do
    res' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
res
    onException (do
        result <- propagateGError $ g_dbus_object_manager_client_new_finish res'
        checkUnexpectedReturnNULL "dBusObjectManagerClientNewFinish" result
        result' <- (wrapObject DBusObjectManagerClient) result
        touchManagedPtr res
        return result'
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method DBusObjectManagerClient::new_for_bus_finish
-- method type : Constructor
-- Args: [ 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 g_dbus_object_manager_client_new_for_bus()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "DBusObjectManagerClient" })
-- throws : True
-- Skip return : False

foreign import ccall "g_dbus_object_manager_client_new_for_bus_finish" g_dbus_object_manager_client_new_for_bus_finish :: 
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr DBusObjectManagerClient)

-- | Finishes an operation started with 'GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientNewForBus'.
-- 
-- /Since: 2.30/
dBusObjectManagerClientNewForBusFinish ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
    a
    -- ^ /@res@/: A t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to 'GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientNewForBus'.
    -> m DBusObjectManagerClient
    -- ^ __Returns:__ A
    --   t'GI.Gio.Objects.DBusObjectManagerClient.DBusObjectManagerClient' object or 'P.Nothing' if /@error@/ is set. Free
    --   with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
dBusObjectManagerClientNewForBusFinish :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m DBusObjectManagerClient
dBusObjectManagerClientNewForBusFinish a
res = IO DBusObjectManagerClient -> m DBusObjectManagerClient
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DBusObjectManagerClient -> m DBusObjectManagerClient)
-> IO DBusObjectManagerClient -> m DBusObjectManagerClient
forall a b. (a -> b) -> a -> b
$ do
    res' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
res
    onException (do
        result <- propagateGError $ g_dbus_object_manager_client_new_for_bus_finish res'
        checkUnexpectedReturnNULL "dBusObjectManagerClientNewForBusFinish" result
        result' <- (wrapObject DBusObjectManagerClient) result
        touchManagedPtr res
        return result'
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method DBusObjectManagerClient::new_for_bus_sync
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "bus_type"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "BusType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GBusType." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DBusObjectManagerClientFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Zero or more flags from the #GDBusObjectManagerClientFlags enumeration."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The owner of the control object (unique or well-known name)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object path of the control object."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "get_proxy_type_func"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusProxyTypeFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GDBusProxyTypeFunc function or %NULL to always construct #GDBusProxy proxies."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 5
--           , argDestroy = 6
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "get_proxy_type_user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "User data to pass to @get_proxy_type_func."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "get_proxy_type_destroy_notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Free function for @get_proxy_type_user_data or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "DBusObjectManagerClient" })
-- throws : True
-- Skip return : False

foreign import ccall "g_dbus_object_manager_client_new_for_bus_sync" g_dbus_object_manager_client_new_for_bus_sync :: 
    CInt ->                                 -- bus_type : TInterface (Name {namespace = "Gio", name = "BusType"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "DBusObjectManagerClientFlags"})
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- object_path : TBasicType TUTF8
    FunPtr Gio.Callbacks.C_DBusProxyTypeFunc -> -- get_proxy_type_func : TInterface (Name {namespace = "Gio", name = "DBusProxyTypeFunc"})
    Ptr () ->                               -- get_proxy_type_user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- get_proxy_type_destroy_notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr DBusObjectManagerClient)

-- | Like 'GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientNewSync' but takes a t'GI.Gio.Enums.BusType' instead
-- of a t'GI.Gio.Objects.DBusConnection.DBusConnection'.
-- 
-- This is a synchronous failable constructor - the calling thread is
-- blocked until a reply is received. See 'GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientNewForBus'
-- for the asynchronous version.
-- 
-- /Since: 2.30/
dBusObjectManagerClientNewForBusSync ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Cancellable.IsCancellable a) =>
    Gio.Enums.BusType
    -- ^ /@busType@/: A t'GI.Gio.Enums.BusType'.
    -> [Gio.Flags.DBusObjectManagerClientFlags]
    -- ^ /@flags@/: Zero or more flags from the t'GI.Gio.Flags.DBusObjectManagerClientFlags' enumeration.
    -> T.Text
    -- ^ /@name@/: The owner of the control object (unique or well-known name).
    -> T.Text
    -- ^ /@objectPath@/: The object path of the control object.
    -> Maybe (Gio.Callbacks.DBusProxyTypeFunc)
    -- ^ /@getProxyTypeFunc@/: A t'GI.Gio.Callbacks.DBusProxyTypeFunc' function or 'P.Nothing' to always construct t'GI.Gio.Objects.DBusProxy.DBusProxy' proxies.
    -> Maybe (a)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'
    -> m DBusObjectManagerClient
    -- ^ __Returns:__ A
    --   t'GI.Gio.Objects.DBusObjectManagerClient.DBusObjectManagerClient' object or 'P.Nothing' if /@error@/ is set. Free
    --   with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
dBusObjectManagerClientNewForBusSync :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCancellable a) =>
BusType
-> [DBusObjectManagerClientFlags]
-> Text
-> Text
-> Maybe DBusProxyTypeFunc
-> Maybe a
-> m DBusObjectManagerClient
dBusObjectManagerClientNewForBusSync BusType
busType [DBusObjectManagerClientFlags]
flags Text
name Text
objectPath Maybe DBusProxyTypeFunc
getProxyTypeFunc Maybe a
cancellable = IO DBusObjectManagerClient -> m DBusObjectManagerClient
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DBusObjectManagerClient -> m DBusObjectManagerClient)
-> IO DBusObjectManagerClient -> m DBusObjectManagerClient
forall a b. (a -> b) -> a -> b
$ do
    let busType' :: CInt
busType' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (BusType -> Int) -> BusType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BusType -> Int
forall a. Enum a => a -> Int
fromEnum) BusType
busType
    let flags' :: CUInt
flags' = [DBusObjectManagerClientFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DBusObjectManagerClientFlags]
flags
    name' <- Text -> IO CString
textToCString Text
name
    objectPath' <- textToCString objectPath
    maybeGetProxyTypeFunc <- case getProxyTypeFunc of
        Maybe DBusProxyTypeFunc
Nothing -> FunPtr C_DBusProxyTypeFunc -> IO (FunPtr C_DBusProxyTypeFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_DBusProxyTypeFunc
forall a. FunPtr a
FP.nullFunPtr
        Just DBusProxyTypeFunc
jGetProxyTypeFunc -> do
            jGetProxyTypeFunc' <- C_DBusProxyTypeFunc -> IO (FunPtr C_DBusProxyTypeFunc)
Gio.Callbacks.mk_DBusProxyTypeFunc (Maybe (Ptr (FunPtr C_DBusProxyTypeFunc))
-> DBusProxyTypeFunc -> C_DBusProxyTypeFunc
Gio.Callbacks.wrap_DBusProxyTypeFunc Maybe (Ptr (FunPtr C_DBusProxyTypeFunc))
forall a. Maybe a
Nothing DBusProxyTypeFunc
jGetProxyTypeFunc)
            return jGetProxyTypeFunc'
    maybeCancellable <- case cancellable of
        Maybe a
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just a
jCancellable -> do
            jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            return jCancellable'
    let getProxyTypeUserData = FunPtr C_DBusProxyTypeFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_DBusProxyTypeFunc
maybeGetProxyTypeFunc
    let getProxyTypeDestroyNotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    onException (do
        result <- propagateGError $ g_dbus_object_manager_client_new_for_bus_sync busType' flags' name' objectPath' maybeGetProxyTypeFunc getProxyTypeUserData getProxyTypeDestroyNotify maybeCancellable
        checkUnexpectedReturnNULL "dBusObjectManagerClientNewForBusSync" result
        result' <- (wrapObject DBusObjectManagerClient) result
        whenJust cancellable touchManagedPtr
        freeMem name'
        freeMem objectPath'
        return result'
     ) (do
        freeMem name'
        freeMem objectPath'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method DBusObjectManagerClient::new_sync
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusConnection."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DBusObjectManagerClientFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Zero or more flags from the #GDBusObjectManagerClientFlags enumeration."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The owner of the control object (unique or well-known name), or %NULL when not using a message bus connection."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object path of the control object."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "get_proxy_type_func"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusProxyTypeFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GDBusProxyTypeFunc function or %NULL to always construct #GDBusProxy proxies."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 5
--           , argDestroy = 6
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "get_proxy_type_user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "User data to pass to @get_proxy_type_func."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "get_proxy_type_destroy_notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Free function for @get_proxy_type_user_data or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "DBusObjectManagerClient" })
-- throws : True
-- Skip return : False

foreign import ccall "g_dbus_object_manager_client_new_sync" g_dbus_object_manager_client_new_sync :: 
    Ptr Gio.DBusConnection.DBusConnection -> -- connection : TInterface (Name {namespace = "Gio", name = "DBusConnection"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "DBusObjectManagerClientFlags"})
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- object_path : TBasicType TUTF8
    FunPtr Gio.Callbacks.C_DBusProxyTypeFunc -> -- get_proxy_type_func : TInterface (Name {namespace = "Gio", name = "DBusProxyTypeFunc"})
    Ptr () ->                               -- get_proxy_type_user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- get_proxy_type_destroy_notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr DBusObjectManagerClient)

-- | Creates a new t'GI.Gio.Objects.DBusObjectManagerClient.DBusObjectManagerClient' object.
-- 
-- This is a synchronous failable constructor - the calling thread is
-- blocked until a reply is received. See 'GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientNew'
-- for the asynchronous version.
-- 
-- /Since: 2.30/
dBusObjectManagerClientNewSync ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.DBusConnection.IsDBusConnection a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@connection@/: A t'GI.Gio.Objects.DBusConnection.DBusConnection'.
    -> [Gio.Flags.DBusObjectManagerClientFlags]
    -- ^ /@flags@/: Zero or more flags from the t'GI.Gio.Flags.DBusObjectManagerClientFlags' enumeration.
    -> Maybe (T.Text)
    -- ^ /@name@/: The owner of the control object (unique or well-known name), or 'P.Nothing' when not using a message bus connection.
    -> T.Text
    -- ^ /@objectPath@/: The object path of the control object.
    -> Maybe (Gio.Callbacks.DBusProxyTypeFunc)
    -- ^ /@getProxyTypeFunc@/: A t'GI.Gio.Callbacks.DBusProxyTypeFunc' function or 'P.Nothing' to always construct t'GI.Gio.Objects.DBusProxy.DBusProxy' proxies.
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'
    -> m DBusObjectManagerClient
    -- ^ __Returns:__ A
    --   t'GI.Gio.Objects.DBusObjectManagerClient.DBusObjectManagerClient' object or 'P.Nothing' if /@error@/ is set. Free
    --   with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
dBusObjectManagerClientNewSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDBusConnection a, IsCancellable b) =>
a
-> [DBusObjectManagerClientFlags]
-> Maybe Text
-> Text
-> Maybe DBusProxyTypeFunc
-> Maybe b
-> m DBusObjectManagerClient
dBusObjectManagerClientNewSync a
connection [DBusObjectManagerClientFlags]
flags Maybe Text
name Text
objectPath Maybe DBusProxyTypeFunc
getProxyTypeFunc Maybe b
cancellable = IO DBusObjectManagerClient -> m DBusObjectManagerClient
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DBusObjectManagerClient -> m DBusObjectManagerClient)
-> IO DBusObjectManagerClient -> m DBusObjectManagerClient
forall a b. (a -> b) -> a -> b
$ do
    connection' <- a -> IO (Ptr DBusConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
    let flags' = [DBusObjectManagerClientFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DBusObjectManagerClientFlags]
flags
    maybeName <- case name of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jName -> do
            jName' <- Text -> IO CString
textToCString Text
jName
            return jName'
    objectPath' <- textToCString objectPath
    maybeGetProxyTypeFunc <- case getProxyTypeFunc of
        Maybe DBusProxyTypeFunc
Nothing -> FunPtr C_DBusProxyTypeFunc -> IO (FunPtr C_DBusProxyTypeFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_DBusProxyTypeFunc
forall a. FunPtr a
FP.nullFunPtr
        Just DBusProxyTypeFunc
jGetProxyTypeFunc -> do
            jGetProxyTypeFunc' <- C_DBusProxyTypeFunc -> IO (FunPtr C_DBusProxyTypeFunc)
Gio.Callbacks.mk_DBusProxyTypeFunc (Maybe (Ptr (FunPtr C_DBusProxyTypeFunc))
-> DBusProxyTypeFunc -> C_DBusProxyTypeFunc
Gio.Callbacks.wrap_DBusProxyTypeFunc Maybe (Ptr (FunPtr C_DBusProxyTypeFunc))
forall a. Maybe a
Nothing DBusProxyTypeFunc
jGetProxyTypeFunc)
            return jGetProxyTypeFunc'
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    let getProxyTypeUserData = FunPtr C_DBusProxyTypeFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_DBusProxyTypeFunc
maybeGetProxyTypeFunc
    let getProxyTypeDestroyNotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    onException (do
        result <- propagateGError $ g_dbus_object_manager_client_new_sync connection' flags' maybeName objectPath' maybeGetProxyTypeFunc getProxyTypeUserData getProxyTypeDestroyNotify maybeCancellable
        checkUnexpectedReturnNULL "dBusObjectManagerClientNewSync" result
        result' <- (wrapObject DBusObjectManagerClient) result
        touchManagedPtr connection
        whenJust cancellable touchManagedPtr
        freeMem maybeName
        freeMem objectPath'
        return result'
     ) (do
        freeMem maybeName
        freeMem objectPath'
     )

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "g_dbus_object_manager_client_get_connection" g_dbus_object_manager_client_get_connection :: 
    Ptr DBusObjectManagerClient ->          -- manager : TInterface (Name {namespace = "Gio", name = "DBusObjectManagerClient"})
    IO (Ptr Gio.DBusConnection.DBusConnection)

-- | Gets the t'GI.Gio.Objects.DBusConnection.DBusConnection' used by /@manager@/.
-- 
-- /Since: 2.30/
dBusObjectManagerClientGetConnection ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusObjectManagerClient a) =>
    a
    -- ^ /@manager@/: A t'GI.Gio.Objects.DBusObjectManagerClient.DBusObjectManagerClient'
    -> m Gio.DBusConnection.DBusConnection
    -- ^ __Returns:__ A t'GI.Gio.Objects.DBusConnection.DBusConnection' object. Do not free,
    --   the object belongs to /@manager@/.
dBusObjectManagerClientGetConnection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusObjectManagerClient a) =>
a -> m DBusConnection
dBusObjectManagerClientGetConnection a
manager = IO DBusConnection -> m DBusConnection
forall a. IO a -> m a
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
    manager' <- a -> IO (Ptr DBusObjectManagerClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    result <- g_dbus_object_manager_client_get_connection manager'
    checkUnexpectedReturnNULL "dBusObjectManagerClientGetConnection" result
    result' <- (newObject Gio.DBusConnection.DBusConnection) result
    touchManagedPtr manager
    return result'

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerClientGetConnectionMethodInfo
instance (signature ~ (m Gio.DBusConnection.DBusConnection), MonadIO m, IsDBusObjectManagerClient a) => O.OverloadedMethod DBusObjectManagerClientGetConnectionMethodInfo a signature where
    overloadedMethod = dBusObjectManagerClientGetConnection

instance O.OverloadedMethodInfo DBusObjectManagerClientGetConnectionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientGetConnection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DBusObjectManagerClient.html#v:dBusObjectManagerClientGetConnection"
        })


#endif

-- method DBusObjectManagerClient::get_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DBusObjectManagerClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusObjectManagerClient"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "DBusObjectManagerClientFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_manager_client_get_flags" g_dbus_object_manager_client_get_flags :: 
    Ptr DBusObjectManagerClient ->          -- manager : TInterface (Name {namespace = "Gio", name = "DBusObjectManagerClient"})
    IO CUInt

-- | Gets the flags that /@manager@/ was constructed with.
-- 
-- /Since: 2.30/
dBusObjectManagerClientGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusObjectManagerClient a) =>
    a
    -- ^ /@manager@/: A t'GI.Gio.Objects.DBusObjectManagerClient.DBusObjectManagerClient'
    -> m [Gio.Flags.DBusObjectManagerClientFlags]
    -- ^ __Returns:__ Zero of more flags from the t'GI.Gio.Flags.DBusObjectManagerClientFlags'
    -- enumeration.
dBusObjectManagerClientGetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusObjectManagerClient a) =>
a -> m [DBusObjectManagerClientFlags]
dBusObjectManagerClientGetFlags a
manager = IO [DBusObjectManagerClientFlags]
-> m [DBusObjectManagerClientFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DBusObjectManagerClientFlags]
 -> m [DBusObjectManagerClientFlags])
-> IO [DBusObjectManagerClientFlags]
-> m [DBusObjectManagerClientFlags]
forall a b. (a -> b) -> a -> b
$ do
    manager' <- a -> IO (Ptr DBusObjectManagerClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    result <- g_dbus_object_manager_client_get_flags manager'
    let result' = CUInt -> [DBusObjectManagerClientFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    touchManagedPtr manager
    return result'

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerClientGetFlagsMethodInfo
instance (signature ~ (m [Gio.Flags.DBusObjectManagerClientFlags]), MonadIO m, IsDBusObjectManagerClient a) => O.OverloadedMethod DBusObjectManagerClientGetFlagsMethodInfo a signature where
    overloadedMethod = dBusObjectManagerClientGetFlags

instance O.OverloadedMethodInfo DBusObjectManagerClientGetFlagsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientGetFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DBusObjectManagerClient.html#v:dBusObjectManagerClientGetFlags"
        })


#endif

-- method DBusObjectManagerClient::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DBusObjectManagerClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusObjectManagerClient"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_manager_client_get_name" g_dbus_object_manager_client_get_name :: 
    Ptr DBusObjectManagerClient ->          -- manager : TInterface (Name {namespace = "Gio", name = "DBusObjectManagerClient"})
    IO CString

-- | Gets the name that /@manager@/ is for, or 'P.Nothing' if not a message bus
-- connection.
-- 
-- /Since: 2.30/
dBusObjectManagerClientGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusObjectManagerClient a) =>
    a
    -- ^ /@manager@/: A t'GI.Gio.Objects.DBusObjectManagerClient.DBusObjectManagerClient'
    -> m T.Text
    -- ^ __Returns:__ A unique or well-known name. Do not free, the string
    -- belongs to /@manager@/.
dBusObjectManagerClientGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusObjectManagerClient a) =>
a -> m Text
dBusObjectManagerClientGetName a
manager = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    manager' <- a -> IO (Ptr DBusObjectManagerClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    result <- g_dbus_object_manager_client_get_name manager'
    checkUnexpectedReturnNULL "dBusObjectManagerClientGetName" result
    result' <- cstringToText result
    touchManagedPtr manager
    return result'

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerClientGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDBusObjectManagerClient a) => O.OverloadedMethod DBusObjectManagerClientGetNameMethodInfo a signature where
    overloadedMethod = dBusObjectManagerClientGetName

instance O.OverloadedMethodInfo DBusObjectManagerClientGetNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientGetName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DBusObjectManagerClient.html#v:dBusObjectManagerClientGetName"
        })


#endif

-- method DBusObjectManagerClient::get_name_owner
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DBusObjectManagerClient" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusObjectManagerClient."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_manager_client_get_name_owner" g_dbus_object_manager_client_get_name_owner :: 
    Ptr DBusObjectManagerClient ->          -- manager : TInterface (Name {namespace = "Gio", name = "DBusObjectManagerClient"})
    IO CString

-- | The unique name that owns the name that /@manager@/ is for or 'P.Nothing' if
-- no-one currently owns that name. You can connect to the
-- [Object::notify]("GI.GObject.Objects.Object#g:signal:notify") signal to track changes to the
-- [DBusObjectManagerClient:nameOwner]("GI.Gio.Objects.DBusObjectManagerClient#g:attr:nameOwner") property.
-- 
-- /Since: 2.30/
dBusObjectManagerClientGetNameOwner ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusObjectManagerClient a) =>
    a
    -- ^ /@manager@/: A t'GI.Gio.Objects.DBusObjectManagerClient.DBusObjectManagerClient'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The name owner or 'P.Nothing' if no name owner
    -- exists. Free with 'GI.GLib.Functions.free'.
dBusObjectManagerClientGetNameOwner :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusObjectManagerClient a) =>
a -> m (Maybe Text)
dBusObjectManagerClientGetNameOwner a
manager = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    manager' <- a -> IO (Ptr DBusObjectManagerClient)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    result <- g_dbus_object_manager_client_get_name_owner manager'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        freeMem result'
        return result''
    touchManagedPtr manager
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerClientGetNameOwnerMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsDBusObjectManagerClient a) => O.OverloadedMethod DBusObjectManagerClientGetNameOwnerMethodInfo a signature where
    overloadedMethod = dBusObjectManagerClientGetNameOwner

instance O.OverloadedMethodInfo DBusObjectManagerClientGetNameOwnerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientGetNameOwner",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-DBusObjectManagerClient.html#v:dBusObjectManagerClientGetNameOwner"
        })


#endif

-- method DBusObjectManagerClient::new
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusConnection."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DBusObjectManagerClientFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Zero or more flags from the #GDBusObjectManagerClientFlags enumeration."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The owner of the control object (unique or well-known name)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object path of the control object."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "get_proxy_type_func"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusProxyTypeFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GDBusProxyTypeFunc function or %NULL to always construct #GDBusProxy proxies."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 5
--           , argDestroy = 6
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "get_proxy_type_user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "User data to pass to @get_proxy_type_func."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "get_proxy_type_destroy_notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Free function for @get_proxy_type_user_data or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 9
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_manager_client_new" g_dbus_object_manager_client_new :: 
    Ptr Gio.DBusConnection.DBusConnection -> -- connection : TInterface (Name {namespace = "Gio", name = "DBusConnection"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "DBusObjectManagerClientFlags"})
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- object_path : TBasicType TUTF8
    FunPtr Gio.Callbacks.C_DBusProxyTypeFunc -> -- get_proxy_type_func : TInterface (Name {namespace = "Gio", name = "DBusProxyTypeFunc"})
    Ptr () ->                               -- get_proxy_type_user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- get_proxy_type_destroy_notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    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 ()

-- | Asynchronously creates a new t'GI.Gio.Objects.DBusObjectManagerClient.DBusObjectManagerClient' object.
-- 
-- This is an asynchronous failable constructor. When the result is
-- ready, /@callback@/ will be invoked in the
-- [thread-default main context][g-main-context-push-thread-default]
-- of the thread you are calling this method from. You can
-- then call 'GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientNewFinish' to get the result. See
-- 'GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientNewSync' for the synchronous version.
-- 
-- /Since: 2.30/
dBusObjectManagerClientNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.DBusConnection.IsDBusConnection a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@connection@/: A t'GI.Gio.Objects.DBusConnection.DBusConnection'.
    -> [Gio.Flags.DBusObjectManagerClientFlags]
    -- ^ /@flags@/: Zero or more flags from the t'GI.Gio.Flags.DBusObjectManagerClientFlags' enumeration.
    -> T.Text
    -- ^ /@name@/: The owner of the control object (unique or well-known name).
    -> T.Text
    -- ^ /@objectPath@/: The object path of the control object.
    -> Maybe (Gio.Callbacks.DBusProxyTypeFunc)
    -- ^ /@getProxyTypeFunc@/: A t'GI.Gio.Callbacks.DBusProxyTypeFunc' function or 'P.Nothing' to always construct t'GI.Gio.Objects.DBusProxy.DBusProxy' proxies.
    -> 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.
    -> m ()
dBusObjectManagerClientNew :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDBusConnection a, IsCancellable b) =>
a
-> [DBusObjectManagerClientFlags]
-> Text
-> Text
-> Maybe DBusProxyTypeFunc
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
dBusObjectManagerClientNew a
connection [DBusObjectManagerClientFlags]
flags Text
name Text
objectPath Maybe DBusProxyTypeFunc
getProxyTypeFunc Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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
    connection' <- a -> IO (Ptr DBusConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
    let flags' = [DBusObjectManagerClientFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DBusObjectManagerClientFlags]
flags
    name' <- textToCString name
    objectPath' <- textToCString objectPath
    maybeGetProxyTypeFunc <- case getProxyTypeFunc of
        Maybe DBusProxyTypeFunc
Nothing -> FunPtr C_DBusProxyTypeFunc -> IO (FunPtr C_DBusProxyTypeFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_DBusProxyTypeFunc
forall a. FunPtr a
FP.nullFunPtr
        Just DBusProxyTypeFunc
jGetProxyTypeFunc -> do
            jGetProxyTypeFunc' <- C_DBusProxyTypeFunc -> IO (FunPtr C_DBusProxyTypeFunc)
Gio.Callbacks.mk_DBusProxyTypeFunc (Maybe (Ptr (FunPtr C_DBusProxyTypeFunc))
-> DBusProxyTypeFunc -> C_DBusProxyTypeFunc
Gio.Callbacks.wrap_DBusProxyTypeFunc Maybe (Ptr (FunPtr C_DBusProxyTypeFunc))
forall a. Maybe a
Nothing DBusProxyTypeFunc
jGetProxyTypeFunc)
            return jGetProxyTypeFunc'
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let getProxyTypeUserData = FunPtr C_DBusProxyTypeFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_DBusProxyTypeFunc
maybeGetProxyTypeFunc
    let getProxyTypeDestroyNotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    let userData = Ptr a
forall a. Ptr a
nullPtr
    g_dbus_object_manager_client_new connection' flags' name' objectPath' maybeGetProxyTypeFunc getProxyTypeUserData getProxyTypeDestroyNotify maybeCancellable maybeCallback userData
    touchManagedPtr connection
    whenJust cancellable touchManagedPtr
    freeMem name'
    freeMem objectPath'
    return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method DBusObjectManagerClient::new_for_bus
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "bus_type"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "BusType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GBusType." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DBusObjectManagerClientFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Zero or more flags from the #GDBusObjectManagerClientFlags enumeration."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The owner of the control object (unique or well-known name)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object path of the control object."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "get_proxy_type_func"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusProxyTypeFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GDBusProxyTypeFunc function or %NULL to always construct #GDBusProxy proxies."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 5
--           , argDestroy = 6
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "get_proxy_type_user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "User data to pass to @get_proxy_type_func."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "get_proxy_type_destroy_notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Free function for @get_proxy_type_user_data or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 9
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_manager_client_new_for_bus" g_dbus_object_manager_client_new_for_bus :: 
    CInt ->                                 -- bus_type : TInterface (Name {namespace = "Gio", name = "BusType"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "DBusObjectManagerClientFlags"})
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- object_path : TBasicType TUTF8
    FunPtr Gio.Callbacks.C_DBusProxyTypeFunc -> -- get_proxy_type_func : TInterface (Name {namespace = "Gio", name = "DBusProxyTypeFunc"})
    Ptr () ->                               -- get_proxy_type_user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- get_proxy_type_destroy_notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    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 ()

-- | Like 'GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientNew' but takes a t'GI.Gio.Enums.BusType' instead of a
-- t'GI.Gio.Objects.DBusConnection.DBusConnection'.
-- 
-- This is an asynchronous failable constructor. When the result is
-- ready, /@callback@/ will be invoked in the
-- [thread-default main loop][g-main-context-push-thread-default]
-- of the thread you are calling this method from. You can
-- then call 'GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientNewForBusFinish' to get the result. See
-- 'GI.Gio.Objects.DBusObjectManagerClient.dBusObjectManagerClientNewForBusSync' for the synchronous version.
-- 
-- /Since: 2.30/
dBusObjectManagerClientNewForBus ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Cancellable.IsCancellable a) =>
    Gio.Enums.BusType
    -- ^ /@busType@/: A t'GI.Gio.Enums.BusType'.
    -> [Gio.Flags.DBusObjectManagerClientFlags]
    -- ^ /@flags@/: Zero or more flags from the t'GI.Gio.Flags.DBusObjectManagerClientFlags' enumeration.
    -> T.Text
    -- ^ /@name@/: The owner of the control object (unique or well-known name).
    -> T.Text
    -- ^ /@objectPath@/: The object path of the control object.
    -> Maybe (Gio.Callbacks.DBusProxyTypeFunc)
    -- ^ /@getProxyTypeFunc@/: A t'GI.Gio.Callbacks.DBusProxyTypeFunc' function or 'P.Nothing' to always construct t'GI.Gio.Objects.DBusProxy.DBusProxy' proxies.
    -> Maybe (a)
    -- ^ /@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.
    -> m ()
dBusObjectManagerClientNewForBus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCancellable a) =>
BusType
-> [DBusObjectManagerClientFlags]
-> Text
-> Text
-> Maybe DBusProxyTypeFunc
-> Maybe a
-> Maybe AsyncReadyCallback
-> m ()
dBusObjectManagerClientNewForBus BusType
busType [DBusObjectManagerClientFlags]
flags Text
name Text
objectPath Maybe DBusProxyTypeFunc
getProxyTypeFunc Maybe a
cancellable Maybe AsyncReadyCallback
callback = 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
    let busType' :: CInt
busType' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (BusType -> Int) -> BusType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BusType -> Int
forall a. Enum a => a -> Int
fromEnum) BusType
busType
    let flags' :: CUInt
flags' = [DBusObjectManagerClientFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DBusObjectManagerClientFlags]
flags
    name' <- Text -> IO CString
textToCString Text
name
    objectPath' <- textToCString objectPath
    maybeGetProxyTypeFunc <- case getProxyTypeFunc of
        Maybe DBusProxyTypeFunc
Nothing -> FunPtr C_DBusProxyTypeFunc -> IO (FunPtr C_DBusProxyTypeFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_DBusProxyTypeFunc
forall a. FunPtr a
FP.nullFunPtr
        Just DBusProxyTypeFunc
jGetProxyTypeFunc -> do
            jGetProxyTypeFunc' <- C_DBusProxyTypeFunc -> IO (FunPtr C_DBusProxyTypeFunc)
Gio.Callbacks.mk_DBusProxyTypeFunc (Maybe (Ptr (FunPtr C_DBusProxyTypeFunc))
-> DBusProxyTypeFunc -> C_DBusProxyTypeFunc
Gio.Callbacks.wrap_DBusProxyTypeFunc Maybe (Ptr (FunPtr C_DBusProxyTypeFunc))
forall a. Maybe a
Nothing DBusProxyTypeFunc
jGetProxyTypeFunc)
            return jGetProxyTypeFunc'
    maybeCancellable <- case cancellable of
        Maybe a
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just a
jCancellable -> do
            jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let getProxyTypeUserData = FunPtr C_DBusProxyTypeFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_DBusProxyTypeFunc
maybeGetProxyTypeFunc
    let getProxyTypeDestroyNotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    let userData = Ptr a
forall a. Ptr a
nullPtr
    g_dbus_object_manager_client_new_for_bus busType' flags' name' objectPath' maybeGetProxyTypeFunc getProxyTypeUserData getProxyTypeDestroyNotify maybeCancellable maybeCallback userData
    whenJust cancellable touchManagedPtr
    freeMem name'
    freeMem objectPath'
    return ()

#if defined(ENABLE_OVERLOADING)
#endif