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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Abstract base class for D-Bus interfaces on the service side.
-- 
-- /Since: 2.30/

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

module GI.Gio.Objects.DBusInterfaceSkeleton
    ( 

-- * Exported types
    DBusInterfaceSkeleton(..)               ,
    IsDBusInterfaceSkeleton                 ,
    toDBusInterfaceSkeleton                 ,


 -- * 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"), [export]("GI.Gio.Objects.DBusInterfaceSkeleton#g:method:export"), [flush]("GI.Gio.Objects.DBusInterfaceSkeleton#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"), [hasConnection]("GI.Gio.Objects.DBusInterfaceSkeleton#g:method:hasConnection"), [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"), [unexport]("GI.Gio.Objects.DBusInterfaceSkeleton#g:method:unexport"), [unexportFromConnection]("GI.Gio.Objects.DBusInterfaceSkeleton#g:method:unexportFromConnection"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getConnection]("GI.Gio.Objects.DBusInterfaceSkeleton#g:method:getConnection"), [getConnections]("GI.Gio.Objects.DBusInterfaceSkeleton#g:method:getConnections"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFlags]("GI.Gio.Objects.DBusInterfaceSkeleton#g:method:getFlags"), [getInfo]("GI.Gio.Objects.DBusInterfaceSkeleton#g:method:getInfo"), [getObject]("GI.Gio.Interfaces.DBusInterface#g:method:getObject"), [getObjectPath]("GI.Gio.Objects.DBusInterfaceSkeleton#g:method:getObjectPath"), [getProperties]("GI.Gio.Objects.DBusInterfaceSkeleton#g:method:getProperties"), [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"), [setFlags]("GI.Gio.Objects.DBusInterfaceSkeleton#g:method:setFlags"), [setObject]("GI.Gio.Interfaces.DBusInterface#g:method:setObject"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveDBusInterfaceSkeletonMethod      ,
#endif

-- ** export #method:export#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceSkeletonExportMethodInfo   ,
#endif
    dBusInterfaceSkeletonExport             ,


-- ** flush #method:flush#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceSkeletonFlushMethodInfo    ,
#endif
    dBusInterfaceSkeletonFlush              ,


-- ** getConnection #method:getConnection#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceSkeletonGetConnectionMethodInfo,
#endif
    dBusInterfaceSkeletonGetConnection      ,


-- ** getConnections #method:getConnections#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceSkeletonGetConnectionsMethodInfo,
#endif
    dBusInterfaceSkeletonGetConnections     ,


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceSkeletonGetFlagsMethodInfo ,
#endif
    dBusInterfaceSkeletonGetFlags           ,


-- ** getInfo #method:getInfo#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceSkeletonGetInfoMethodInfo  ,
#endif
    dBusInterfaceSkeletonGetInfo            ,


-- ** getObjectPath #method:getObjectPath#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceSkeletonGetObjectPathMethodInfo,
#endif
    dBusInterfaceSkeletonGetObjectPath      ,


-- ** getProperties #method:getProperties#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceSkeletonGetPropertiesMethodInfo,
#endif
    dBusInterfaceSkeletonGetProperties      ,


-- ** hasConnection #method:hasConnection#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceSkeletonHasConnectionMethodInfo,
#endif
    dBusInterfaceSkeletonHasConnection      ,


-- ** setFlags #method:setFlags#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceSkeletonSetFlagsMethodInfo ,
#endif
    dBusInterfaceSkeletonSetFlags           ,


-- ** unexport #method:unexport#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceSkeletonUnexportMethodInfo ,
#endif
    dBusInterfaceSkeletonUnexport           ,


-- ** unexportFromConnection #method:unexportFromConnection#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceSkeletonUnexportFromConnectionMethodInfo,
#endif
    dBusInterfaceSkeletonUnexportFromConnection,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceSkeletonGFlagsPropertyInfo ,
#endif
    constructDBusInterfaceSkeletonGFlags    ,
#if defined(ENABLE_OVERLOADING)
    dBusInterfaceSkeletonGFlags             ,
#endif
    getDBusInterfaceSkeletonGFlags          ,
    setDBusInterfaceSkeletonGFlags          ,




 -- * Signals


-- ** gAuthorizeMethod #signal:gAuthorizeMethod#

    DBusInterfaceSkeletonGAuthorizeMethodCallback,
#if defined(ENABLE_OVERLOADING)
    DBusInterfaceSkeletonGAuthorizeMethodSignalInfo,
#endif
    afterDBusInterfaceSkeletonGAuthorizeMethod,
    onDBusInterfaceSkeletonGAuthorizeMethod ,




    ) 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.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.Flags as Gio.Flags
import {-# SOURCE #-} qualified GI.Gio.Interfaces.DBusInterface as Gio.DBusInterface
import {-# SOURCE #-} qualified GI.Gio.Objects.DBusConnection as Gio.DBusConnection
import {-# SOURCE #-} qualified GI.Gio.Objects.DBusMethodInvocation as Gio.DBusMethodInvocation
import {-# SOURCE #-} qualified GI.Gio.Structs.DBusInterfaceInfo as Gio.DBusInterfaceInfo

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

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

foreign import ccall "g_dbus_interface_skeleton_get_type"
    c_g_dbus_interface_skeleton_get_type :: IO B.Types.GType

instance B.Types.TypedObject DBusInterfaceSkeleton where
    glibType :: IO GType
glibType = IO GType
c_g_dbus_interface_skeleton_get_type

instance B.Types.GObject DBusInterfaceSkeleton

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

instance O.HasParentTypes DBusInterfaceSkeleton
type instance O.ParentTypes DBusInterfaceSkeleton = '[GObject.Object.Object, Gio.DBusInterface.DBusInterface]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDBusInterfaceSkeletonMethod (t :: Symbol) (o :: *) :: * where
    ResolveDBusInterfaceSkeletonMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDBusInterfaceSkeletonMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDBusInterfaceSkeletonMethod "export" o = DBusInterfaceSkeletonExportMethodInfo
    ResolveDBusInterfaceSkeletonMethod "flush" o = DBusInterfaceSkeletonFlushMethodInfo
    ResolveDBusInterfaceSkeletonMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDBusInterfaceSkeletonMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDBusInterfaceSkeletonMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDBusInterfaceSkeletonMethod "hasConnection" o = DBusInterfaceSkeletonHasConnectionMethodInfo
    ResolveDBusInterfaceSkeletonMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDBusInterfaceSkeletonMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDBusInterfaceSkeletonMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDBusInterfaceSkeletonMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDBusInterfaceSkeletonMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDBusInterfaceSkeletonMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDBusInterfaceSkeletonMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDBusInterfaceSkeletonMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDBusInterfaceSkeletonMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDBusInterfaceSkeletonMethod "unexport" o = DBusInterfaceSkeletonUnexportMethodInfo
    ResolveDBusInterfaceSkeletonMethod "unexportFromConnection" o = DBusInterfaceSkeletonUnexportFromConnectionMethodInfo
    ResolveDBusInterfaceSkeletonMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDBusInterfaceSkeletonMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDBusInterfaceSkeletonMethod "getConnection" o = DBusInterfaceSkeletonGetConnectionMethodInfo
    ResolveDBusInterfaceSkeletonMethod "getConnections" o = DBusInterfaceSkeletonGetConnectionsMethodInfo
    ResolveDBusInterfaceSkeletonMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDBusInterfaceSkeletonMethod "getFlags" o = DBusInterfaceSkeletonGetFlagsMethodInfo
    ResolveDBusInterfaceSkeletonMethod "getInfo" o = DBusInterfaceSkeletonGetInfoMethodInfo
    ResolveDBusInterfaceSkeletonMethod "getObject" o = Gio.DBusInterface.DBusInterfaceGetObjectMethodInfo
    ResolveDBusInterfaceSkeletonMethod "getObjectPath" o = DBusInterfaceSkeletonGetObjectPathMethodInfo
    ResolveDBusInterfaceSkeletonMethod "getProperties" o = DBusInterfaceSkeletonGetPropertiesMethodInfo
    ResolveDBusInterfaceSkeletonMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDBusInterfaceSkeletonMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDBusInterfaceSkeletonMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDBusInterfaceSkeletonMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDBusInterfaceSkeletonMethod "setFlags" o = DBusInterfaceSkeletonSetFlagsMethodInfo
    ResolveDBusInterfaceSkeletonMethod "setObject" o = Gio.DBusInterface.DBusInterfaceSetObjectMethodInfo
    ResolveDBusInterfaceSkeletonMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDBusInterfaceSkeletonMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal DBusInterfaceSkeleton::g-authorize-method
-- | Emitted when a method is invoked by a remote caller and used to
-- determine if the method call is authorized.
-- 
-- Note that this signal is emitted in a thread dedicated to
-- handling the method call so handlers are allowed to perform
-- blocking IO. This means that it is appropriate to call e.g.
-- <http://hal.freedesktop.org/docs/polkit/PolkitAuthority.html#polkit-authority-check-authorization-sync polkit_authority_check_authorization_sync()>
-- with the
-- <http://hal.freedesktop.org/docs/polkit/PolkitAuthority.html#POLKIT-CHECK-AUTHORIZATION-FLAGS-ALLOW-USER-INTERACTION:CAPS POLKIT_CHECK_AUTHORIZATION_FLAGS_ALLOW_USER_INTERACTION>
-- flag set.
-- 
-- If 'P.False' is returned then no further handlers are run and the
-- signal handler must take a reference to /@invocation@/ and finish
-- handling the call (e.g. return an error via
-- @/g_dbus_method_invocation_return_error()/@).
-- 
-- Otherwise, if 'P.True' is returned, signal emission continues. If no
-- handlers return 'P.False', then the method is dispatched. If
-- /@interface@/ has an enclosing t'GI.Gio.Objects.DBusObjectSkeleton.DBusObjectSkeleton', then the
-- [DBusObjectSkeleton::authorizeMethod]("GI.Gio.Objects.DBusObjectSkeleton#g:signal:authorizeMethod") signal handlers run before
-- the handlers for this signal.
-- 
-- The default class handler just returns 'P.True'.
-- 
-- Please note that the common case is optimized: if no signals
-- handlers are connected and the default class handler isn\'t
-- overridden (for both /@interface@/ and the enclosing
-- t'GI.Gio.Objects.DBusObjectSkeleton.DBusObjectSkeleton', if any) and [DBusInterfaceSkeleton:gFlags]("GI.Gio.Objects.DBusInterfaceSkeleton#g:attr:gFlags") does
-- not have the
-- 'GI.Gio.Flags.DBusInterfaceSkeletonFlagsHandleMethodInvocationsInThread'
-- flags set, no dedicated thread is ever used and the call will be
-- handled in the same thread as the object that /@interface@/ belongs
-- to was exported in.
-- 
-- /Since: 2.30/
type DBusInterfaceSkeletonGAuthorizeMethodCallback =
    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_DBusInterfaceSkeletonGAuthorizeMethodCallback =
    Ptr DBusInterfaceSkeleton ->            -- object
    Ptr Gio.DBusMethodInvocation.DBusMethodInvocation ->
    Ptr () ->                               -- user_data
    IO CInt

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

wrap_DBusInterfaceSkeletonGAuthorizeMethodCallback :: 
    GObject a => (a -> DBusInterfaceSkeletonGAuthorizeMethodCallback) ->
    C_DBusInterfaceSkeletonGAuthorizeMethodCallback
wrap_DBusInterfaceSkeletonGAuthorizeMethodCallback :: forall a.
GObject a =>
(a -> DBusInterfaceSkeletonGAuthorizeMethodCallback)
-> C_DBusInterfaceSkeletonGAuthorizeMethodCallback
wrap_DBusInterfaceSkeletonGAuthorizeMethodCallback a -> DBusInterfaceSkeletonGAuthorizeMethodCallback
gi'cb Ptr DBusInterfaceSkeleton
gi'selfPtr Ptr DBusMethodInvocation
invocation Ptr ()
_ = do
    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 DBusInterfaceSkeleton
-> (DBusInterfaceSkeleton -> IO Bool) -> IO Bool
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr DBusInterfaceSkeleton
gi'selfPtr ((DBusInterfaceSkeleton -> IO Bool) -> IO Bool)
-> (DBusInterfaceSkeleton -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \DBusInterfaceSkeleton
gi'self -> a -> DBusInterfaceSkeletonGAuthorizeMethodCallback
gi'cb (DBusInterfaceSkeleton -> a
forall a b. Coercible a b => a -> b
Coerce.coerce DBusInterfaceSkeleton
gi'self)  DBusMethodInvocation
invocation'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
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 [gAuthorizeMethod](#signal:gAuthorizeMethod) 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' dBusInterfaceSkeleton #gAuthorizeMethod callback
-- @
-- 
-- 
onDBusInterfaceSkeletonGAuthorizeMethod :: (IsDBusInterfaceSkeleton a, MonadIO m) => a -> ((?self :: a) => DBusInterfaceSkeletonGAuthorizeMethodCallback) -> m SignalHandlerId
onDBusInterfaceSkeletonGAuthorizeMethod :: forall a (m :: * -> *).
(IsDBusInterfaceSkeleton a, MonadIO m) =>
a
-> ((?self::a) => DBusInterfaceSkeletonGAuthorizeMethodCallback)
-> m SignalHandlerId
onDBusInterfaceSkeletonGAuthorizeMethod a
obj (?self::a) => DBusInterfaceSkeletonGAuthorizeMethodCallback
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 -> DBusInterfaceSkeletonGAuthorizeMethodCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusInterfaceSkeletonGAuthorizeMethodCallback
DBusInterfaceSkeletonGAuthorizeMethodCallback
cb
    let wrapped' :: C_DBusInterfaceSkeletonGAuthorizeMethodCallback
wrapped' = (a -> DBusInterfaceSkeletonGAuthorizeMethodCallback)
-> C_DBusInterfaceSkeletonGAuthorizeMethodCallback
forall a.
GObject a =>
(a -> DBusInterfaceSkeletonGAuthorizeMethodCallback)
-> C_DBusInterfaceSkeletonGAuthorizeMethodCallback
wrap_DBusInterfaceSkeletonGAuthorizeMethodCallback a -> DBusInterfaceSkeletonGAuthorizeMethodCallback
wrapped
    FunPtr C_DBusInterfaceSkeletonGAuthorizeMethodCallback
wrapped'' <- C_DBusInterfaceSkeletonGAuthorizeMethodCallback
-> IO (FunPtr C_DBusInterfaceSkeletonGAuthorizeMethodCallback)
mk_DBusInterfaceSkeletonGAuthorizeMethodCallback C_DBusInterfaceSkeletonGAuthorizeMethodCallback
wrapped'
    a
-> Text
-> FunPtr C_DBusInterfaceSkeletonGAuthorizeMethodCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"g-authorize-method" FunPtr C_DBusInterfaceSkeletonGAuthorizeMethodCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [gAuthorizeMethod](#signal:gAuthorizeMethod) 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' dBusInterfaceSkeleton #gAuthorizeMethod 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.
-- 
afterDBusInterfaceSkeletonGAuthorizeMethod :: (IsDBusInterfaceSkeleton a, MonadIO m) => a -> ((?self :: a) => DBusInterfaceSkeletonGAuthorizeMethodCallback) -> m SignalHandlerId
afterDBusInterfaceSkeletonGAuthorizeMethod :: forall a (m :: * -> *).
(IsDBusInterfaceSkeleton a, MonadIO m) =>
a
-> ((?self::a) => DBusInterfaceSkeletonGAuthorizeMethodCallback)
-> m SignalHandlerId
afterDBusInterfaceSkeletonGAuthorizeMethod a
obj (?self::a) => DBusInterfaceSkeletonGAuthorizeMethodCallback
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 -> DBusInterfaceSkeletonGAuthorizeMethodCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DBusInterfaceSkeletonGAuthorizeMethodCallback
DBusInterfaceSkeletonGAuthorizeMethodCallback
cb
    let wrapped' :: C_DBusInterfaceSkeletonGAuthorizeMethodCallback
wrapped' = (a -> DBusInterfaceSkeletonGAuthorizeMethodCallback)
-> C_DBusInterfaceSkeletonGAuthorizeMethodCallback
forall a.
GObject a =>
(a -> DBusInterfaceSkeletonGAuthorizeMethodCallback)
-> C_DBusInterfaceSkeletonGAuthorizeMethodCallback
wrap_DBusInterfaceSkeletonGAuthorizeMethodCallback a -> DBusInterfaceSkeletonGAuthorizeMethodCallback
wrapped
    FunPtr C_DBusInterfaceSkeletonGAuthorizeMethodCallback
wrapped'' <- C_DBusInterfaceSkeletonGAuthorizeMethodCallback
-> IO (FunPtr C_DBusInterfaceSkeletonGAuthorizeMethodCallback)
mk_DBusInterfaceSkeletonGAuthorizeMethodCallback C_DBusInterfaceSkeletonGAuthorizeMethodCallback
wrapped'
    a
-> Text
-> FunPtr C_DBusInterfaceSkeletonGAuthorizeMethodCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"g-authorize-method" FunPtr C_DBusInterfaceSkeletonGAuthorizeMethodCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DBusInterfaceSkeletonGAuthorizeMethodSignalInfo
instance SignalInfo DBusInterfaceSkeletonGAuthorizeMethodSignalInfo where
    type HaskellCallbackType DBusInterfaceSkeletonGAuthorizeMethodSignalInfo = DBusInterfaceSkeletonGAuthorizeMethodCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DBusInterfaceSkeletonGAuthorizeMethodCallback cb
        cb'' <- mk_DBusInterfaceSkeletonGAuthorizeMethodCallback cb'
        connectSignalFunPtr obj "g-authorize-method" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.DBusInterfaceSkeleton::g-authorize-method"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Objects-DBusInterfaceSkeleton.html#g:signal:gAuthorizeMethod"})

#endif

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

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

-- | Set the value of the “@g-flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dBusInterfaceSkeleton [ #gFlags 'Data.GI.Base.Attributes.:=' value ]
-- @
setDBusInterfaceSkeletonGFlags :: (MonadIO m, IsDBusInterfaceSkeleton o) => o -> [Gio.Flags.DBusInterfaceSkeletonFlags] -> m ()
setDBusInterfaceSkeletonGFlags :: forall (m :: * -> *) o.
(MonadIO m, IsDBusInterfaceSkeleton o) =>
o -> [DBusInterfaceSkeletonFlags] -> m ()
setDBusInterfaceSkeletonGFlags o
obj [DBusInterfaceSkeletonFlags]
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 -> [DBusInterfaceSkeletonFlags] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"g-flags" [DBusInterfaceSkeletonFlags]
val

-- | Construct a `GValueConstruct` with valid value for the “@g-flags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDBusInterfaceSkeletonGFlags :: (IsDBusInterfaceSkeleton o, MIO.MonadIO m) => [Gio.Flags.DBusInterfaceSkeletonFlags] -> m (GValueConstruct o)
constructDBusInterfaceSkeletonGFlags :: forall o (m :: * -> *).
(IsDBusInterfaceSkeleton o, MonadIO m) =>
[DBusInterfaceSkeletonFlags] -> m (GValueConstruct o)
constructDBusInterfaceSkeletonGFlags [DBusInterfaceSkeletonFlags]
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 -> [DBusInterfaceSkeletonFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"g-flags" [DBusInterfaceSkeletonFlags]
val

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DBusInterfaceSkeleton
type instance O.AttributeList DBusInterfaceSkeleton = DBusInterfaceSkeletonAttributeList
type DBusInterfaceSkeletonAttributeList = ('[ '("gFlags", DBusInterfaceSkeletonGFlagsPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
dBusInterfaceSkeletonGFlags :: AttrLabelProxy "gFlags"
dBusInterfaceSkeletonGFlags = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DBusInterfaceSkeleton = DBusInterfaceSkeletonSignalList
type DBusInterfaceSkeletonSignalList = ('[ '("gAuthorizeMethod", DBusInterfaceSkeletonGAuthorizeMethodSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method DBusInterfaceSkeleton::export
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "interface_"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DBusInterfaceSkeleton" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The D-Bus interface to export."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusConnection to export @interface_ on."
--                 , 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 "The path to export the interface at."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_dbus_interface_skeleton_export" g_dbus_interface_skeleton_export :: 
    Ptr DBusInterfaceSkeleton ->            -- interface_ : TInterface (Name {namespace = "Gio", name = "DBusInterfaceSkeleton"})
    Ptr Gio.DBusConnection.DBusConnection -> -- connection : TInterface (Name {namespace = "Gio", name = "DBusConnection"})
    CString ->                              -- object_path : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Exports /@interface_@/ at /@objectPath@/ on /@connection@/.
-- 
-- This can be called multiple times to export the same /@interface_@/
-- onto multiple connections however the /@objectPath@/ provided must be
-- the same for all connections.
-- 
-- Use 'GI.Gio.Objects.DBusInterfaceSkeleton.dBusInterfaceSkeletonUnexport' to unexport the object.
-- 
-- /Since: 2.30/
dBusInterfaceSkeletonExport ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a, Gio.DBusConnection.IsDBusConnection b) =>
    a
    -- ^ /@interface_@/: The D-Bus interface to export.
    -> b
    -- ^ /@connection@/: A t'GI.Gio.Objects.DBusConnection.DBusConnection' to export /@interface_@/ on.
    -> T.Text
    -- ^ /@objectPath@/: The path to export the interface at.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
dBusInterfaceSkeletonExport :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a,
 IsDBusConnection b) =>
a -> b -> Text -> m ()
dBusInterfaceSkeletonExport a
interface_ b
connection 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 DBusInterfaceSkeleton
interface_' <- a -> IO (Ptr DBusInterfaceSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interface_
    Ptr DBusConnection
connection' <- b -> IO (Ptr DBusConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
connection
    CString
objectPath' <- Text -> IO CString
textToCString Text
objectPath
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr DBusInterfaceSkeleton
-> Ptr DBusConnection -> CString -> Ptr (Ptr GError) -> IO CInt
g_dbus_interface_skeleton_export Ptr DBusInterfaceSkeleton
interface_' Ptr DBusConnection
connection' CString
objectPath'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interface_
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
connection
        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 ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
objectPath'
     )

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceSkeletonExportMethodInfo
instance (signature ~ (b -> T.Text -> m ()), MonadIO m, IsDBusInterfaceSkeleton a, Gio.DBusConnection.IsDBusConnection b) => O.OverloadedMethod DBusInterfaceSkeletonExportMethodInfo a signature where
    overloadedMethod = dBusInterfaceSkeletonExport

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


#endif

-- method DBusInterfaceSkeleton::flush
-- method type : OrdinaryMethod
-- Args: [ 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_interface_skeleton_flush" g_dbus_interface_skeleton_flush :: 
    Ptr DBusInterfaceSkeleton ->            -- interface_ : TInterface (Name {namespace = "Gio", name = "DBusInterfaceSkeleton"})
    IO ()

-- | If /@interface_@/ has outstanding changes, request for these changes to be
-- emitted immediately.
-- 
-- For example, an exported D-Bus interface may queue up property
-- changes and emit the
-- @org.freedesktop.DBus.Properties.PropertiesChanged@
-- signal later (e.g. in an idle handler). This technique is useful
-- for collapsing multiple property changes into one.
-- 
-- /Since: 2.30/
dBusInterfaceSkeletonFlush ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
    a
    -- ^ /@interface_@/: A t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton'.
    -> m ()
dBusInterfaceSkeletonFlush :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
a -> m ()
dBusInterfaceSkeletonFlush a
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 DBusInterfaceSkeleton
interface_' <- a -> IO (Ptr DBusInterfaceSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interface_
    Ptr DBusInterfaceSkeleton -> IO ()
g_dbus_interface_skeleton_flush Ptr DBusInterfaceSkeleton
interface_'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interface_
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceSkeletonFlushMethodInfo
instance (signature ~ (m ()), MonadIO m, IsDBusInterfaceSkeleton a) => O.OverloadedMethod DBusInterfaceSkeletonFlushMethodInfo a signature where
    overloadedMethod = dBusInterfaceSkeletonFlush

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


#endif

-- method DBusInterfaceSkeleton::get_connection
-- method type : OrdinaryMethod
-- Args: [ 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: Just
--               (TInterface Name { namespace = "Gio" , name = "DBusConnection" })
-- throws : False
-- Skip return : False

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

-- | Gets the first connection that /@interface_@/ is exported on, if any.
-- 
-- /Since: 2.30/
dBusInterfaceSkeletonGetConnection ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
    a
    -- ^ /@interface_@/: A t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton'.
    -> m (Maybe Gio.DBusConnection.DBusConnection)
    -- ^ __Returns:__ A t'GI.Gio.Objects.DBusConnection.DBusConnection' or 'P.Nothing' if /@interface_@/ is
    -- not exported anywhere. Do not free, the object belongs to /@interface_@/.
dBusInterfaceSkeletonGetConnection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
a -> m (Maybe DBusConnection)
dBusInterfaceSkeletonGetConnection a
interface_ = IO (Maybe DBusConnection) -> m (Maybe DBusConnection)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DBusConnection) -> m (Maybe DBusConnection))
-> IO (Maybe DBusConnection) -> m (Maybe DBusConnection)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusInterfaceSkeleton
interface_' <- a -> IO (Ptr DBusInterfaceSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interface_
    Ptr DBusConnection
result <- Ptr DBusInterfaceSkeleton -> IO (Ptr DBusConnection)
g_dbus_interface_skeleton_get_connection Ptr DBusInterfaceSkeleton
interface_'
    Maybe DBusConnection
maybeResult <- Ptr DBusConnection
-> (Ptr DBusConnection -> IO DBusConnection)
-> IO (Maybe DBusConnection)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DBusConnection
result ((Ptr DBusConnection -> IO DBusConnection)
 -> IO (Maybe DBusConnection))
-> (Ptr DBusConnection -> IO DBusConnection)
-> IO (Maybe DBusConnection)
forall a b. (a -> b) -> a -> b
$ \Ptr DBusConnection
result' -> do
        DBusConnection
result'' <- ((ManagedPtr DBusConnection -> DBusConnection)
-> Ptr DBusConnection -> IO DBusConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DBusConnection -> DBusConnection
Gio.DBusConnection.DBusConnection) Ptr DBusConnection
result'
        DBusConnection -> IO DBusConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DBusConnection
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interface_
    Maybe DBusConnection -> IO (Maybe DBusConnection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DBusConnection
maybeResult

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceSkeletonGetConnectionMethodInfo
instance (signature ~ (m (Maybe Gio.DBusConnection.DBusConnection)), MonadIO m, IsDBusInterfaceSkeleton a) => O.OverloadedMethod DBusInterfaceSkeletonGetConnectionMethodInfo a signature where
    overloadedMethod = dBusInterfaceSkeletonGetConnection

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


#endif

-- method DBusInterfaceSkeleton::get_connections
-- method type : OrdinaryMethod
-- Args: [ 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: Just
--               (TGList
--                  (TInterface Name { namespace = "Gio" , name = "DBusConnection" }))
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_interface_skeleton_get_connections" g_dbus_interface_skeleton_get_connections :: 
    Ptr DBusInterfaceSkeleton ->            -- interface_ : TInterface (Name {namespace = "Gio", name = "DBusInterfaceSkeleton"})
    IO (Ptr (GList (Ptr Gio.DBusConnection.DBusConnection)))

-- | Gets a list of the connections that /@interface_@/ is exported on.
-- 
-- /Since: 2.32/
dBusInterfaceSkeletonGetConnections ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
    a
    -- ^ /@interface_@/: A t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton'.
    -> m [Gio.DBusConnection.DBusConnection]
    -- ^ __Returns:__ A list of
    --   all the connections that /@interface_@/ is exported on. The returned
    --   list should be freed with @/g_list_free()/@ after each element has
    --   been freed with 'GI.GObject.Objects.Object.objectUnref'.
dBusInterfaceSkeletonGetConnections :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
a -> m [DBusConnection]
dBusInterfaceSkeletonGetConnections a
interface_ = IO [DBusConnection] -> m [DBusConnection]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DBusConnection] -> m [DBusConnection])
-> IO [DBusConnection] -> m [DBusConnection]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusInterfaceSkeleton
interface_' <- a -> IO (Ptr DBusInterfaceSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interface_
    Ptr (GList (Ptr DBusConnection))
result <- Ptr DBusInterfaceSkeleton -> IO (Ptr (GList (Ptr DBusConnection)))
g_dbus_interface_skeleton_get_connections Ptr DBusInterfaceSkeleton
interface_'
    [Ptr DBusConnection]
result' <- Ptr (GList (Ptr DBusConnection)) -> IO [Ptr DBusConnection]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr DBusConnection))
result
    [DBusConnection]
result'' <- (Ptr DBusConnection -> IO DBusConnection)
-> [Ptr DBusConnection] -> IO [DBusConnection]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr DBusConnection -> DBusConnection)
-> Ptr DBusConnection -> IO DBusConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DBusConnection -> DBusConnection
Gio.DBusConnection.DBusConnection) [Ptr DBusConnection]
result'
    Ptr (GList (Ptr DBusConnection)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DBusConnection))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interface_
    [DBusConnection] -> IO [DBusConnection]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [DBusConnection]
result''

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceSkeletonGetConnectionsMethodInfo
instance (signature ~ (m [Gio.DBusConnection.DBusConnection]), MonadIO m, IsDBusInterfaceSkeleton a) => O.OverloadedMethod DBusInterfaceSkeletonGetConnectionsMethodInfo a signature where
    overloadedMethod = dBusInterfaceSkeletonGetConnections

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


#endif

-- method DBusInterfaceSkeleton::get_flags
-- method type : OrdinaryMethod
-- Args: [ 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: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "DBusInterfaceSkeletonFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_interface_skeleton_get_flags" g_dbus_interface_skeleton_get_flags :: 
    Ptr DBusInterfaceSkeleton ->            -- interface_ : TInterface (Name {namespace = "Gio", name = "DBusInterfaceSkeleton"})
    IO CUInt

-- | Gets the t'GI.Gio.Flags.DBusInterfaceSkeletonFlags' that describes what the behavior
-- of /@interface_@/
-- 
-- /Since: 2.30/
dBusInterfaceSkeletonGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
    a
    -- ^ /@interface_@/: A t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton'.
    -> m [Gio.Flags.DBusInterfaceSkeletonFlags]
    -- ^ __Returns:__ One or more flags from the t'GI.Gio.Flags.DBusInterfaceSkeletonFlags' enumeration.
dBusInterfaceSkeletonGetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
a -> m [DBusInterfaceSkeletonFlags]
dBusInterfaceSkeletonGetFlags a
interface_ = IO [DBusInterfaceSkeletonFlags] -> m [DBusInterfaceSkeletonFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DBusInterfaceSkeletonFlags] -> m [DBusInterfaceSkeletonFlags])
-> IO [DBusInterfaceSkeletonFlags]
-> m [DBusInterfaceSkeletonFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusInterfaceSkeleton
interface_' <- a -> IO (Ptr DBusInterfaceSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interface_
    CUInt
result <- Ptr DBusInterfaceSkeleton -> IO CUInt
g_dbus_interface_skeleton_get_flags Ptr DBusInterfaceSkeleton
interface_'
    let result' :: [DBusInterfaceSkeletonFlags]
result' = CUInt -> [DBusInterfaceSkeletonFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interface_
    [DBusInterfaceSkeletonFlags] -> IO [DBusInterfaceSkeletonFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [DBusInterfaceSkeletonFlags]
result'

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceSkeletonGetFlagsMethodInfo
instance (signature ~ (m [Gio.Flags.DBusInterfaceSkeletonFlags]), MonadIO m, IsDBusInterfaceSkeleton a) => O.OverloadedMethod DBusInterfaceSkeletonGetFlagsMethodInfo a signature where
    overloadedMethod = dBusInterfaceSkeletonGetFlags

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


#endif

-- method DBusInterfaceSkeleton::get_info
-- method type : OrdinaryMethod
-- Args: [ 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: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "DBusInterfaceInfo" })
-- throws : False
-- Skip return : False

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

-- | Gets D-Bus introspection information for the D-Bus interface
-- implemented by /@interface_@/.
-- 
-- /Since: 2.30/
dBusInterfaceSkeletonGetInfo ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
    a
    -- ^ /@interface_@/: A t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton'.
    -> m Gio.DBusInterfaceInfo.DBusInterfaceInfo
    -- ^ __Returns:__ A t'GI.Gio.Structs.DBusInterfaceInfo.DBusInterfaceInfo' (never 'P.Nothing'). Do not free.
dBusInterfaceSkeletonGetInfo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
a -> m DBusInterfaceInfo
dBusInterfaceSkeletonGetInfo a
interface_ = IO DBusInterfaceInfo -> m DBusInterfaceInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DBusInterfaceInfo -> m DBusInterfaceInfo)
-> IO DBusInterfaceInfo -> m DBusInterfaceInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusInterfaceSkeleton
interface_' <- a -> IO (Ptr DBusInterfaceSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interface_
    Ptr DBusInterfaceInfo
result <- Ptr DBusInterfaceSkeleton -> IO (Ptr DBusInterfaceInfo)
g_dbus_interface_skeleton_get_info Ptr DBusInterfaceSkeleton
interface_'
    Text -> Ptr DBusInterfaceInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dBusInterfaceSkeletonGetInfo" Ptr DBusInterfaceInfo
result
    DBusInterfaceInfo
result' <- ((ManagedPtr DBusInterfaceInfo -> DBusInterfaceInfo)
-> Ptr DBusInterfaceInfo -> IO DBusInterfaceInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DBusInterfaceInfo -> DBusInterfaceInfo
Gio.DBusInterfaceInfo.DBusInterfaceInfo) Ptr DBusInterfaceInfo
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interface_
    DBusInterfaceInfo -> IO DBusInterfaceInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DBusInterfaceInfo
result'

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceSkeletonGetInfoMethodInfo
instance (signature ~ (m Gio.DBusInterfaceInfo.DBusInterfaceInfo), MonadIO m, IsDBusInterfaceSkeleton a) => O.OverloadedMethod DBusInterfaceSkeletonGetInfoMethodInfo a signature where
    overloadedMethod = dBusInterfaceSkeletonGetInfo

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


#endif

-- method DBusInterfaceSkeleton::get_object_path
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_interface_skeleton_get_object_path" g_dbus_interface_skeleton_get_object_path :: 
    Ptr DBusInterfaceSkeleton ->            -- interface_ : TInterface (Name {namespace = "Gio", name = "DBusInterfaceSkeleton"})
    IO CString

-- | Gets the object path that /@interface_@/ is exported on, if any.
-- 
-- /Since: 2.30/
dBusInterfaceSkeletonGetObjectPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
    a
    -- ^ /@interface_@/: A t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ A string owned by /@interface_@/ or 'P.Nothing' if /@interface_@/ is not exported
    -- anywhere. Do not free, the string belongs to /@interface_@/.
dBusInterfaceSkeletonGetObjectPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
a -> m (Maybe Text)
dBusInterfaceSkeletonGetObjectPath a
interface_ = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusInterfaceSkeleton
interface_' <- a -> IO (Ptr DBusInterfaceSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interface_
    CString
result <- Ptr DBusInterfaceSkeleton -> IO CString
g_dbus_interface_skeleton_get_object_path Ptr DBusInterfaceSkeleton
interface_'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interface_
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

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


#endif

-- method DBusInterfaceSkeleton::get_properties
-- method type : OrdinaryMethod
-- Args: [ 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: Just TVariant
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_interface_skeleton_get_properties" g_dbus_interface_skeleton_get_properties :: 
    Ptr DBusInterfaceSkeleton ->            -- interface_ : TInterface (Name {namespace = "Gio", name = "DBusInterfaceSkeleton"})
    IO (Ptr GVariant)

-- | Gets all D-Bus properties for /@interface_@/.
-- 
-- /Since: 2.30/
dBusInterfaceSkeletonGetProperties ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
    a
    -- ^ /@interface_@/: A t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton'.
    -> m GVariant
    -- ^ __Returns:__ A t'GVariant' of type
    -- [\'a{sv}\'][G-VARIANT-TYPE-VARDICT:CAPS].
    -- Free with 'GI.GLib.Structs.Variant.variantUnref'.
dBusInterfaceSkeletonGetProperties :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
a -> m GVariant
dBusInterfaceSkeletonGetProperties a
interface_ = IO GVariant -> m GVariant
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusInterfaceSkeleton
interface_' <- a -> IO (Ptr DBusInterfaceSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interface_
    Ptr GVariant
result <- Ptr DBusInterfaceSkeleton -> IO (Ptr GVariant)
g_dbus_interface_skeleton_get_properties Ptr DBusInterfaceSkeleton
interface_'
    Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dBusInterfaceSkeletonGetProperties" Ptr GVariant
result
    GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interface_
    GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceSkeletonGetPropertiesMethodInfo
instance (signature ~ (m GVariant), MonadIO m, IsDBusInterfaceSkeleton a) => O.OverloadedMethod DBusInterfaceSkeletonGetPropertiesMethodInfo a signature where
    overloadedMethod = dBusInterfaceSkeletonGetProperties

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


#endif

-- method DBusInterfaceSkeleton::has_connection
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusConnection."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_interface_skeleton_has_connection" g_dbus_interface_skeleton_has_connection :: 
    Ptr DBusInterfaceSkeleton ->            -- interface_ : TInterface (Name {namespace = "Gio", name = "DBusInterfaceSkeleton"})
    Ptr Gio.DBusConnection.DBusConnection -> -- connection : TInterface (Name {namespace = "Gio", name = "DBusConnection"})
    IO CInt

-- | Checks if /@interface_@/ is exported on /@connection@/.
-- 
-- /Since: 2.32/
dBusInterfaceSkeletonHasConnection ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a, Gio.DBusConnection.IsDBusConnection b) =>
    a
    -- ^ /@interface_@/: A t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton'.
    -> b
    -- ^ /@connection@/: A t'GI.Gio.Objects.DBusConnection.DBusConnection'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@interface_@/ is exported on /@connection@/, 'P.False' otherwise.
dBusInterfaceSkeletonHasConnection :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a,
 IsDBusConnection b) =>
a -> b -> m Bool
dBusInterfaceSkeletonHasConnection a
interface_ b
connection = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusInterfaceSkeleton
interface_' <- a -> IO (Ptr DBusInterfaceSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interface_
    Ptr DBusConnection
connection' <- b -> IO (Ptr DBusConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
connection
    CInt
result <- Ptr DBusInterfaceSkeleton -> Ptr DBusConnection -> IO CInt
g_dbus_interface_skeleton_has_connection Ptr DBusInterfaceSkeleton
interface_' Ptr DBusConnection
connection'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interface_
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
connection
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceSkeletonHasConnectionMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsDBusInterfaceSkeleton a, Gio.DBusConnection.IsDBusConnection b) => O.OverloadedMethod DBusInterfaceSkeletonHasConnectionMethodInfo a signature where
    overloadedMethod = dBusInterfaceSkeletonHasConnection

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


#endif

-- method DBusInterfaceSkeleton::set_flags
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DBusInterfaceSkeletonFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Flags from the #GDBusInterfaceSkeletonFlags enumeration."
--                 , 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_interface_skeleton_set_flags" g_dbus_interface_skeleton_set_flags :: 
    Ptr DBusInterfaceSkeleton ->            -- interface_ : TInterface (Name {namespace = "Gio", name = "DBusInterfaceSkeleton"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "DBusInterfaceSkeletonFlags"})
    IO ()

-- | Sets flags describing what the behavior of /@skeleton@/ should be.
-- 
-- /Since: 2.30/
dBusInterfaceSkeletonSetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
    a
    -- ^ /@interface_@/: A t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton'.
    -> [Gio.Flags.DBusInterfaceSkeletonFlags]
    -- ^ /@flags@/: Flags from the t'GI.Gio.Flags.DBusInterfaceSkeletonFlags' enumeration.
    -> m ()
dBusInterfaceSkeletonSetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
a -> [DBusInterfaceSkeletonFlags] -> m ()
dBusInterfaceSkeletonSetFlags a
interface_ [DBusInterfaceSkeletonFlags]
flags = 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 DBusInterfaceSkeleton
interface_' <- a -> IO (Ptr DBusInterfaceSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interface_
    let flags' :: CUInt
flags' = [DBusInterfaceSkeletonFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DBusInterfaceSkeletonFlags]
flags
    Ptr DBusInterfaceSkeleton -> CUInt -> IO ()
g_dbus_interface_skeleton_set_flags Ptr DBusInterfaceSkeleton
interface_' CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interface_
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceSkeletonSetFlagsMethodInfo
instance (signature ~ ([Gio.Flags.DBusInterfaceSkeletonFlags] -> m ()), MonadIO m, IsDBusInterfaceSkeleton a) => O.OverloadedMethod DBusInterfaceSkeletonSetFlagsMethodInfo a signature where
    overloadedMethod = dBusInterfaceSkeletonSetFlags

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


#endif

-- method DBusInterfaceSkeleton::unexport
-- method type : OrdinaryMethod
-- Args: [ 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_interface_skeleton_unexport" g_dbus_interface_skeleton_unexport :: 
    Ptr DBusInterfaceSkeleton ->            -- interface_ : TInterface (Name {namespace = "Gio", name = "DBusInterfaceSkeleton"})
    IO ()

-- | Stops exporting /@interface_@/ on all connections it is exported on.
-- 
-- To unexport /@interface_@/ from only a single connection, use
-- 'GI.Gio.Objects.DBusInterfaceSkeleton.dBusInterfaceSkeletonUnexportFromConnection'
-- 
-- /Since: 2.30/
dBusInterfaceSkeletonUnexport ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
    a
    -- ^ /@interface_@/: A t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton'.
    -> m ()
dBusInterfaceSkeletonUnexport :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a) =>
a -> m ()
dBusInterfaceSkeletonUnexport a
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 DBusInterfaceSkeleton
interface_' <- a -> IO (Ptr DBusInterfaceSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interface_
    Ptr DBusInterfaceSkeleton -> IO ()
g_dbus_interface_skeleton_unexport Ptr DBusInterfaceSkeleton
interface_'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interface_
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceSkeletonUnexportMethodInfo
instance (signature ~ (m ()), MonadIO m, IsDBusInterfaceSkeleton a) => O.OverloadedMethod DBusInterfaceSkeletonUnexportMethodInfo a signature where
    overloadedMethod = dBusInterfaceSkeletonUnexport

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


#endif

-- method DBusInterfaceSkeleton::unexport_from_connection
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusConnection."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_interface_skeleton_unexport_from_connection" g_dbus_interface_skeleton_unexport_from_connection :: 
    Ptr DBusInterfaceSkeleton ->            -- interface_ : TInterface (Name {namespace = "Gio", name = "DBusInterfaceSkeleton"})
    Ptr Gio.DBusConnection.DBusConnection -> -- connection : TInterface (Name {namespace = "Gio", name = "DBusConnection"})
    IO ()

-- | Stops exporting /@interface_@/ on /@connection@/.
-- 
-- To stop exporting on all connections the interface is exported on,
-- use 'GI.Gio.Objects.DBusInterfaceSkeleton.dBusInterfaceSkeletonUnexport'.
-- 
-- /Since: 2.32/
dBusInterfaceSkeletonUnexportFromConnection ::
    (B.CallStack.HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a, Gio.DBusConnection.IsDBusConnection b) =>
    a
    -- ^ /@interface_@/: A t'GI.Gio.Objects.DBusInterfaceSkeleton.DBusInterfaceSkeleton'.
    -> b
    -- ^ /@connection@/: A t'GI.Gio.Objects.DBusConnection.DBusConnection'.
    -> m ()
dBusInterfaceSkeletonUnexportFromConnection :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDBusInterfaceSkeleton a,
 IsDBusConnection b) =>
a -> b -> m ()
dBusInterfaceSkeletonUnexportFromConnection a
interface_ b
connection = 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 DBusInterfaceSkeleton
interface_' <- a -> IO (Ptr DBusInterfaceSkeleton)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interface_
    Ptr DBusConnection
connection' <- b -> IO (Ptr DBusConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
connection
    Ptr DBusInterfaceSkeleton -> Ptr DBusConnection -> IO ()
g_dbus_interface_skeleton_unexport_from_connection Ptr DBusInterfaceSkeleton
interface_' Ptr DBusConnection
connection'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interface_
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
connection
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceSkeletonUnexportFromConnectionMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsDBusInterfaceSkeleton a, Gio.DBusConnection.IsDBusConnection b) => O.OverloadedMethod DBusInterfaceSkeletonUnexportFromConnectionMethodInfo a signature where
    overloadedMethod = dBusInterfaceSkeletonUnexportFromConnection

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


#endif