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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The @GDBusObjectManager@ type is the base type for service- and
-- client-side implementations of the standardized
-- <http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-objectmanager `org.freedesktop.DBus.ObjectManager`>
-- interface.
-- 
-- See t'GI.Gio.Objects.DBusObjectManagerClient.DBusObjectManagerClient' for the client-side implementation
-- and t'GI.Gio.Objects.DBusObjectManagerServer.DBusObjectManagerServer' for the service-side implementation.

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

module GI.Gio.Interfaces.DBusObjectManager
    ( 

-- * Exported types
    DBusObjectManager(..)                   ,
    IsDBusObjectManager                     ,
    toDBusObjectManager                     ,


 -- * 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"), [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
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getInterface]("GI.Gio.Interfaces.DBusObjectManager#g:method:getInterface"), [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)
    ResolveDBusObjectManagerMethod          ,
#endif

-- ** getInterface #method:getInterface#

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerGetInterfaceMethodInfo ,
#endif
    dBusObjectManagerGetInterface           ,


-- ** getObject #method:getObject#

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerGetObjectMethodInfo    ,
#endif
    dBusObjectManagerGetObject              ,


-- ** getObjectPath #method:getObjectPath#

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerGetObjectPathMethodInfo,
#endif
    dBusObjectManagerGetObjectPath          ,


-- ** getObjects #method:getObjects#

#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerGetObjectsMethodInfo   ,
#endif
    dBusObjectManagerGetObjects             ,




 -- * Signals


-- ** interfaceAdded #signal:interfaceAdded#

    DBusObjectManagerInterfaceAddedCallback ,
#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerInterfaceAddedSignalInfo,
#endif
    afterDBusObjectManagerInterfaceAdded    ,
    onDBusObjectManagerInterfaceAdded       ,


-- ** interfaceRemoved #signal:interfaceRemoved#

    DBusObjectManagerInterfaceRemovedCallback,
#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerInterfaceRemovedSignalInfo,
#endif
    afterDBusObjectManagerInterfaceRemoved  ,
    onDBusObjectManagerInterfaceRemoved     ,


-- ** objectAdded #signal:objectAdded#

    DBusObjectManagerObjectAddedCallback    ,
#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerObjectAddedSignalInfo  ,
#endif
    afterDBusObjectManagerObjectAdded       ,
    onDBusObjectManagerObjectAdded          ,


-- ** objectRemoved #signal:objectRemoved#

    DBusObjectManagerObjectRemovedCallback  ,
#if defined(ENABLE_OVERLOADING)
    DBusObjectManagerObjectRemovedSignalInfo,
#endif
    afterDBusObjectManagerObjectRemoved     ,
    onDBusObjectManagerObjectRemoved        ,




    ) 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.Structs.String as GLib.String
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Flags as Gio.Flags
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.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

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Interfaces.DBusInterface as Gio.DBusInterface
import {-# SOURCE #-} qualified GI.Gio.Interfaces.DBusObject as Gio.DBusObject

#endif

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

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

foreign import ccall "g_dbus_object_manager_get_type"
    c_g_dbus_object_manager_get_type :: IO B.Types.GType

instance B.Types.TypedObject DBusObjectManager where
    glibType :: IO GType
glibType = IO GType
c_g_dbus_object_manager_get_type

instance B.Types.GObject DBusObjectManager

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

instance O.HasParentTypes DBusObjectManager
type instance O.ParentTypes DBusObjectManager = '[GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DBusObjectManager
type instance O.AttributeList DBusObjectManager = DBusObjectManagerAttributeList
type DBusObjectManagerAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDBusObjectManagerMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveDBusObjectManagerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDBusObjectManagerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDBusObjectManagerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDBusObjectManagerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDBusObjectManagerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDBusObjectManagerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDBusObjectManagerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDBusObjectManagerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDBusObjectManagerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDBusObjectManagerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDBusObjectManagerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDBusObjectManagerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDBusObjectManagerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDBusObjectManagerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDBusObjectManagerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDBusObjectManagerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDBusObjectManagerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDBusObjectManagerMethod "getInterface" o = DBusObjectManagerGetInterfaceMethodInfo
    ResolveDBusObjectManagerMethod "getObject" o = DBusObjectManagerGetObjectMethodInfo
    ResolveDBusObjectManagerMethod "getObjectPath" o = DBusObjectManagerGetObjectPathMethodInfo
    ResolveDBusObjectManagerMethod "getObjects" o = DBusObjectManagerGetObjectsMethodInfo
    ResolveDBusObjectManagerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDBusObjectManagerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDBusObjectManagerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDBusObjectManagerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDBusObjectManagerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDBusObjectManagerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- method DBusObjectManager::get_interface
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusObjectManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusObjectManager."
--                 , 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 "Object path to look up."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interface_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "D-Bus interface name to look up."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "DBusInterface" })
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_manager_get_interface" g_dbus_object_manager_get_interface :: 
    Ptr DBusObjectManager ->                -- manager : TInterface (Name {namespace = "Gio", name = "DBusObjectManager"})
    CString ->                              -- object_path : TBasicType TUTF8
    CString ->                              -- interface_name : TBasicType TUTF8
    IO (Ptr Gio.DBusInterface.DBusInterface)

-- | Gets the interface proxy for /@interfaceName@/ at /@objectPath@/, if
-- any.
-- 
-- /Since: 2.30/
dBusObjectManagerGetInterface ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusObjectManager a) =>
    a
    -- ^ /@manager@/: A t'GI.Gio.Interfaces.DBusObjectManager.DBusObjectManager'.
    -> T.Text
    -- ^ /@objectPath@/: Object path to look up.
    -> T.Text
    -- ^ /@interfaceName@/: D-Bus interface name to look up.
    -> m (Maybe Gio.DBusInterface.DBusInterface)
    -- ^ __Returns:__ A t'GI.Gio.Interfaces.DBusInterface.DBusInterface' instance or 'P.Nothing'. Free
    --   with 'GI.GObject.Objects.Object.objectUnref'.
dBusObjectManagerGetInterface :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusObjectManager a) =>
a -> Text -> Text -> m (Maybe DBusInterface)
dBusObjectManagerGetInterface a
manager Text
objectPath Text
interfaceName = IO (Maybe DBusInterface) -> m (Maybe DBusInterface)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DBusInterface) -> m (Maybe DBusInterface))
-> IO (Maybe DBusInterface) -> m (Maybe DBusInterface)
forall a b. (a -> b) -> a -> b
$ do
    manager' <- a -> IO (Ptr DBusObjectManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    objectPath' <- textToCString objectPath
    interfaceName' <- textToCString interfaceName
    result <- g_dbus_object_manager_get_interface manager' objectPath' interfaceName'
    maybeResult <- convertIfNonNull result $ \Ptr DBusInterface
result' -> do
        result'' <- ((ManagedPtr DBusInterface -> DBusInterface)
-> Ptr DBusInterface -> IO DBusInterface
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DBusInterface -> DBusInterface
Gio.DBusInterface.DBusInterface) Ptr DBusInterface
result'
        return result''
    touchManagedPtr manager
    freeMem objectPath'
    freeMem interfaceName'
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerGetInterfaceMethodInfo
instance (signature ~ (T.Text -> T.Text -> m (Maybe Gio.DBusInterface.DBusInterface)), MonadIO m, IsDBusObjectManager a) => O.OverloadedMethod DBusObjectManagerGetInterfaceMethodInfo a signature where
    overloadedMethod = dBusObjectManagerGetInterface

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


#endif

-- method DBusObjectManager::get_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusObjectManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusObjectManager."
--                 , 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 "Object path to look up."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "DBusObject" })
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_manager_get_object" g_dbus_object_manager_get_object :: 
    Ptr DBusObjectManager ->                -- manager : TInterface (Name {namespace = "Gio", name = "DBusObjectManager"})
    CString ->                              -- object_path : TBasicType TUTF8
    IO (Ptr Gio.DBusObject.DBusObject)

-- | Gets the t'GI.Gio.Interfaces.DBusObject.DBusObject' at /@objectPath@/, if any.
-- 
-- /Since: 2.30/
dBusObjectManagerGetObject ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusObjectManager a) =>
    a
    -- ^ /@manager@/: A t'GI.Gio.Interfaces.DBusObjectManager.DBusObjectManager'.
    -> T.Text
    -- ^ /@objectPath@/: Object path to look up.
    -> m (Maybe Gio.DBusObject.DBusObject)
    -- ^ __Returns:__ A t'GI.Gio.Interfaces.DBusObject.DBusObject' or 'P.Nothing'. Free with
    --   'GI.GObject.Objects.Object.objectUnref'.
dBusObjectManagerGetObject :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusObjectManager a) =>
a -> Text -> m (Maybe DBusObject)
dBusObjectManagerGetObject a
manager Text
objectPath = IO (Maybe DBusObject) -> m (Maybe DBusObject)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DBusObject) -> m (Maybe DBusObject))
-> IO (Maybe DBusObject) -> m (Maybe DBusObject)
forall a b. (a -> b) -> a -> b
$ do
    manager' <- a -> IO (Ptr DBusObjectManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    objectPath' <- textToCString objectPath
    result <- g_dbus_object_manager_get_object manager' objectPath'
    maybeResult <- convertIfNonNull result $ \Ptr DBusObject
result' -> do
        result'' <- ((ManagedPtr DBusObject -> DBusObject)
-> Ptr DBusObject -> IO DBusObject
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DBusObject -> DBusObject
Gio.DBusObject.DBusObject) Ptr DBusObject
result'
        return result''
    touchManagedPtr manager
    freeMem objectPath'
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerGetObjectMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gio.DBusObject.DBusObject)), MonadIO m, IsDBusObjectManager a) => O.OverloadedMethod DBusObjectManagerGetObjectMethodInfo a signature where
    overloadedMethod = dBusObjectManagerGetObject

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


#endif

-- method DBusObjectManager::get_object_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusObjectManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusObjectManager."
--                 , 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_get_object_path" g_dbus_object_manager_get_object_path :: 
    Ptr DBusObjectManager ->                -- manager : TInterface (Name {namespace = "Gio", name = "DBusObjectManager"})
    IO CString

-- | Gets the object path that /@manager@/ is for.
-- 
-- /Since: 2.30/
dBusObjectManagerGetObjectPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusObjectManager a) =>
    a
    -- ^ /@manager@/: A t'GI.Gio.Interfaces.DBusObjectManager.DBusObjectManager'.
    -> m T.Text
    -- ^ __Returns:__ A string owned by /@manager@/. Do not free.
dBusObjectManagerGetObjectPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusObjectManager a) =>
a -> m Text
dBusObjectManagerGetObjectPath 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 DBusObjectManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    result <- g_dbus_object_manager_get_object_path manager'
    checkUnexpectedReturnNULL "dBusObjectManagerGetObjectPath" result
    result' <- cstringToText result
    touchManagedPtr manager
    return result'

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerGetObjectPathMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDBusObjectManager a) => O.OverloadedMethod DBusObjectManagerGetObjectPathMethodInfo a signature where
    overloadedMethod = dBusObjectManagerGetObjectPath

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


#endif

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

foreign import ccall "g_dbus_object_manager_get_objects" g_dbus_object_manager_get_objects :: 
    Ptr DBusObjectManager ->                -- manager : TInterface (Name {namespace = "Gio", name = "DBusObjectManager"})
    IO (Ptr (GList (Ptr Gio.DBusObject.DBusObject)))

-- | Gets all t'GI.Gio.Interfaces.DBusObject.DBusObject' objects known to /@manager@/.
-- 
-- /Since: 2.30/
dBusObjectManagerGetObjects ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusObjectManager a) =>
    a
    -- ^ /@manager@/: A t'GI.Gio.Interfaces.DBusObjectManager.DBusObjectManager'.
    -> m [Gio.DBusObject.DBusObject]
    -- ^ __Returns:__ A list of
    --   t'GI.Gio.Interfaces.DBusObject.DBusObject' objects. The returned list should be freed with
    --   @/g_list_free()/@ after each element has been freed with
    --   'GI.GObject.Objects.Object.objectUnref'.
dBusObjectManagerGetObjects :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusObjectManager a) =>
a -> m [DBusObject]
dBusObjectManagerGetObjects a
manager = IO [DBusObject] -> m [DBusObject]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DBusObject] -> m [DBusObject])
-> IO [DBusObject] -> m [DBusObject]
forall a b. (a -> b) -> a -> b
$ do
    manager' <- a -> IO (Ptr DBusObjectManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    result <- g_dbus_object_manager_get_objects manager'
    result' <- unpackGList result
    result'' <- mapM (wrapObject Gio.DBusObject.DBusObject) result'
    g_list_free result
    touchManagedPtr manager
    return result''

#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerGetObjectsMethodInfo
instance (signature ~ (m [Gio.DBusObject.DBusObject]), MonadIO m, IsDBusObjectManager a) => O.OverloadedMethod DBusObjectManagerGetObjectsMethodInfo a signature where
    overloadedMethod = dBusObjectManagerGetObjects

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


#endif

-- signal DBusObjectManager::interface-added
-- | Emitted when /@interface@/ is added to /@object@/.
-- 
-- This signal exists purely as a convenience to avoid having to
-- connect signals to all objects managed by /@manager@/.
-- 
-- /Since: 2.30/
type DBusObjectManagerInterfaceAddedCallback =
    Gio.DBusObject.DBusObject
    -- ^ /@object@/: The t'GI.Gio.Interfaces.DBusObject.DBusObject' on which an interface was added.
    -> Gio.DBusInterface.DBusInterface
    -- ^ /@interface@/: The t'GI.Gio.Interfaces.DBusInterface.DBusInterface' that was added.
    -> IO ()

type C_DBusObjectManagerInterfaceAddedCallback =
    Ptr DBusObjectManager ->                -- object
    Ptr Gio.DBusObject.DBusObject ->
    Ptr Gio.DBusInterface.DBusInterface ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_DBusObjectManagerInterfaceAddedCallback :: 
    GObject a => (a -> DBusObjectManagerInterfaceAddedCallback) ->
    C_DBusObjectManagerInterfaceAddedCallback
wrap_DBusObjectManagerInterfaceAddedCallback :: forall a.
GObject a =>
(a -> DBusObjectManagerInterfaceAddedCallback)
-> C_DBusObjectManagerInterfaceAddedCallback
wrap_DBusObjectManagerInterfaceAddedCallback a -> DBusObjectManagerInterfaceAddedCallback
gi'cb Ptr DBusObjectManager
gi'selfPtr Ptr DBusObject
object Ptr DBusInterface
interface Ptr ()
_ = do
    object' <- ((ManagedPtr DBusObject -> DBusObject)
-> Ptr DBusObject -> IO DBusObject
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DBusObject -> DBusObject
Gio.DBusObject.DBusObject) Ptr DBusObject
object
    interface' <- (newObject Gio.DBusInterface.DBusInterface) interface
    B.ManagedPtr.withNewObject gi'selfPtr $ \DBusObjectManager
gi'self -> a -> DBusObjectManagerInterfaceAddedCallback
gi'cb (DBusObjectManager -> a
forall a b. Coercible a b => a -> b
Coerce.coerce DBusObjectManager
gi'self)  DBusObject
object' DBusInterface
interface'


-- | Connect a signal handler for the [interfaceAdded](#signal:interfaceAdded) 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' dBusObjectManager #interfaceAdded callback
-- @
-- 
-- 
onDBusObjectManagerInterfaceAdded :: (IsDBusObjectManager a, MonadIO m) => a -> ((?self :: a) => DBusObjectManagerInterfaceAddedCallback) -> m SignalHandlerId
onDBusObjectManagerInterfaceAdded :: forall a (m :: * -> *).
(IsDBusObjectManager a, MonadIO m) =>
a
-> ((?self::a) => DBusObjectManagerInterfaceAddedCallback)
-> m SignalHandlerId
onDBusObjectManagerInterfaceAdded a
obj (?self::a) => DBusObjectManagerInterfaceAddedCallback
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 -> DBusObjectManagerInterfaceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusObjectManagerInterfaceAddedCallback
DBusObjectManagerInterfaceAddedCallback
cb
    let wrapped' :: C_DBusObjectManagerInterfaceAddedCallback
wrapped' = (a -> DBusObjectManagerInterfaceAddedCallback)
-> C_DBusObjectManagerInterfaceAddedCallback
forall a.
GObject a =>
(a -> DBusObjectManagerInterfaceAddedCallback)
-> C_DBusObjectManagerInterfaceAddedCallback
wrap_DBusObjectManagerInterfaceAddedCallback a -> DBusObjectManagerInterfaceAddedCallback
wrapped
    wrapped'' <- C_DBusObjectManagerInterfaceAddedCallback
-> IO (FunPtr C_DBusObjectManagerInterfaceAddedCallback)
mk_DBusObjectManagerInterfaceAddedCallback C_DBusObjectManagerInterfaceAddedCallback
wrapped'
    connectSignalFunPtr obj "interface-added" wrapped'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [interfaceAdded](#signal:interfaceAdded) 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' dBusObjectManager #interfaceAdded 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.
-- 
afterDBusObjectManagerInterfaceAdded :: (IsDBusObjectManager a, MonadIO m) => a -> ((?self :: a) => DBusObjectManagerInterfaceAddedCallback) -> m SignalHandlerId
afterDBusObjectManagerInterfaceAdded :: forall a (m :: * -> *).
(IsDBusObjectManager a, MonadIO m) =>
a
-> ((?self::a) => DBusObjectManagerInterfaceAddedCallback)
-> m SignalHandlerId
afterDBusObjectManagerInterfaceAdded a
obj (?self::a) => DBusObjectManagerInterfaceAddedCallback
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 -> DBusObjectManagerInterfaceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusObjectManagerInterfaceAddedCallback
DBusObjectManagerInterfaceAddedCallback
cb
    let wrapped' :: C_DBusObjectManagerInterfaceAddedCallback
wrapped' = (a -> DBusObjectManagerInterfaceAddedCallback)
-> C_DBusObjectManagerInterfaceAddedCallback
forall a.
GObject a =>
(a -> DBusObjectManagerInterfaceAddedCallback)
-> C_DBusObjectManagerInterfaceAddedCallback
wrap_DBusObjectManagerInterfaceAddedCallback a -> DBusObjectManagerInterfaceAddedCallback
wrapped
    wrapped'' <- C_DBusObjectManagerInterfaceAddedCallback
-> IO (FunPtr C_DBusObjectManagerInterfaceAddedCallback)
mk_DBusObjectManagerInterfaceAddedCallback C_DBusObjectManagerInterfaceAddedCallback
wrapped'
    connectSignalFunPtr obj "interface-added" wrapped'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerInterfaceAddedSignalInfo
instance SignalInfo DBusObjectManagerInterfaceAddedSignalInfo where
    type HaskellCallbackType DBusObjectManagerInterfaceAddedSignalInfo = DBusObjectManagerInterfaceAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DBusObjectManagerInterfaceAddedCallback cb
        cb'' <- mk_DBusObjectManagerInterfaceAddedCallback cb'
        connectSignalFunPtr obj "interface-added" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.DBusObjectManager::interface-added"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Interfaces-DBusObjectManager.html#g:signal:interfaceAdded"})

#endif

-- signal DBusObjectManager::interface-removed
-- | Emitted when /@interface@/ has been removed from /@object@/.
-- 
-- This signal exists purely as a convenience to avoid having to
-- connect signals to all objects managed by /@manager@/.
-- 
-- /Since: 2.30/
type DBusObjectManagerInterfaceRemovedCallback =
    Gio.DBusObject.DBusObject
    -- ^ /@object@/: The t'GI.Gio.Interfaces.DBusObject.DBusObject' on which an interface was removed.
    -> Gio.DBusInterface.DBusInterface
    -- ^ /@interface@/: The t'GI.Gio.Interfaces.DBusInterface.DBusInterface' that was removed.
    -> IO ()

type C_DBusObjectManagerInterfaceRemovedCallback =
    Ptr DBusObjectManager ->                -- object
    Ptr Gio.DBusObject.DBusObject ->
    Ptr Gio.DBusInterface.DBusInterface ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_DBusObjectManagerInterfaceRemovedCallback :: 
    GObject a => (a -> DBusObjectManagerInterfaceRemovedCallback) ->
    C_DBusObjectManagerInterfaceRemovedCallback
wrap_DBusObjectManagerInterfaceRemovedCallback :: forall a.
GObject a =>
(a -> DBusObjectManagerInterfaceAddedCallback)
-> C_DBusObjectManagerInterfaceAddedCallback
wrap_DBusObjectManagerInterfaceRemovedCallback a -> DBusObjectManagerInterfaceAddedCallback
gi'cb Ptr DBusObjectManager
gi'selfPtr Ptr DBusObject
object Ptr DBusInterface
interface Ptr ()
_ = do
    object' <- ((ManagedPtr DBusObject -> DBusObject)
-> Ptr DBusObject -> IO DBusObject
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DBusObject -> DBusObject
Gio.DBusObject.DBusObject) Ptr DBusObject
object
    interface' <- (newObject Gio.DBusInterface.DBusInterface) interface
    B.ManagedPtr.withNewObject gi'selfPtr $ \DBusObjectManager
gi'self -> a -> DBusObjectManagerInterfaceAddedCallback
gi'cb (DBusObjectManager -> a
forall a b. Coercible a b => a -> b
Coerce.coerce DBusObjectManager
gi'self)  DBusObject
object' DBusInterface
interface'


-- | Connect a signal handler for the [interfaceRemoved](#signal:interfaceRemoved) 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' dBusObjectManager #interfaceRemoved callback
-- @
-- 
-- 
onDBusObjectManagerInterfaceRemoved :: (IsDBusObjectManager a, MonadIO m) => a -> ((?self :: a) => DBusObjectManagerInterfaceRemovedCallback) -> m SignalHandlerId
onDBusObjectManagerInterfaceRemoved :: forall a (m :: * -> *).
(IsDBusObjectManager a, MonadIO m) =>
a
-> ((?self::a) => DBusObjectManagerInterfaceAddedCallback)
-> m SignalHandlerId
onDBusObjectManagerInterfaceRemoved a
obj (?self::a) => DBusObjectManagerInterfaceAddedCallback
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 -> DBusObjectManagerInterfaceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusObjectManagerInterfaceAddedCallback
DBusObjectManagerInterfaceAddedCallback
cb
    let wrapped' :: C_DBusObjectManagerInterfaceAddedCallback
wrapped' = (a -> DBusObjectManagerInterfaceAddedCallback)
-> C_DBusObjectManagerInterfaceAddedCallback
forall a.
GObject a =>
(a -> DBusObjectManagerInterfaceAddedCallback)
-> C_DBusObjectManagerInterfaceAddedCallback
wrap_DBusObjectManagerInterfaceRemovedCallback a -> DBusObjectManagerInterfaceAddedCallback
wrapped
    wrapped'' <- C_DBusObjectManagerInterfaceAddedCallback
-> IO (FunPtr C_DBusObjectManagerInterfaceAddedCallback)
mk_DBusObjectManagerInterfaceRemovedCallback C_DBusObjectManagerInterfaceAddedCallback
wrapped'
    connectSignalFunPtr obj "interface-removed" wrapped'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [interfaceRemoved](#signal:interfaceRemoved) 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' dBusObjectManager #interfaceRemoved 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.
-- 
afterDBusObjectManagerInterfaceRemoved :: (IsDBusObjectManager a, MonadIO m) => a -> ((?self :: a) => DBusObjectManagerInterfaceRemovedCallback) -> m SignalHandlerId
afterDBusObjectManagerInterfaceRemoved :: forall a (m :: * -> *).
(IsDBusObjectManager a, MonadIO m) =>
a
-> ((?self::a) => DBusObjectManagerInterfaceAddedCallback)
-> m SignalHandlerId
afterDBusObjectManagerInterfaceRemoved a
obj (?self::a) => DBusObjectManagerInterfaceAddedCallback
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 -> DBusObjectManagerInterfaceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusObjectManagerInterfaceAddedCallback
DBusObjectManagerInterfaceAddedCallback
cb
    let wrapped' :: C_DBusObjectManagerInterfaceAddedCallback
wrapped' = (a -> DBusObjectManagerInterfaceAddedCallback)
-> C_DBusObjectManagerInterfaceAddedCallback
forall a.
GObject a =>
(a -> DBusObjectManagerInterfaceAddedCallback)
-> C_DBusObjectManagerInterfaceAddedCallback
wrap_DBusObjectManagerInterfaceRemovedCallback a -> DBusObjectManagerInterfaceAddedCallback
wrapped
    wrapped'' <- C_DBusObjectManagerInterfaceAddedCallback
-> IO (FunPtr C_DBusObjectManagerInterfaceAddedCallback)
mk_DBusObjectManagerInterfaceRemovedCallback C_DBusObjectManagerInterfaceAddedCallback
wrapped'
    connectSignalFunPtr obj "interface-removed" wrapped'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerInterfaceRemovedSignalInfo
instance SignalInfo DBusObjectManagerInterfaceRemovedSignalInfo where
    type HaskellCallbackType DBusObjectManagerInterfaceRemovedSignalInfo = DBusObjectManagerInterfaceRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DBusObjectManagerInterfaceRemovedCallback cb
        cb'' <- mk_DBusObjectManagerInterfaceRemovedCallback cb'
        connectSignalFunPtr obj "interface-removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.DBusObjectManager::interface-removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Interfaces-DBusObjectManager.html#g:signal:interfaceRemoved"})

#endif

-- signal DBusObjectManager::object-added
-- | Emitted when /@object@/ is added to /@manager@/.
-- 
-- /Since: 2.30/
type DBusObjectManagerObjectAddedCallback =
    Gio.DBusObject.DBusObject
    -- ^ /@object@/: The t'GI.Gio.Interfaces.DBusObject.DBusObject' that was added.
    -> IO ()

type C_DBusObjectManagerObjectAddedCallback =
    Ptr DBusObjectManager ->                -- object
    Ptr Gio.DBusObject.DBusObject ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_DBusObjectManagerObjectAddedCallback :: 
    GObject a => (a -> DBusObjectManagerObjectAddedCallback) ->
    C_DBusObjectManagerObjectAddedCallback
wrap_DBusObjectManagerObjectAddedCallback :: forall a.
GObject a =>
(a -> DBusObjectManagerObjectAddedCallback)
-> C_DBusObjectManagerObjectAddedCallback
wrap_DBusObjectManagerObjectAddedCallback a -> DBusObjectManagerObjectAddedCallback
gi'cb Ptr DBusObjectManager
gi'selfPtr Ptr DBusObject
object Ptr ()
_ = do
    object' <- ((ManagedPtr DBusObject -> DBusObject)
-> Ptr DBusObject -> IO DBusObject
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DBusObject -> DBusObject
Gio.DBusObject.DBusObject) Ptr DBusObject
object
    B.ManagedPtr.withNewObject gi'selfPtr $ \DBusObjectManager
gi'self -> a -> DBusObjectManagerObjectAddedCallback
gi'cb (DBusObjectManager -> a
forall a b. Coercible a b => a -> b
Coerce.coerce DBusObjectManager
gi'self)  DBusObject
object'


-- | Connect a signal handler for the [objectAdded](#signal:objectAdded) 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' dBusObjectManager #objectAdded callback
-- @
-- 
-- 
onDBusObjectManagerObjectAdded :: (IsDBusObjectManager a, MonadIO m) => a -> ((?self :: a) => DBusObjectManagerObjectAddedCallback) -> m SignalHandlerId
onDBusObjectManagerObjectAdded :: forall a (m :: * -> *).
(IsDBusObjectManager a, MonadIO m) =>
a
-> ((?self::a) => DBusObjectManagerObjectAddedCallback)
-> m SignalHandlerId
onDBusObjectManagerObjectAdded a
obj (?self::a) => DBusObjectManagerObjectAddedCallback
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 -> DBusObjectManagerObjectAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusObjectManagerObjectAddedCallback
DBusObjectManagerObjectAddedCallback
cb
    let wrapped' :: C_DBusObjectManagerObjectAddedCallback
wrapped' = (a -> DBusObjectManagerObjectAddedCallback)
-> C_DBusObjectManagerObjectAddedCallback
forall a.
GObject a =>
(a -> DBusObjectManagerObjectAddedCallback)
-> C_DBusObjectManagerObjectAddedCallback
wrap_DBusObjectManagerObjectAddedCallback a -> DBusObjectManagerObjectAddedCallback
wrapped
    wrapped'' <- C_DBusObjectManagerObjectAddedCallback
-> IO (FunPtr C_DBusObjectManagerObjectAddedCallback)
mk_DBusObjectManagerObjectAddedCallback C_DBusObjectManagerObjectAddedCallback
wrapped'
    connectSignalFunPtr obj "object-added" wrapped'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [objectAdded](#signal:objectAdded) 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' dBusObjectManager #objectAdded 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.
-- 
afterDBusObjectManagerObjectAdded :: (IsDBusObjectManager a, MonadIO m) => a -> ((?self :: a) => DBusObjectManagerObjectAddedCallback) -> m SignalHandlerId
afterDBusObjectManagerObjectAdded :: forall a (m :: * -> *).
(IsDBusObjectManager a, MonadIO m) =>
a
-> ((?self::a) => DBusObjectManagerObjectAddedCallback)
-> m SignalHandlerId
afterDBusObjectManagerObjectAdded a
obj (?self::a) => DBusObjectManagerObjectAddedCallback
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 -> DBusObjectManagerObjectAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusObjectManagerObjectAddedCallback
DBusObjectManagerObjectAddedCallback
cb
    let wrapped' :: C_DBusObjectManagerObjectAddedCallback
wrapped' = (a -> DBusObjectManagerObjectAddedCallback)
-> C_DBusObjectManagerObjectAddedCallback
forall a.
GObject a =>
(a -> DBusObjectManagerObjectAddedCallback)
-> C_DBusObjectManagerObjectAddedCallback
wrap_DBusObjectManagerObjectAddedCallback a -> DBusObjectManagerObjectAddedCallback
wrapped
    wrapped'' <- C_DBusObjectManagerObjectAddedCallback
-> IO (FunPtr C_DBusObjectManagerObjectAddedCallback)
mk_DBusObjectManagerObjectAddedCallback C_DBusObjectManagerObjectAddedCallback
wrapped'
    connectSignalFunPtr obj "object-added" wrapped'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerObjectAddedSignalInfo
instance SignalInfo DBusObjectManagerObjectAddedSignalInfo where
    type HaskellCallbackType DBusObjectManagerObjectAddedSignalInfo = DBusObjectManagerObjectAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DBusObjectManagerObjectAddedCallback cb
        cb'' <- mk_DBusObjectManagerObjectAddedCallback cb'
        connectSignalFunPtr obj "object-added" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.DBusObjectManager::object-added"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Interfaces-DBusObjectManager.html#g:signal:objectAdded"})

#endif

-- signal DBusObjectManager::object-removed
-- | Emitted when /@object@/ is removed from /@manager@/.
-- 
-- /Since: 2.30/
type DBusObjectManagerObjectRemovedCallback =
    Gio.DBusObject.DBusObject
    -- ^ /@object@/: The t'GI.Gio.Interfaces.DBusObject.DBusObject' that was removed.
    -> IO ()

type C_DBusObjectManagerObjectRemovedCallback =
    Ptr DBusObjectManager ->                -- object
    Ptr Gio.DBusObject.DBusObject ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_DBusObjectManagerObjectRemovedCallback :: 
    GObject a => (a -> DBusObjectManagerObjectRemovedCallback) ->
    C_DBusObjectManagerObjectRemovedCallback
wrap_DBusObjectManagerObjectRemovedCallback :: forall a.
GObject a =>
(a -> DBusObjectManagerObjectAddedCallback)
-> C_DBusObjectManagerObjectAddedCallback
wrap_DBusObjectManagerObjectRemovedCallback a -> DBusObjectManagerObjectAddedCallback
gi'cb Ptr DBusObjectManager
gi'selfPtr Ptr DBusObject
object Ptr ()
_ = do
    object' <- ((ManagedPtr DBusObject -> DBusObject)
-> Ptr DBusObject -> IO DBusObject
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DBusObject -> DBusObject
Gio.DBusObject.DBusObject) Ptr DBusObject
object
    B.ManagedPtr.withNewObject gi'selfPtr $ \DBusObjectManager
gi'self -> a -> DBusObjectManagerObjectAddedCallback
gi'cb (DBusObjectManager -> a
forall a b. Coercible a b => a -> b
Coerce.coerce DBusObjectManager
gi'self)  DBusObject
object'


-- | Connect a signal handler for the [objectRemoved](#signal:objectRemoved) 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' dBusObjectManager #objectRemoved callback
-- @
-- 
-- 
onDBusObjectManagerObjectRemoved :: (IsDBusObjectManager a, MonadIO m) => a -> ((?self :: a) => DBusObjectManagerObjectRemovedCallback) -> m SignalHandlerId
onDBusObjectManagerObjectRemoved :: forall a (m :: * -> *).
(IsDBusObjectManager a, MonadIO m) =>
a
-> ((?self::a) => DBusObjectManagerObjectAddedCallback)
-> m SignalHandlerId
onDBusObjectManagerObjectRemoved a
obj (?self::a) => DBusObjectManagerObjectAddedCallback
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 -> DBusObjectManagerObjectAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusObjectManagerObjectAddedCallback
DBusObjectManagerObjectAddedCallback
cb
    let wrapped' :: C_DBusObjectManagerObjectAddedCallback
wrapped' = (a -> DBusObjectManagerObjectAddedCallback)
-> C_DBusObjectManagerObjectAddedCallback
forall a.
GObject a =>
(a -> DBusObjectManagerObjectAddedCallback)
-> C_DBusObjectManagerObjectAddedCallback
wrap_DBusObjectManagerObjectRemovedCallback a -> DBusObjectManagerObjectAddedCallback
wrapped
    wrapped'' <- C_DBusObjectManagerObjectAddedCallback
-> IO (FunPtr C_DBusObjectManagerObjectAddedCallback)
mk_DBusObjectManagerObjectRemovedCallback C_DBusObjectManagerObjectAddedCallback
wrapped'
    connectSignalFunPtr obj "object-removed" wrapped'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [objectRemoved](#signal:objectRemoved) 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' dBusObjectManager #objectRemoved 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.
-- 
afterDBusObjectManagerObjectRemoved :: (IsDBusObjectManager a, MonadIO m) => a -> ((?self :: a) => DBusObjectManagerObjectRemovedCallback) -> m SignalHandlerId
afterDBusObjectManagerObjectRemoved :: forall a (m :: * -> *).
(IsDBusObjectManager a, MonadIO m) =>
a
-> ((?self::a) => DBusObjectManagerObjectAddedCallback)
-> m SignalHandlerId
afterDBusObjectManagerObjectRemoved a
obj (?self::a) => DBusObjectManagerObjectAddedCallback
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 -> DBusObjectManagerObjectAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusObjectManagerObjectAddedCallback
DBusObjectManagerObjectAddedCallback
cb
    let wrapped' :: C_DBusObjectManagerObjectAddedCallback
wrapped' = (a -> DBusObjectManagerObjectAddedCallback)
-> C_DBusObjectManagerObjectAddedCallback
forall a.
GObject a =>
(a -> DBusObjectManagerObjectAddedCallback)
-> C_DBusObjectManagerObjectAddedCallback
wrap_DBusObjectManagerObjectRemovedCallback a -> DBusObjectManagerObjectAddedCallback
wrapped
    wrapped'' <- C_DBusObjectManagerObjectAddedCallback
-> IO (FunPtr C_DBusObjectManagerObjectAddedCallback)
mk_DBusObjectManagerObjectRemovedCallback C_DBusObjectManagerObjectAddedCallback
wrapped'
    connectSignalFunPtr obj "object-removed" wrapped'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data DBusObjectManagerObjectRemovedSignalInfo
instance SignalInfo DBusObjectManagerObjectRemovedSignalInfo where
    type HaskellCallbackType DBusObjectManagerObjectRemovedSignalInfo = DBusObjectManagerObjectRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DBusObjectManagerObjectRemovedCallback cb
        cb'' <- mk_DBusObjectManagerObjectRemovedCallback cb'
        connectSignalFunPtr obj "object-removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.DBusObjectManager::object-removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Interfaces-DBusObjectManager.html#g:signal:objectRemoved"})

#endif

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

#endif