{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Gio.Objects.DBusObjectManagerClient
    ( 

-- * Exported types
    DBusObjectManagerClient(..)             ,
    DBusObjectManagerClientK                ,
    toDBusObjectManagerClient               ,
    noDBusObjectManagerClient               ,


 -- * Methods
-- ** dBusObjectManagerClientGetConnection
    dBusObjectManagerClientGetConnection    ,


-- ** dBusObjectManagerClientGetFlags
    dBusObjectManagerClientGetFlags         ,


-- ** dBusObjectManagerClientGetName
    dBusObjectManagerClientGetName          ,


-- ** dBusObjectManagerClientGetNameOwner
    dBusObjectManagerClientGetNameOwner     ,


-- ** dBusObjectManagerClientNew
    dBusObjectManagerClientNew              ,


-- ** dBusObjectManagerClientNewFinish
    dBusObjectManagerClientNewFinish        ,


-- ** dBusObjectManagerClientNewForBus
    dBusObjectManagerClientNewForBus        ,


-- ** dBusObjectManagerClientNewForBusFinish
    dBusObjectManagerClientNewForBusFinish  ,


-- ** dBusObjectManagerClientNewForBusSync
    dBusObjectManagerClientNewForBusSync    ,


-- ** dBusObjectManagerClientNewSync
    dBusObjectManagerClientNewSync          ,




 -- * Properties
-- ** BusType
    DBusObjectManagerClientBusTypePropertyInfo,
    constructDBusObjectManagerClientBusType ,


-- ** Connection
    DBusObjectManagerClientConnectionPropertyInfo,
    constructDBusObjectManagerClientConnection,
    getDBusObjectManagerClientConnection    ,


-- ** Flags
    DBusObjectManagerClientFlagsPropertyInfo,
    constructDBusObjectManagerClientFlags   ,
    getDBusObjectManagerClientFlags         ,


-- ** GetProxyTypeDestroyNotify
    DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo,
    constructDBusObjectManagerClientGetProxyTypeDestroyNotify,
    getDBusObjectManagerClientGetProxyTypeDestroyNotify,


-- ** GetProxyTypeFunc
    DBusObjectManagerClientGetProxyTypeFuncPropertyInfo,
    constructDBusObjectManagerClientGetProxyTypeFunc,
    getDBusObjectManagerClientGetProxyTypeFunc,


-- ** GetProxyTypeUserData
    DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo,
    constructDBusObjectManagerClientGetProxyTypeUserData,
    getDBusObjectManagerClientGetProxyTypeUserData,


-- ** Name
    DBusObjectManagerClientNamePropertyInfo ,
    constructDBusObjectManagerClientName    ,
    getDBusObjectManagerClientName          ,


-- ** NameOwner
    DBusObjectManagerClientNameOwnerPropertyInfo,
    getDBusObjectManagerClientNameOwner     ,


-- ** ObjectPath
    DBusObjectManagerClientObjectPathPropertyInfo,
    constructDBusObjectManagerClientObjectPath,
    getDBusObjectManagerClientObjectPath    ,




 -- * Signals
-- ** InterfaceProxyPropertiesChanged
    DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback,
    DBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackC,
    DBusObjectManagerClientInterfaceProxyPropertiesChangedSignalInfo,
    afterDBusObjectManagerClientInterfaceProxyPropertiesChanged,
    dBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackWrapper,
    dBusObjectManagerClientInterfaceProxyPropertiesChangedClosure,
    mkDBusObjectManagerClientInterfaceProxyPropertiesChangedCallback,
    noDBusObjectManagerClientInterfaceProxyPropertiesChangedCallback,
    onDBusObjectManagerClientInterfaceProxyPropertiesChanged,


-- ** InterfaceProxySignal
    DBusObjectManagerClientInterfaceProxySignalCallback,
    DBusObjectManagerClientInterfaceProxySignalCallbackC,
    DBusObjectManagerClientInterfaceProxySignalSignalInfo,
    afterDBusObjectManagerClientInterfaceProxySignal,
    dBusObjectManagerClientInterfaceProxySignalCallbackWrapper,
    dBusObjectManagerClientInterfaceProxySignalClosure,
    mkDBusObjectManagerClientInterfaceProxySignalCallback,
    noDBusObjectManagerClientInterfaceProxySignalCallback,
    onDBusObjectManagerClientInterfaceProxySignal,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gio.Types
import GI.Gio.Callbacks
import qualified GI.GLib as GLib
import qualified GI.GObject as GObject

newtype DBusObjectManagerClient = DBusObjectManagerClient (ForeignPtr DBusObjectManagerClient)
foreign import ccall "g_dbus_object_manager_client_get_type"
    c_g_dbus_object_manager_client_get_type :: IO GType

type instance ParentTypes DBusObjectManagerClient = DBusObjectManagerClientParentTypes
type DBusObjectManagerClientParentTypes = '[GObject.Object, AsyncInitable, DBusObjectManager, Initable]

instance GObject DBusObjectManagerClient where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_g_dbus_object_manager_client_get_type
    

class GObject o => DBusObjectManagerClientK o
instance (GObject o, IsDescendantOf DBusObjectManagerClient o) => DBusObjectManagerClientK o

toDBusObjectManagerClient :: DBusObjectManagerClientK o => o -> IO DBusObjectManagerClient
toDBusObjectManagerClient = unsafeCastTo DBusObjectManagerClient

noDBusObjectManagerClient :: Maybe DBusObjectManagerClient
noDBusObjectManagerClient = Nothing

-- signal DBusObjectManagerClient::interface-proxy-properties-changed
type DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback =
    DBusObjectProxy ->
    DBusProxy ->
    GVariant ->
    [T.Text] ->
    IO ()

noDBusObjectManagerClientInterfaceProxyPropertiesChangedCallback :: Maybe DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
noDBusObjectManagerClientInterfaceProxyPropertiesChangedCallback = Nothing

type DBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackC =
    Ptr () ->                               -- object
    Ptr DBusObjectProxy ->
    Ptr DBusProxy ->
    Ptr GVariant ->
    Ptr CString ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkDBusObjectManagerClientInterfaceProxyPropertiesChangedCallback :: DBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackC -> IO (FunPtr DBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackC)

dBusObjectManagerClientInterfaceProxyPropertiesChangedClosure :: DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback -> IO Closure
dBusObjectManagerClientInterfaceProxyPropertiesChangedClosure cb = newCClosure =<< mkDBusObjectManagerClientInterfaceProxyPropertiesChangedCallback wrapped
    where wrapped = dBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackWrapper cb

dBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackWrapper ::
    DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback ->
    Ptr () ->
    Ptr DBusObjectProxy ->
    Ptr DBusProxy ->
    Ptr GVariant ->
    Ptr CString ->
    Ptr () ->
    IO ()
dBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackWrapper _cb _ object_proxy interface_proxy changed_properties invalidated_properties _ = do
    object_proxy' <- (newObject DBusObjectProxy) object_proxy
    interface_proxy' <- (newObject DBusProxy) interface_proxy
    changed_properties' <- newGVariantFromPtr changed_properties
    invalidated_properties' <- unpackZeroTerminatedUTF8CArray invalidated_properties
    _cb  object_proxy' interface_proxy' changed_properties' invalidated_properties'

onDBusObjectManagerClientInterfaceProxyPropertiesChanged :: (GObject a, MonadIO m) => a -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback -> m SignalHandlerId
onDBusObjectManagerClientInterfaceProxyPropertiesChanged obj cb = liftIO $ connectDBusObjectManagerClientInterfaceProxyPropertiesChanged obj cb SignalConnectBefore
afterDBusObjectManagerClientInterfaceProxyPropertiesChanged :: (GObject a, MonadIO m) => a -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback -> m SignalHandlerId
afterDBusObjectManagerClientInterfaceProxyPropertiesChanged obj cb = connectDBusObjectManagerClientInterfaceProxyPropertiesChanged obj cb SignalConnectAfter

connectDBusObjectManagerClientInterfaceProxyPropertiesChanged :: (GObject a, MonadIO m) =>
                                                                 a -> DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectDBusObjectManagerClientInterfaceProxyPropertiesChanged obj cb after = liftIO $ do
    cb' <- mkDBusObjectManagerClientInterfaceProxyPropertiesChangedCallback (dBusObjectManagerClientInterfaceProxyPropertiesChangedCallbackWrapper cb)
    connectSignalFunPtr obj "interface-proxy-properties-changed" cb' after

-- signal DBusObjectManagerClient::interface-proxy-signal
type DBusObjectManagerClientInterfaceProxySignalCallback =
    DBusObjectProxy ->
    DBusProxy ->
    T.Text ->
    T.Text ->
    GVariant ->
    IO ()

noDBusObjectManagerClientInterfaceProxySignalCallback :: Maybe DBusObjectManagerClientInterfaceProxySignalCallback
noDBusObjectManagerClientInterfaceProxySignalCallback = Nothing

type DBusObjectManagerClientInterfaceProxySignalCallbackC =
    Ptr () ->                               -- object
    Ptr DBusObjectProxy ->
    Ptr DBusProxy ->
    CString ->
    CString ->
    Ptr GVariant ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkDBusObjectManagerClientInterfaceProxySignalCallback :: DBusObjectManagerClientInterfaceProxySignalCallbackC -> IO (FunPtr DBusObjectManagerClientInterfaceProxySignalCallbackC)

dBusObjectManagerClientInterfaceProxySignalClosure :: DBusObjectManagerClientInterfaceProxySignalCallback -> IO Closure
dBusObjectManagerClientInterfaceProxySignalClosure cb = newCClosure =<< mkDBusObjectManagerClientInterfaceProxySignalCallback wrapped
    where wrapped = dBusObjectManagerClientInterfaceProxySignalCallbackWrapper cb

dBusObjectManagerClientInterfaceProxySignalCallbackWrapper ::
    DBusObjectManagerClientInterfaceProxySignalCallback ->
    Ptr () ->
    Ptr DBusObjectProxy ->
    Ptr DBusProxy ->
    CString ->
    CString ->
    Ptr GVariant ->
    Ptr () ->
    IO ()
dBusObjectManagerClientInterfaceProxySignalCallbackWrapper _cb _ object_proxy interface_proxy sender_name signal_name parameters _ = do
    object_proxy' <- (newObject DBusObjectProxy) object_proxy
    interface_proxy' <- (newObject DBusProxy) interface_proxy
    sender_name' <- cstringToText sender_name
    signal_name' <- cstringToText signal_name
    parameters' <- newGVariantFromPtr parameters
    _cb  object_proxy' interface_proxy' sender_name' signal_name' parameters'

onDBusObjectManagerClientInterfaceProxySignal :: (GObject a, MonadIO m) => a -> DBusObjectManagerClientInterfaceProxySignalCallback -> m SignalHandlerId
onDBusObjectManagerClientInterfaceProxySignal obj cb = liftIO $ connectDBusObjectManagerClientInterfaceProxySignal obj cb SignalConnectBefore
afterDBusObjectManagerClientInterfaceProxySignal :: (GObject a, MonadIO m) => a -> DBusObjectManagerClientInterfaceProxySignalCallback -> m SignalHandlerId
afterDBusObjectManagerClientInterfaceProxySignal obj cb = connectDBusObjectManagerClientInterfaceProxySignal obj cb SignalConnectAfter

connectDBusObjectManagerClientInterfaceProxySignal :: (GObject a, MonadIO m) =>
                                                      a -> DBusObjectManagerClientInterfaceProxySignalCallback -> SignalConnectMode -> m SignalHandlerId
connectDBusObjectManagerClientInterfaceProxySignal obj cb after = liftIO $ do
    cb' <- mkDBusObjectManagerClientInterfaceProxySignalCallback (dBusObjectManagerClientInterfaceProxySignalCallbackWrapper cb)
    connectSignalFunPtr obj "interface-proxy-signal" cb' after

-- VVV Prop "bus-type"
   -- Type: TInterface "Gio" "BusType"
   -- Flags: [PropertyWritable,PropertyConstructOnly]

constructDBusObjectManagerClientBusType :: BusType -> IO ([Char], GValue)
constructDBusObjectManagerClientBusType val = constructObjectPropertyEnum "bus-type" val

data DBusObjectManagerClientBusTypePropertyInfo
instance AttrInfo DBusObjectManagerClientBusTypePropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientBusTypePropertyInfo = '[ 'AttrConstruct]
    type AttrSetTypeConstraint DBusObjectManagerClientBusTypePropertyInfo = (~) BusType
    type AttrBaseTypeConstraint DBusObjectManagerClientBusTypePropertyInfo = DBusObjectManagerClientK
    type AttrGetType DBusObjectManagerClientBusTypePropertyInfo = ()
    type AttrLabel DBusObjectManagerClientBusTypePropertyInfo = "DBusObjectManagerClient::bus-type"
    attrGet _ = undefined
    attrSet _ = undefined
    attrConstruct _ = constructDBusObjectManagerClientBusType

-- VVV Prop "connection"
   -- Type: TInterface "Gio" "DBusConnection"
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getDBusObjectManagerClientConnection :: (MonadIO m, DBusObjectManagerClientK o) => o -> m DBusConnection
getDBusObjectManagerClientConnection obj = liftIO $ getObjectPropertyObject obj "connection" DBusConnection

constructDBusObjectManagerClientConnection :: (DBusConnectionK a) => a -> IO ([Char], GValue)
constructDBusObjectManagerClientConnection val = constructObjectPropertyObject "connection" val

data DBusObjectManagerClientConnectionPropertyInfo
instance AttrInfo DBusObjectManagerClientConnectionPropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientConnectionPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DBusObjectManagerClientConnectionPropertyInfo = DBusConnectionK
    type AttrBaseTypeConstraint DBusObjectManagerClientConnectionPropertyInfo = DBusObjectManagerClientK
    type AttrGetType DBusObjectManagerClientConnectionPropertyInfo = DBusConnection
    type AttrLabel DBusObjectManagerClientConnectionPropertyInfo = "DBusObjectManagerClient::connection"
    attrGet _ = getDBusObjectManagerClientConnection
    attrSet _ = undefined
    attrConstruct _ = constructDBusObjectManagerClientConnection

-- VVV Prop "flags"
   -- Type: TInterface "Gio" "DBusObjectManagerClientFlags"
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getDBusObjectManagerClientFlags :: (MonadIO m, DBusObjectManagerClientK o) => o -> m [DBusObjectManagerClientFlags]
getDBusObjectManagerClientFlags obj = liftIO $ getObjectPropertyFlags obj "flags"

constructDBusObjectManagerClientFlags :: [DBusObjectManagerClientFlags] -> IO ([Char], GValue)
constructDBusObjectManagerClientFlags val = constructObjectPropertyFlags "flags" val

data DBusObjectManagerClientFlagsPropertyInfo
instance AttrInfo DBusObjectManagerClientFlagsPropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientFlagsPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DBusObjectManagerClientFlagsPropertyInfo = (~) [DBusObjectManagerClientFlags]
    type AttrBaseTypeConstraint DBusObjectManagerClientFlagsPropertyInfo = DBusObjectManagerClientK
    type AttrGetType DBusObjectManagerClientFlagsPropertyInfo = [DBusObjectManagerClientFlags]
    type AttrLabel DBusObjectManagerClientFlagsPropertyInfo = "DBusObjectManagerClient::flags"
    attrGet _ = getDBusObjectManagerClientFlags
    attrSet _ = undefined
    attrConstruct _ = constructDBusObjectManagerClientFlags

-- VVV Prop "get-proxy-type-destroy-notify"
   -- Type: TBasicType TVoid
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getDBusObjectManagerClientGetProxyTypeDestroyNotify :: (MonadIO m, DBusObjectManagerClientK o) => o -> m (Ptr ())
getDBusObjectManagerClientGetProxyTypeDestroyNotify obj = liftIO $ getObjectPropertyPtr obj "get-proxy-type-destroy-notify"

constructDBusObjectManagerClientGetProxyTypeDestroyNotify :: (Ptr ()) -> IO ([Char], GValue)
constructDBusObjectManagerClientGetProxyTypeDestroyNotify val = constructObjectPropertyPtr "get-proxy-type-destroy-notify" val

data DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo
instance AttrInfo DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = (~) (Ptr ())
    type AttrBaseTypeConstraint DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = DBusObjectManagerClientK
    type AttrGetType DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = (Ptr ())
    type AttrLabel DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = "DBusObjectManagerClient::get-proxy-type-destroy-notify"
    attrGet _ = getDBusObjectManagerClientGetProxyTypeDestroyNotify
    attrSet _ = undefined
    attrConstruct _ = constructDBusObjectManagerClientGetProxyTypeDestroyNotify

-- VVV Prop "get-proxy-type-func"
   -- Type: TBasicType TVoid
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getDBusObjectManagerClientGetProxyTypeFunc :: (MonadIO m, DBusObjectManagerClientK o) => o -> m (Ptr ())
getDBusObjectManagerClientGetProxyTypeFunc obj = liftIO $ getObjectPropertyPtr obj "get-proxy-type-func"

constructDBusObjectManagerClientGetProxyTypeFunc :: (Ptr ()) -> IO ([Char], GValue)
constructDBusObjectManagerClientGetProxyTypeFunc val = constructObjectPropertyPtr "get-proxy-type-func" val

data DBusObjectManagerClientGetProxyTypeFuncPropertyInfo
instance AttrInfo DBusObjectManagerClientGetProxyTypeFuncPropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = (~) (Ptr ())
    type AttrBaseTypeConstraint DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = DBusObjectManagerClientK
    type AttrGetType DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = (Ptr ())
    type AttrLabel DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = "DBusObjectManagerClient::get-proxy-type-func"
    attrGet _ = getDBusObjectManagerClientGetProxyTypeFunc
    attrSet _ = undefined
    attrConstruct _ = constructDBusObjectManagerClientGetProxyTypeFunc

-- VVV Prop "get-proxy-type-user-data"
   -- Type: TBasicType TVoid
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getDBusObjectManagerClientGetProxyTypeUserData :: (MonadIO m, DBusObjectManagerClientK o) => o -> m (Ptr ())
getDBusObjectManagerClientGetProxyTypeUserData obj = liftIO $ getObjectPropertyPtr obj "get-proxy-type-user-data"

constructDBusObjectManagerClientGetProxyTypeUserData :: (Ptr ()) -> IO ([Char], GValue)
constructDBusObjectManagerClientGetProxyTypeUserData val = constructObjectPropertyPtr "get-proxy-type-user-data" val

data DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo
instance AttrInfo DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = (~) (Ptr ())
    type AttrBaseTypeConstraint DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = DBusObjectManagerClientK
    type AttrGetType DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = (Ptr ())
    type AttrLabel DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = "DBusObjectManagerClient::get-proxy-type-user-data"
    attrGet _ = getDBusObjectManagerClientGetProxyTypeUserData
    attrSet _ = undefined
    attrConstruct _ = constructDBusObjectManagerClientGetProxyTypeUserData

-- VVV Prop "name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getDBusObjectManagerClientName :: (MonadIO m, DBusObjectManagerClientK o) => o -> m T.Text
getDBusObjectManagerClientName obj = liftIO $ getObjectPropertyString obj "name"

constructDBusObjectManagerClientName :: T.Text -> IO ([Char], GValue)
constructDBusObjectManagerClientName val = constructObjectPropertyString "name" val

data DBusObjectManagerClientNamePropertyInfo
instance AttrInfo DBusObjectManagerClientNamePropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DBusObjectManagerClientNamePropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DBusObjectManagerClientNamePropertyInfo = DBusObjectManagerClientK
    type AttrGetType DBusObjectManagerClientNamePropertyInfo = T.Text
    type AttrLabel DBusObjectManagerClientNamePropertyInfo = "DBusObjectManagerClient::name"
    attrGet _ = getDBusObjectManagerClientName
    attrSet _ = undefined
    attrConstruct _ = constructDBusObjectManagerClientName

-- VVV Prop "name-owner"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]

getDBusObjectManagerClientNameOwner :: (MonadIO m, DBusObjectManagerClientK o) => o -> m T.Text
getDBusObjectManagerClientNameOwner obj = liftIO $ getObjectPropertyString obj "name-owner"

data DBusObjectManagerClientNameOwnerPropertyInfo
instance AttrInfo DBusObjectManagerClientNameOwnerPropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientNameOwnerPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint DBusObjectManagerClientNameOwnerPropertyInfo = (~) ()
    type AttrBaseTypeConstraint DBusObjectManagerClientNameOwnerPropertyInfo = DBusObjectManagerClientK
    type AttrGetType DBusObjectManagerClientNameOwnerPropertyInfo = T.Text
    type AttrLabel DBusObjectManagerClientNameOwnerPropertyInfo = "DBusObjectManagerClient::name-owner"
    attrGet _ = getDBusObjectManagerClientNameOwner
    attrSet _ = undefined
    attrConstruct _ = undefined

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

getDBusObjectManagerClientObjectPath :: (MonadIO m, DBusObjectManagerClientK o) => o -> m T.Text
getDBusObjectManagerClientObjectPath obj = liftIO $ getObjectPropertyString obj "object-path"

constructDBusObjectManagerClientObjectPath :: T.Text -> IO ([Char], GValue)
constructDBusObjectManagerClientObjectPath val = constructObjectPropertyString "object-path" val

data DBusObjectManagerClientObjectPathPropertyInfo
instance AttrInfo DBusObjectManagerClientObjectPathPropertyInfo where
    type AttrAllowedOps DBusObjectManagerClientObjectPathPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DBusObjectManagerClientObjectPathPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DBusObjectManagerClientObjectPathPropertyInfo = DBusObjectManagerClientK
    type AttrGetType DBusObjectManagerClientObjectPathPropertyInfo = T.Text
    type AttrLabel DBusObjectManagerClientObjectPathPropertyInfo = "DBusObjectManagerClient::object-path"
    attrGet _ = getDBusObjectManagerClientObjectPath
    attrSet _ = undefined
    attrConstruct _ = constructDBusObjectManagerClientObjectPath

type instance AttributeList DBusObjectManagerClient = DBusObjectManagerClientAttributeList
type DBusObjectManagerClientAttributeList = ('[ '("bus-type", DBusObjectManagerClientBusTypePropertyInfo), '("connection", DBusObjectManagerClientConnectionPropertyInfo), '("flags", DBusObjectManagerClientFlagsPropertyInfo), '("get-proxy-type-destroy-notify", DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo), '("get-proxy-type-func", DBusObjectManagerClientGetProxyTypeFuncPropertyInfo), '("get-proxy-type-user-data", DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo), '("name", DBusObjectManagerClientNamePropertyInfo), '("name-owner", DBusObjectManagerClientNameOwnerPropertyInfo), '("object-path", DBusObjectManagerClientObjectPathPropertyInfo)] :: [(Symbol, *)])

data DBusObjectManagerClientInterfaceProxyPropertiesChangedSignalInfo
instance SignalInfo DBusObjectManagerClientInterfaceProxyPropertiesChangedSignalInfo where
    type HaskellCallbackType DBusObjectManagerClientInterfaceProxyPropertiesChangedSignalInfo = DBusObjectManagerClientInterfaceProxyPropertiesChangedCallback
    connectSignal _ = connectDBusObjectManagerClientInterfaceProxyPropertiesChanged

data DBusObjectManagerClientInterfaceProxySignalSignalInfo
instance SignalInfo DBusObjectManagerClientInterfaceProxySignalSignalInfo where
    type HaskellCallbackType DBusObjectManagerClientInterfaceProxySignalSignalInfo = DBusObjectManagerClientInterfaceProxySignalCallback
    connectSignal _ = connectDBusObjectManagerClientInterfaceProxySignal

type instance SignalList DBusObjectManagerClient = DBusObjectManagerClientSignalList
type DBusObjectManagerClientSignalList = ('[ '("interface-added", DBusObjectManagerInterfaceAddedSignalInfo), '("interface-proxy-properties-changed", DBusObjectManagerClientInterfaceProxyPropertiesChangedSignalInfo), '("interface-proxy-signal", DBusObjectManagerClientInterfaceProxySignalSignalInfo), '("interface-removed", DBusObjectManagerInterfaceRemovedSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("object-added", DBusObjectManagerObjectAddedSignalInfo), '("object-removed", DBusObjectManagerObjectRemovedSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method DBusObjectManagerClient::new_finish
-- method type : Constructor
-- Args : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "DBusObjectManagerClient"
-- throws : True
-- Skip return : False

foreign import ccall "g_dbus_object_manager_client_new_finish" g_dbus_object_manager_client_new_finish :: 
    Ptr AsyncResult ->                      -- res : TInterface "Gio" "AsyncResult"
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr DBusObjectManagerClient)


dBusObjectManagerClientNewFinish ::
    (MonadIO m, AsyncResultK a) =>
    a ->                                    -- res
    m DBusObjectManagerClient
dBusObjectManagerClientNewFinish res = liftIO $ do
    let res' = unsafeManagedPtrCastPtr res
    onException (do
        result <- propagateGError $ g_dbus_object_manager_client_new_finish res'
        checkUnexpectedReturnNULL "g_dbus_object_manager_client_new_finish" result
        result' <- (wrapObject DBusObjectManagerClient) result
        touchManagedPtr res
        return result'
     ) (do
        return ()
     )

-- method DBusObjectManagerClient::new_for_bus_finish
-- method type : Constructor
-- Args : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "res", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "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 AsyncResult ->                      -- res : TInterface "Gio" "AsyncResult"
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr DBusObjectManagerClient)


dBusObjectManagerClientNewForBusFinish ::
    (MonadIO m, AsyncResultK a) =>
    a ->                                    -- res
    m DBusObjectManagerClient
dBusObjectManagerClientNewForBusFinish res = liftIO $ do
    let res' = unsafeManagedPtrCastPtr res
    onException (do
        result <- propagateGError $ g_dbus_object_manager_client_new_for_bus_finish res'
        checkUnexpectedReturnNULL "g_dbus_object_manager_client_new_for_bus_finish" result
        result' <- (wrapObject DBusObjectManagerClient) result
        touchManagedPtr res
        return result'
     ) (do
        return ()
     )

-- method DBusObjectManagerClient::new_for_bus_sync
-- method type : Constructor
-- Args : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "get_proxy_type_user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_destroy_notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "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 :: 
    CUInt ->                                -- bus_type : TInterface "Gio" "BusType"
    CUInt ->                                -- flags : TInterface "Gio" "DBusObjectManagerClientFlags"
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- object_path : TBasicType TUTF8
    FunPtr DBusProxyTypeFuncC ->            -- get_proxy_type_func : TInterface "Gio" "DBusProxyTypeFunc"
    Ptr () ->                               -- get_proxy_type_user_data : TBasicType TVoid
    FunPtr GLib.DestroyNotifyC ->           -- get_proxy_type_destroy_notify : TInterface "GLib" "DestroyNotify"
    Ptr Cancellable ->                      -- cancellable : TInterface "Gio" "Cancellable"
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr DBusObjectManagerClient)


dBusObjectManagerClientNewForBusSync ::
    (MonadIO m, CancellableK a) =>
    BusType ->                              -- bus_type
    [DBusObjectManagerClientFlags] ->       -- flags
    T.Text ->                               -- name
    T.Text ->                               -- object_path
    Maybe (DBusProxyTypeFunc) ->            -- get_proxy_type_func
    Maybe (a) ->                            -- cancellable
    m DBusObjectManagerClient
dBusObjectManagerClientNewForBusSync bus_type flags name object_path get_proxy_type_func_ cancellable = liftIO $ do
    let bus_type' = (fromIntegral . fromEnum) bus_type
    let flags' = gflagsToWord flags
    name' <- textToCString name
    object_path' <- textToCString object_path
    maybeGet_proxy_type_func_ <- case get_proxy_type_func_ of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jGet_proxy_type_func_ -> do
            jGet_proxy_type_func_' <- mkDBusProxyTypeFunc (dBusProxyTypeFuncWrapper Nothing jGet_proxy_type_func_)
            return jGet_proxy_type_func_'
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    let get_proxy_type_user_data_ = castFunPtrToPtr maybeGet_proxy_type_func_
    let get_proxy_type_destroy_notify_ = safeFreeFunPtrPtr
    onException (do
        result <- propagateGError $ g_dbus_object_manager_client_new_for_bus_sync bus_type' flags' name' object_path' maybeGet_proxy_type_func_ get_proxy_type_user_data_ get_proxy_type_destroy_notify_ maybeCancellable
        checkUnexpectedReturnNULL "g_dbus_object_manager_client_new_for_bus_sync" result
        result' <- (wrapObject DBusObjectManagerClient) result
        whenJust cancellable touchManagedPtr
        freeMem name'
        freeMem object_path'
        return result'
     ) (do
        freeMem name'
        freeMem object_path'
     )

-- method DBusObjectManagerClient::new_sync
-- method type : Constructor
-- Args : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "get_proxy_type_user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_destroy_notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "DBusObjectManagerClient"
-- throws : True
-- Skip return : False

foreign import ccall "g_dbus_object_manager_client_new_sync" g_dbus_object_manager_client_new_sync :: 
    Ptr DBusConnection ->                   -- connection : TInterface "Gio" "DBusConnection"
    CUInt ->                                -- flags : TInterface "Gio" "DBusObjectManagerClientFlags"
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- object_path : TBasicType TUTF8
    FunPtr DBusProxyTypeFuncC ->            -- get_proxy_type_func : TInterface "Gio" "DBusProxyTypeFunc"
    Ptr () ->                               -- get_proxy_type_user_data : TBasicType TVoid
    FunPtr GLib.DestroyNotifyC ->           -- get_proxy_type_destroy_notify : TInterface "GLib" "DestroyNotify"
    Ptr Cancellable ->                      -- cancellable : TInterface "Gio" "Cancellable"
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr DBusObjectManagerClient)


dBusObjectManagerClientNewSync ::
    (MonadIO m, DBusConnectionK a, CancellableK b) =>
    a ->                                    -- connection
    [DBusObjectManagerClientFlags] ->       -- flags
    Maybe (T.Text) ->                       -- name
    T.Text ->                               -- object_path
    Maybe (DBusProxyTypeFunc) ->            -- get_proxy_type_func
    Maybe (b) ->                            -- cancellable
    m DBusObjectManagerClient
dBusObjectManagerClientNewSync connection flags name object_path get_proxy_type_func_ cancellable = liftIO $ do
    let connection' = unsafeManagedPtrCastPtr connection
    let flags' = gflagsToWord flags
    maybeName <- case name of
        Nothing -> return nullPtr
        Just jName -> do
            jName' <- textToCString jName
            return jName'
    object_path' <- textToCString object_path
    maybeGet_proxy_type_func_ <- case get_proxy_type_func_ of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jGet_proxy_type_func_ -> do
            jGet_proxy_type_func_' <- mkDBusProxyTypeFunc (dBusProxyTypeFuncWrapper Nothing jGet_proxy_type_func_)
            return jGet_proxy_type_func_'
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    let get_proxy_type_user_data_ = castFunPtrToPtr maybeGet_proxy_type_func_
    let get_proxy_type_destroy_notify_ = safeFreeFunPtrPtr
    onException (do
        result <- propagateGError $ g_dbus_object_manager_client_new_sync connection' flags' maybeName object_path' maybeGet_proxy_type_func_ get_proxy_type_user_data_ get_proxy_type_destroy_notify_ maybeCancellable
        checkUnexpectedReturnNULL "g_dbus_object_manager_client_new_sync" result
        result' <- (wrapObject DBusObjectManagerClient) result
        touchManagedPtr connection
        whenJust cancellable touchManagedPtr
        freeMem maybeName
        freeMem object_path'
        return result'
     ) (do
        freeMem maybeName
        freeMem object_path'
     )

-- method DBusObjectManagerClient::get_connection
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "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 ->          -- _obj : TInterface "Gio" "DBusObjectManagerClient"
    IO (Ptr DBusConnection)


dBusObjectManagerClientGetConnection ::
    (MonadIO m, DBusObjectManagerClientK a) =>
    a ->                                    -- _obj
    m DBusConnection
dBusObjectManagerClientGetConnection _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_dbus_object_manager_client_get_connection _obj'
    checkUnexpectedReturnNULL "g_dbus_object_manager_client_get_connection" result
    result' <- (newObject DBusConnection) result
    touchManagedPtr _obj
    return result'

-- method DBusObjectManagerClient::get_flags
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "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 ->          -- _obj : TInterface "Gio" "DBusObjectManagerClient"
    IO CUInt


dBusObjectManagerClientGetFlags ::
    (MonadIO m, DBusObjectManagerClientK a) =>
    a ->                                    -- _obj
    m [DBusObjectManagerClientFlags]
dBusObjectManagerClientGetFlags _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_dbus_object_manager_client_get_flags _obj'
    let result' = wordToGFlags result
    touchManagedPtr _obj
    return result'

-- method DBusObjectManagerClient::get_name
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : 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 ->          -- _obj : TInterface "Gio" "DBusObjectManagerClient"
    IO CString


dBusObjectManagerClientGetName ::
    (MonadIO m, DBusObjectManagerClientK a) =>
    a ->                                    -- _obj
    m T.Text
dBusObjectManagerClientGetName _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_dbus_object_manager_client_get_name _obj'
    checkUnexpectedReturnNULL "g_dbus_object_manager_client_get_name" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'

-- method DBusObjectManagerClient::get_name_owner
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObjectManagerClient", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : 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 ->          -- _obj : TInterface "Gio" "DBusObjectManagerClient"
    IO CString


dBusObjectManagerClientGetNameOwner ::
    (MonadIO m, DBusObjectManagerClientK a) =>
    a ->                                    -- _obj
    m T.Text
dBusObjectManagerClientGetNameOwner _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_dbus_object_manager_client_get_name_owner _obj'
    checkUnexpectedReturnNULL "g_dbus_object_manager_client_get_name_owner" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    return result'

-- method DBusObjectManagerClient::new
-- method type : MemberFunction
-- Args : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "get_proxy_type_user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_destroy_notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 9, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "connection", argType = TInterface "Gio" "DBusConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 9, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_manager_client_new" g_dbus_object_manager_client_new :: 
    Ptr DBusConnection ->                   -- connection : TInterface "Gio" "DBusConnection"
    CUInt ->                                -- flags : TInterface "Gio" "DBusObjectManagerClientFlags"
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- object_path : TBasicType TUTF8
    FunPtr DBusProxyTypeFuncC ->            -- get_proxy_type_func : TInterface "Gio" "DBusProxyTypeFunc"
    Ptr () ->                               -- get_proxy_type_user_data : TBasicType TVoid
    FunPtr GLib.DestroyNotifyC ->           -- get_proxy_type_destroy_notify : TInterface "GLib" "DestroyNotify"
    Ptr Cancellable ->                      -- cancellable : TInterface "Gio" "Cancellable"
    FunPtr AsyncReadyCallbackC ->           -- callback : TInterface "Gio" "AsyncReadyCallback"
    Ptr () ->                               -- user_data : TBasicType TVoid
    IO ()


dBusObjectManagerClientNew ::
    (MonadIO m, DBusConnectionK a, CancellableK b) =>
    a ->                                    -- connection
    [DBusObjectManagerClientFlags] ->       -- flags
    T.Text ->                               -- name
    T.Text ->                               -- object_path
    Maybe (DBusProxyTypeFunc) ->            -- get_proxy_type_func
    Maybe (b) ->                            -- cancellable
    Maybe (AsyncReadyCallback) ->           -- callback
    m ()
dBusObjectManagerClientNew connection flags name object_path get_proxy_type_func_ cancellable callback = liftIO $ do
    let connection' = unsafeManagedPtrCastPtr connection
    let flags' = gflagsToWord flags
    name' <- textToCString name
    object_path' <- textToCString object_path
    maybeGet_proxy_type_func_ <- case get_proxy_type_func_ of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jGet_proxy_type_func_ -> do
            jGet_proxy_type_func_' <- mkDBusProxyTypeFunc (dBusProxyTypeFuncWrapper Nothing jGet_proxy_type_func_)
            return jGet_proxy_type_func_'
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC))
    maybeCallback <- case callback of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jCallback -> do
            jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback)
            poke ptrcallback jCallback'
            return jCallback'
    let get_proxy_type_user_data_ = castFunPtrToPtr maybeGet_proxy_type_func_
    let get_proxy_type_destroy_notify_ = safeFreeFunPtrPtr
    let user_data = nullPtr
    g_dbus_object_manager_client_new connection' flags' name' object_path' maybeGet_proxy_type_func_ get_proxy_type_user_data_ get_proxy_type_destroy_notify_ maybeCancellable maybeCallback user_data
    touchManagedPtr connection
    whenJust cancellable touchManagedPtr
    freeMem name'
    freeMem object_path'
    return ()

-- method DBusObjectManagerClient::new_for_bus
-- method type : MemberFunction
-- Args : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "get_proxy_type_user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_destroy_notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 9, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "bus_type", argType = TInterface "Gio" "BusType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "DBusObjectManagerClientFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "get_proxy_type_func", argType = TInterface "Gio" "DBusProxyTypeFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 5, argDestroy = 6, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 9, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_manager_client_new_for_bus" g_dbus_object_manager_client_new_for_bus :: 
    CUInt ->                                -- bus_type : TInterface "Gio" "BusType"
    CUInt ->                                -- flags : TInterface "Gio" "DBusObjectManagerClientFlags"
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- object_path : TBasicType TUTF8
    FunPtr DBusProxyTypeFuncC ->            -- get_proxy_type_func : TInterface "Gio" "DBusProxyTypeFunc"
    Ptr () ->                               -- get_proxy_type_user_data : TBasicType TVoid
    FunPtr GLib.DestroyNotifyC ->           -- get_proxy_type_destroy_notify : TInterface "GLib" "DestroyNotify"
    Ptr Cancellable ->                      -- cancellable : TInterface "Gio" "Cancellable"
    FunPtr AsyncReadyCallbackC ->           -- callback : TInterface "Gio" "AsyncReadyCallback"
    Ptr () ->                               -- user_data : TBasicType TVoid
    IO ()


dBusObjectManagerClientNewForBus ::
    (MonadIO m, CancellableK a) =>
    BusType ->                              -- bus_type
    [DBusObjectManagerClientFlags] ->       -- flags
    T.Text ->                               -- name
    T.Text ->                               -- object_path
    Maybe (DBusProxyTypeFunc) ->            -- get_proxy_type_func
    Maybe (a) ->                            -- cancellable
    Maybe (AsyncReadyCallback) ->           -- callback
    m ()
dBusObjectManagerClientNewForBus bus_type flags name object_path get_proxy_type_func_ cancellable callback = liftIO $ do
    let bus_type' = (fromIntegral . fromEnum) bus_type
    let flags' = gflagsToWord flags
    name' <- textToCString name
    object_path' <- textToCString object_path
    maybeGet_proxy_type_func_ <- case get_proxy_type_func_ of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jGet_proxy_type_func_ -> do
            jGet_proxy_type_func_' <- mkDBusProxyTypeFunc (dBusProxyTypeFuncWrapper Nothing jGet_proxy_type_func_)
            return jGet_proxy_type_func_'
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC))
    maybeCallback <- case callback of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jCallback -> do
            jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback)
            poke ptrcallback jCallback'
            return jCallback'
    let get_proxy_type_user_data_ = castFunPtrToPtr maybeGet_proxy_type_func_
    let get_proxy_type_destroy_notify_ = safeFreeFunPtrPtr
    let user_data = nullPtr
    g_dbus_object_manager_client_new_for_bus bus_type' flags' name' object_path' maybeGet_proxy_type_func_ get_proxy_type_user_data_ get_proxy_type_destroy_notify_ maybeCancellable maybeCallback user_data
    whenJust cancellable touchManagedPtr
    freeMem name'
    freeMem object_path'
    return ()