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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Gio.Objects.DBusObjectSkeleton.DBusObjectSkeleton' instance is essentially a group of D-Bus
-- interfaces. The set of exported interfaces on the object may be
-- dynamic and change at runtime.
-- 
-- This type is intended to be used with t'GI.Gio.Interfaces.DBusObjectManager.DBusObjectManager'.
-- 
-- /Since: 2.30/

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

module GI.Gio.Objects.DBusObjectSkeleton
    ( 

-- * Exported types
    DBusObjectSkeleton(..)                  ,
    IsDBusObjectSkeleton                    ,
    toDBusObjectSkeleton                    ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addInterface]("GI.Gio.Objects.DBusObjectSkeleton#g:method:addInterface"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [flush]("GI.Gio.Objects.DBusObjectSkeleton#g:method:flush"), [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"), [removeInterface]("GI.Gio.Objects.DBusObjectSkeleton#g:method:removeInterface"), [removeInterfaceByName]("GI.Gio.Objects.DBusObjectSkeleton#g:method:removeInterfaceByName"), [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.DBusObject#g:method:getInterface"), [getInterfaces]("GI.Gio.Interfaces.DBusObject#g:method:getInterfaces"), [getObjectPath]("GI.Gio.Interfaces.DBusObject#g:method:getObjectPath"), [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"), [setObjectPath]("GI.Gio.Objects.DBusObjectSkeleton#g:method:setObjectPath"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveDBusObjectSkeletonMethod         ,
#endif

-- ** addInterface #method:addInterface#

#if defined(ENABLE_OVERLOADING)
    DBusObjectSkeletonAddInterfaceMethodInfo,
#endif
    dBusObjectSkeletonAddInterface          ,


-- ** flush #method:flush#

#if defined(ENABLE_OVERLOADING)
    DBusObjectSkeletonFlushMethodInfo       ,
#endif
    dBusObjectSkeletonFlush                 ,


-- ** new #method:new#

    dBusObjectSkeletonNew                   ,


-- ** removeInterface #method:removeInterface#

#if defined(ENABLE_OVERLOADING)
    DBusObjectSkeletonRemoveInterfaceMethodInfo,
#endif
    dBusObjectSkeletonRemoveInterface       ,


-- ** removeInterfaceByName #method:removeInterfaceByName#

#if defined(ENABLE_OVERLOADING)
    DBusObjectSkeletonRemoveInterfaceByNameMethodInfo,
#endif
    dBusObjectSkeletonRemoveInterfaceByName ,


-- ** setObjectPath #method:setObjectPath#

#if defined(ENABLE_OVERLOADING)
    DBusObjectSkeletonSetObjectPathMethodInfo,
#endif
    dBusObjectSkeletonSetObjectPath         ,




 -- * Properties


-- ** gObjectPath #attr:gObjectPath#
-- | The object path where the object is exported.
-- 
-- /Since: 2.30/

#if defined(ENABLE_OVERLOADING)
    DBusObjectSkeletonGObjectPathPropertyInfo,
#endif
    clearDBusObjectSkeletonGObjectPath      ,
    constructDBusObjectSkeletonGObjectPath  ,
#if defined(ENABLE_OVERLOADING)
    dBusObjectSkeletonGObjectPath           ,
#endif
    getDBusObjectSkeletonGObjectPath        ,
    setDBusObjectSkeletonGObjectPath        ,




 -- * Signals


-- ** authorizeMethod #signal:authorizeMethod#

    DBusObjectSkeletonAuthorizeMethodCallback,
#if defined(ENABLE_OVERLOADING)
    DBusObjectSkeletonAuthorizeMethodSignalInfo,
#endif
    afterDBusObjectSkeletonAuthorizeMethod  ,
    onDBusObjectSkeletonAuthorizeMethod     ,




    ) where

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

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

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

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

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

foreign import ccall "g_dbus_object_skeleton_get_type"
    c_g_dbus_object_skeleton_get_type :: IO B.Types.GType

instance B.Types.TypedObject DBusObjectSkeleton where
    glibType :: IO GType
glibType = IO GType
c_g_dbus_object_skeleton_get_type

instance B.Types.GObject DBusObjectSkeleton

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

instance O.HasParentTypes DBusObjectSkeleton
type instance O.ParentTypes DBusObjectSkeleton = '[GObject.Object.Object, Gio.DBusObject.DBusObject]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDBusObjectSkeletonMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveDBusObjectSkeletonMethod "addInterface" o = DBusObjectSkeletonAddInterfaceMethodInfo
    ResolveDBusObjectSkeletonMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDBusObjectSkeletonMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDBusObjectSkeletonMethod "flush" o = DBusObjectSkeletonFlushMethodInfo
    ResolveDBusObjectSkeletonMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDBusObjectSkeletonMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDBusObjectSkeletonMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDBusObjectSkeletonMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDBusObjectSkeletonMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDBusObjectSkeletonMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDBusObjectSkeletonMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDBusObjectSkeletonMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDBusObjectSkeletonMethod "removeInterface" o = DBusObjectSkeletonRemoveInterfaceMethodInfo
    ResolveDBusObjectSkeletonMethod "removeInterfaceByName" o = DBusObjectSkeletonRemoveInterfaceByNameMethodInfo
    ResolveDBusObjectSkeletonMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDBusObjectSkeletonMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDBusObjectSkeletonMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDBusObjectSkeletonMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDBusObjectSkeletonMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDBusObjectSkeletonMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDBusObjectSkeletonMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDBusObjectSkeletonMethod "getInterface" o = Gio.DBusObject.DBusObjectGetInterfaceMethodInfo
    ResolveDBusObjectSkeletonMethod "getInterfaces" o = Gio.DBusObject.DBusObjectGetInterfacesMethodInfo
    ResolveDBusObjectSkeletonMethod "getObjectPath" o = Gio.DBusObject.DBusObjectGetObjectPathMethodInfo
    ResolveDBusObjectSkeletonMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDBusObjectSkeletonMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDBusObjectSkeletonMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDBusObjectSkeletonMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDBusObjectSkeletonMethod "setObjectPath" o = DBusObjectSkeletonSetObjectPathMethodInfo
    ResolveDBusObjectSkeletonMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDBusObjectSkeletonMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal DBusObjectSkeleton::authorize-method
-- | Emitted when a method is invoked by a remote caller and used to
-- determine if the method call is authorized.
-- 
-- This signal is like t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton'\'s
-- [DBusInterfaceSkeleton::gAuthorizeMethod]("GI.Gio.Objects.DBusInterfaceSkeleton#g:signal:gAuthorizeMethod") signal,
-- except that it is for the enclosing object.
-- 
-- The default class handler just returns 'P.True'.
-- 
-- /Since: 2.30/
type DBusObjectSkeletonAuthorizeMethodCallback =
    Gio.DBusInterfaceSkeleton.DBusInterfaceSkeleton
    -- ^ /@interface@/: The t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton' that /@invocation@/ is for.
    -> Gio.DBusMethodInvocation.DBusMethodInvocation
    -- ^ /@invocation@/: A t'GI.Gio.Objects.DBusMethodInvocation.DBusMethodInvocation'.
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if the call is authorized, 'P.False' otherwise.

type C_DBusObjectSkeletonAuthorizeMethodCallback =
    Ptr DBusObjectSkeleton ->               -- object
    Ptr Gio.DBusInterfaceSkeleton.DBusInterfaceSkeleton ->
    Ptr Gio.DBusMethodInvocation.DBusMethodInvocation ->
    Ptr () ->                               -- user_data
    IO CInt

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

wrap_DBusObjectSkeletonAuthorizeMethodCallback :: 
    GObject a => (a -> DBusObjectSkeletonAuthorizeMethodCallback) ->
    C_DBusObjectSkeletonAuthorizeMethodCallback
wrap_DBusObjectSkeletonAuthorizeMethodCallback :: forall a.
GObject a =>
(a -> DBusObjectSkeletonAuthorizeMethodCallback)
-> C_DBusObjectSkeletonAuthorizeMethodCallback
wrap_DBusObjectSkeletonAuthorizeMethodCallback a -> DBusObjectSkeletonAuthorizeMethodCallback
gi'cb Ptr DBusObjectSkeleton
gi'selfPtr Ptr DBusInterfaceSkeleton
interface Ptr DBusMethodInvocation
invocation Ptr ()
_ = do
    DBusInterfaceSkeleton
interface' <- ((ManagedPtr DBusInterfaceSkeleton -> DBusInterfaceSkeleton)
-> Ptr DBusInterfaceSkeleton -> IO DBusInterfaceSkeleton
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DBusInterfaceSkeleton -> DBusInterfaceSkeleton
Gio.DBusInterfaceSkeleton.DBusInterfaceSkeleton) Ptr DBusInterfaceSkeleton
interface
    DBusMethodInvocation
invocation' <- ((ManagedPtr DBusMethodInvocation -> DBusMethodInvocation)
-> Ptr DBusMethodInvocation -> IO DBusMethodInvocation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DBusMethodInvocation -> DBusMethodInvocation
Gio.DBusMethodInvocation.DBusMethodInvocation) Ptr DBusMethodInvocation
invocation
    Bool
result <- Ptr DBusObjectSkeleton
-> (DBusObjectSkeleton -> IO Bool) -> IO Bool
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr DBusObjectSkeleton
gi'selfPtr ((DBusObjectSkeleton -> IO Bool) -> IO Bool)
-> (DBusObjectSkeleton -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \DBusObjectSkeleton
gi'self -> a -> DBusObjectSkeletonAuthorizeMethodCallback
gi'cb (DBusObjectSkeleton -> a
forall a b. Coercible a b => a -> b
Coerce.coerce DBusObjectSkeleton
gi'self)  DBusInterfaceSkeleton
interface' DBusMethodInvocation
invocation'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [authorizeMethod](#signal:authorizeMethod) 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' dBusObjectSkeleton #authorizeMethod callback
-- @
-- 
-- 
onDBusObjectSkeletonAuthorizeMethod :: (IsDBusObjectSkeleton a, MonadIO m) => a -> ((?self :: a) => DBusObjectSkeletonAuthorizeMethodCallback) -> m SignalHandlerId
onDBusObjectSkeletonAuthorizeMethod :: forall a (m :: * -> *).
(IsDBusObjectSkeleton a, MonadIO m) =>
a
-> ((?self::a) => DBusObjectSkeletonAuthorizeMethodCallback)
-> m SignalHandlerId
onDBusObjectSkeletonAuthorizeMethod a
obj (?self::a) => DBusObjectSkeletonAuthorizeMethodCallback
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 -> DBusObjectSkeletonAuthorizeMethodCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusObjectSkeletonAuthorizeMethodCallback
DBusObjectSkeletonAuthorizeMethodCallback
cb
    let wrapped' :: C_DBusObjectSkeletonAuthorizeMethodCallback
wrapped' = (a -> DBusObjectSkeletonAuthorizeMethodCallback)
-> C_DBusObjectSkeletonAuthorizeMethodCallback
forall a.
GObject a =>
(a -> DBusObjectSkeletonAuthorizeMethodCallback)
-> C_DBusObjectSkeletonAuthorizeMethodCallback
wrap_DBusObjectSkeletonAuthorizeMethodCallback a -> DBusObjectSkeletonAuthorizeMethodCallback
wrapped
    FunPtr C_DBusObjectSkeletonAuthorizeMethodCallback
wrapped'' <- C_DBusObjectSkeletonAuthorizeMethodCallback
-> IO (FunPtr C_DBusObjectSkeletonAuthorizeMethodCallback)
mk_DBusObjectSkeletonAuthorizeMethodCallback C_DBusObjectSkeletonAuthorizeMethodCallback
wrapped'
    a
-> Text
-> FunPtr C_DBusObjectSkeletonAuthorizeMethodCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"authorize-method" FunPtr C_DBusObjectSkeletonAuthorizeMethodCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [authorizeMethod](#signal:authorizeMethod) 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' dBusObjectSkeleton #authorizeMethod 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.
-- 
afterDBusObjectSkeletonAuthorizeMethod :: (IsDBusObjectSkeleton a, MonadIO m) => a -> ((?self :: a) => DBusObjectSkeletonAuthorizeMethodCallback) -> m SignalHandlerId
afterDBusObjectSkeletonAuthorizeMethod :: forall a (m :: * -> *).
(IsDBusObjectSkeleton a, MonadIO m) =>
a
-> ((?self::a) => DBusObjectSkeletonAuthorizeMethodCallback)
-> m SignalHandlerId
afterDBusObjectSkeletonAuthorizeMethod a
obj (?self::a) => DBusObjectSkeletonAuthorizeMethodCallback
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 -> DBusObjectSkeletonAuthorizeMethodCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusObjectSkeletonAuthorizeMethodCallback
DBusObjectSkeletonAuthorizeMethodCallback
cb
    let wrapped' :: C_DBusObjectSkeletonAuthorizeMethodCallback
wrapped' = (a -> DBusObjectSkeletonAuthorizeMethodCallback)
-> C_DBusObjectSkeletonAuthorizeMethodCallback
forall a.
GObject a =>
(a -> DBusObjectSkeletonAuthorizeMethodCallback)
-> C_DBusObjectSkeletonAuthorizeMethodCallback
wrap_DBusObjectSkeletonAuthorizeMethodCallback a -> DBusObjectSkeletonAuthorizeMethodCallback
wrapped
    FunPtr C_DBusObjectSkeletonAuthorizeMethodCallback
wrapped'' <- C_DBusObjectSkeletonAuthorizeMethodCallback
-> IO (FunPtr C_DBusObjectSkeletonAuthorizeMethodCallback)
mk_DBusObjectSkeletonAuthorizeMethodCallback C_DBusObjectSkeletonAuthorizeMethodCallback
wrapped'
    a
-> Text
-> FunPtr C_DBusObjectSkeletonAuthorizeMethodCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"authorize-method" FunPtr C_DBusObjectSkeletonAuthorizeMethodCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DBusObjectSkeletonAuthorizeMethodSignalInfo
instance SignalInfo DBusObjectSkeletonAuthorizeMethodSignalInfo where
    type HaskellCallbackType DBusObjectSkeletonAuthorizeMethodSignalInfo = DBusObjectSkeletonAuthorizeMethodCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DBusObjectSkeletonAuthorizeMethodCallback cb
        cb'' <- mk_DBusObjectSkeletonAuthorizeMethodCallback cb'
        connectSignalFunPtr obj "authorize-method" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectSkeleton::authorize-method"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-DBusObjectSkeleton.html#g:signal:authorizeMethod"})

#endif

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

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

-- | Set the value of the “@g-object-path@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dBusObjectSkeleton [ #gObjectPath 'Data.GI.Base.Attributes.:=' value ]
-- @
setDBusObjectSkeletonGObjectPath :: (MonadIO m, IsDBusObjectSkeleton o) => o -> T.Text -> m ()
setDBusObjectSkeletonGObjectPath :: forall (m :: * -> *) o.
(MonadIO m, IsDBusObjectSkeleton o) =>
o -> Text -> m ()
setDBusObjectSkeletonGObjectPath o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"g-object-path" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@g-object-path@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #gObjectPath
-- @
clearDBusObjectSkeletonGObjectPath :: (MonadIO m, IsDBusObjectSkeleton o) => o -> m ()
clearDBusObjectSkeletonGObjectPath :: forall (m :: * -> *) o.
(MonadIO m, IsDBusObjectSkeleton o) =>
o -> m ()
clearDBusObjectSkeletonGObjectPath o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"g-object-path" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data DBusObjectSkeletonGObjectPathPropertyInfo
instance AttrInfo DBusObjectSkeletonGObjectPathPropertyInfo where
    type AttrAllowedOps DBusObjectSkeletonGObjectPathPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DBusObjectSkeletonGObjectPathPropertyInfo = IsDBusObjectSkeleton
    type AttrSetTypeConstraint DBusObjectSkeletonGObjectPathPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DBusObjectSkeletonGObjectPathPropertyInfo = (~) T.Text
    type AttrTransferType DBusObjectSkeletonGObjectPathPropertyInfo = T.Text
    type AttrGetType DBusObjectSkeletonGObjectPathPropertyInfo = (Maybe T.Text)
    type AttrLabel DBusObjectSkeletonGObjectPathPropertyInfo = "g-object-path"
    type AttrOrigin DBusObjectSkeletonGObjectPathPropertyInfo = DBusObjectSkeleton
    attrGet = getDBusObjectSkeletonGObjectPath
    attrSet = setDBusObjectSkeletonGObjectPath
    attrTransfer _ v = do
        return v
    attrConstruct = constructDBusObjectSkeletonGObjectPath
    attrClear = clearDBusObjectSkeletonGObjectPath
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusObjectSkeleton.gObjectPath"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-DBusObjectSkeleton.html#g:attr:gObjectPath"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DBusObjectSkeleton
type instance O.AttributeList DBusObjectSkeleton = DBusObjectSkeletonAttributeList
type DBusObjectSkeletonAttributeList = ('[ '("gObjectPath", DBusObjectSkeletonGObjectPathPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
dBusObjectSkeletonGObjectPath :: AttrLabelProxy "gObjectPath"
dBusObjectSkeletonGObjectPath = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DBusObjectSkeleton = DBusObjectSkeletonSignalList
type DBusObjectSkeletonSignalList = ('[ '("authorizeMethod", DBusObjectSkeletonAuthorizeMethodSignalInfo), '("interfaceAdded", Gio.DBusObject.DBusObjectInterfaceAddedSignalInfo), '("interfaceRemoved", Gio.DBusObject.DBusObjectInterfaceRemovedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method DBusObjectSkeleton::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "object_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An object path." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "DBusObjectSkeleton" })
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_skeleton_new" g_dbus_object_skeleton_new :: 
    CString ->                              -- object_path : TBasicType TUTF8
    IO (Ptr DBusObjectSkeleton)

-- | Creates a new t'GI.Gio.Objects.DBusObjectSkeleton.DBusObjectSkeleton'.
-- 
-- /Since: 2.30/
dBusObjectSkeletonNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@objectPath@/: An object path.
    -> m DBusObjectSkeleton
    -- ^ __Returns:__ A t'GI.Gio.Objects.DBusObjectSkeleton.DBusObjectSkeleton'. Free with 'GI.GObject.Objects.Object.objectUnref'.
dBusObjectSkeletonNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m DBusObjectSkeleton
dBusObjectSkeletonNew Text
objectPath = IO DBusObjectSkeleton -> m DBusObjectSkeleton
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DBusObjectSkeleton -> m DBusObjectSkeleton)
-> IO DBusObjectSkeleton -> m DBusObjectSkeleton
forall a b. (a -> b) -> a -> b
$ do
    CString
objectPath' <- Text -> IO CString
textToCString Text
objectPath
    Ptr DBusObjectSkeleton
result <- CString -> IO (Ptr DBusObjectSkeleton)
g_dbus_object_skeleton_new CString
objectPath'
    Text -> Ptr DBusObjectSkeleton -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dBusObjectSkeletonNew" Ptr DBusObjectSkeleton
result
    DBusObjectSkeleton
result' <- ((ManagedPtr DBusObjectSkeleton -> DBusObjectSkeleton)
-> Ptr DBusObjectSkeleton -> IO DBusObjectSkeleton
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DBusObjectSkeleton -> DBusObjectSkeleton
DBusObjectSkeleton) Ptr DBusObjectSkeleton
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
objectPath'
    DBusObjectSkeleton -> IO DBusObjectSkeleton
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DBusObjectSkeleton
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DBusObjectSkeleton::add_interface
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusObjectSkeleton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusObjectSkeleton."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interface_"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DBusInterfaceSkeleton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusInterfaceSkeleton."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_skeleton_add_interface" g_dbus_object_skeleton_add_interface :: 
    Ptr DBusObjectSkeleton ->               -- object : TInterface (Name {namespace = "Gio", name = "DBusObjectSkeleton"})
    Ptr Gio.DBusInterfaceSkeleton.DBusInterfaceSkeleton -> -- interface_ : TInterface (Name {namespace = "Gio", name = "DBusInterfaceSkeleton"})
    IO ()

-- | Adds /@interface_@/ to /@object@/.
-- 
-- If /@object@/ already contains a t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton' with the same
-- interface name, it is removed before /@interface_@/ is added.
-- 
-- Note that /@object@/ takes its own reference on /@interface_@/ and holds
-- it until removed.
-- 
-- /Since: 2.30/
dBusObjectSkeletonAddInterface ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusObjectSkeleton a, Gio.DBusInterfaceSkeleton.IsDBusInterfaceSkeleton b) =>
    a
    -- ^ /@object@/: A t'GI.Gio.Objects.DBusObjectSkeleton.DBusObjectSkeleton'.
    -> b
    -- ^ /@interface_@/: A t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton'.
    -> m ()
dBusObjectSkeletonAddInterface :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDBusObjectSkeleton a,
 IsDBusInterfaceSkeleton b) =>
a -> b -> m ()
dBusObjectSkeletonAddInterface a
object b
interface_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusObjectSkeleton
object' <- a -> IO (Ptr DBusObjectSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr DBusInterfaceSkeleton
interface_' <- b -> IO (Ptr DBusInterfaceSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
interface_
    Ptr DBusObjectSkeleton -> Ptr DBusInterfaceSkeleton -> IO ()
g_dbus_object_skeleton_add_interface Ptr DBusObjectSkeleton
object' Ptr DBusInterfaceSkeleton
interface_'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
interface_
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusObjectSkeletonAddInterfaceMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsDBusObjectSkeleton a, Gio.DBusInterfaceSkeleton.IsDBusInterfaceSkeleton b) => O.OverloadedMethod DBusObjectSkeletonAddInterfaceMethodInfo a signature where
    overloadedMethod = dBusObjectSkeletonAddInterface

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


#endif

-- method DBusObjectSkeleton::flush
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusObjectSkeleton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusObjectSkeleton."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_skeleton_flush" g_dbus_object_skeleton_flush :: 
    Ptr DBusObjectSkeleton ->               -- object : TInterface (Name {namespace = "Gio", name = "DBusObjectSkeleton"})
    IO ()

-- | This method simply calls 'GI.Gio.Objects.DBusInterfaceSkeleton.dBusInterfaceSkeletonFlush' on all
-- interfaces belonging to /@object@/. See that method for when flushing
-- is useful.
-- 
-- /Since: 2.30/
dBusObjectSkeletonFlush ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusObjectSkeleton a) =>
    a
    -- ^ /@object@/: A t'GI.Gio.Objects.DBusObjectSkeleton.DBusObjectSkeleton'.
    -> m ()
dBusObjectSkeletonFlush :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusObjectSkeleton a) =>
a -> m ()
dBusObjectSkeletonFlush a
object = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusObjectSkeleton
object' <- a -> IO (Ptr DBusObjectSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr DBusObjectSkeleton -> IO ()
g_dbus_object_skeleton_flush Ptr DBusObjectSkeleton
object'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusObjectSkeletonFlushMethodInfo
instance (signature ~ (m ()), MonadIO m, IsDBusObjectSkeleton a) => O.OverloadedMethod DBusObjectSkeletonFlushMethodInfo a signature where
    overloadedMethod = dBusObjectSkeletonFlush

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


#endif

-- method DBusObjectSkeleton::remove_interface
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusObjectSkeleton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusObjectSkeleton."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interface_"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DBusInterfaceSkeleton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusInterfaceSkeleton."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_skeleton_remove_interface" g_dbus_object_skeleton_remove_interface :: 
    Ptr DBusObjectSkeleton ->               -- object : TInterface (Name {namespace = "Gio", name = "DBusObjectSkeleton"})
    Ptr Gio.DBusInterfaceSkeleton.DBusInterfaceSkeleton -> -- interface_ : TInterface (Name {namespace = "Gio", name = "DBusInterfaceSkeleton"})
    IO ()

-- | Removes /@interface_@/ from /@object@/.
-- 
-- /Since: 2.30/
dBusObjectSkeletonRemoveInterface ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusObjectSkeleton a, Gio.DBusInterfaceSkeleton.IsDBusInterfaceSkeleton b) =>
    a
    -- ^ /@object@/: A t'GI.Gio.Objects.DBusObjectSkeleton.DBusObjectSkeleton'.
    -> b
    -- ^ /@interface_@/: A t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton'.
    -> m ()
dBusObjectSkeletonRemoveInterface :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDBusObjectSkeleton a,
 IsDBusInterfaceSkeleton b) =>
a -> b -> m ()
dBusObjectSkeletonRemoveInterface a
object b
interface_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusObjectSkeleton
object' <- a -> IO (Ptr DBusObjectSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr DBusInterfaceSkeleton
interface_' <- b -> IO (Ptr DBusInterfaceSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
interface_
    Ptr DBusObjectSkeleton -> Ptr DBusInterfaceSkeleton -> IO ()
g_dbus_object_skeleton_remove_interface Ptr DBusObjectSkeleton
object' Ptr DBusInterfaceSkeleton
interface_'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
interface_
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusObjectSkeletonRemoveInterfaceMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsDBusObjectSkeleton a, Gio.DBusInterfaceSkeleton.IsDBusInterfaceSkeleton b) => O.OverloadedMethod DBusObjectSkeletonRemoveInterfaceMethodInfo a signature where
    overloadedMethod = dBusObjectSkeletonRemoveInterface

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


#endif

-- method DBusObjectSkeleton::remove_interface_by_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusObjectSkeleton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusObjectSkeleton."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interface_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A D-Bus interface name."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_skeleton_remove_interface_by_name" g_dbus_object_skeleton_remove_interface_by_name :: 
    Ptr DBusObjectSkeleton ->               -- object : TInterface (Name {namespace = "Gio", name = "DBusObjectSkeleton"})
    CString ->                              -- interface_name : TBasicType TUTF8
    IO ()

-- | Removes the t'GI.Gio.Interfaces.DBusInterface.DBusInterface' with /@interfaceName@/ from /@object@/.
-- 
-- If no D-Bus interface of the given interface exists, this function
-- does nothing.
-- 
-- /Since: 2.30/
dBusObjectSkeletonRemoveInterfaceByName ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusObjectSkeleton a) =>
    a
    -- ^ /@object@/: A t'GI.Gio.Objects.DBusObjectSkeleton.DBusObjectSkeleton'.
    -> T.Text
    -- ^ /@interfaceName@/: A D-Bus interface name.
    -> m ()
dBusObjectSkeletonRemoveInterfaceByName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusObjectSkeleton a) =>
a -> Text -> m ()
dBusObjectSkeletonRemoveInterfaceByName a
object Text
interfaceName = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusObjectSkeleton
object' <- a -> IO (Ptr DBusObjectSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    CString
interfaceName' <- Text -> IO CString
textToCString Text
interfaceName
    Ptr DBusObjectSkeleton -> CString -> IO ()
g_dbus_object_skeleton_remove_interface_by_name Ptr DBusObjectSkeleton
object' CString
interfaceName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
interfaceName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusObjectSkeletonRemoveInterfaceByNameMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsDBusObjectSkeleton a) => O.OverloadedMethod DBusObjectSkeletonRemoveInterfaceByNameMethodInfo a signature where
    overloadedMethod = dBusObjectSkeletonRemoveInterfaceByName

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


#endif

-- method DBusObjectSkeleton::set_object_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusObjectSkeleton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusObjectSkeleton."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid D-Bus object path."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_skeleton_set_object_path" g_dbus_object_skeleton_set_object_path :: 
    Ptr DBusObjectSkeleton ->               -- object : TInterface (Name {namespace = "Gio", name = "DBusObjectSkeleton"})
    CString ->                              -- object_path : TBasicType TUTF8
    IO ()

-- | Sets the object path for /@object@/.
-- 
-- /Since: 2.30/
dBusObjectSkeletonSetObjectPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusObjectSkeleton a) =>
    a
    -- ^ /@object@/: A t'GI.Gio.Objects.DBusObjectSkeleton.DBusObjectSkeleton'.
    -> T.Text
    -- ^ /@objectPath@/: A valid D-Bus object path.
    -> m ()
dBusObjectSkeletonSetObjectPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusObjectSkeleton a) =>
a -> Text -> m ()
dBusObjectSkeletonSetObjectPath a
object Text
objectPath = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusObjectSkeleton
object' <- a -> IO (Ptr DBusObjectSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    CString
objectPath' <- Text -> IO CString
textToCString Text
objectPath
    Ptr DBusObjectSkeleton -> CString -> IO ()
g_dbus_object_skeleton_set_object_path Ptr DBusObjectSkeleton
object' CString
objectPath'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
objectPath'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusObjectSkeletonSetObjectPathMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsDBusObjectSkeleton a) => O.OverloadedMethod DBusObjectSkeletonSetObjectPathMethodInfo a signature where
    overloadedMethod = dBusObjectSkeletonSetObjectPath

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


#endif