{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Information about a D-Bus interface.
-- 
-- /Since: 2.26/

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

module GI.Gio.Structs.DBusInterfaceInfo
    ( 

-- * Exported types
    DBusInterfaceInfo(..)                   ,
    newZeroDBusInterfaceInfo                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [cacheBuild]("GI.Gio.Structs.DBusInterfaceInfo#g:method:cacheBuild"), [cacheRelease]("GI.Gio.Structs.DBusInterfaceInfo#g:method:cacheRelease"), [generateXml]("GI.Gio.Structs.DBusInterfaceInfo#g:method:generateXml"), [lookupMethod]("GI.Gio.Structs.DBusInterfaceInfo#g:method:lookupMethod"), [lookupProperty]("GI.Gio.Structs.DBusInterfaceInfo#g:method:lookupProperty"), [lookupSignal]("GI.Gio.Structs.DBusInterfaceInfo#g:method:lookupSignal"), [ref]("GI.Gio.Structs.DBusInterfaceInfo#g:method:ref"), [unref]("GI.Gio.Structs.DBusInterfaceInfo#g:method:unref").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveDBusInterfaceInfoMethod          ,
#endif

-- ** cacheBuild #method:cacheBuild#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceInfoCacheBuildMethodInfo   ,
#endif
    dBusInterfaceInfoCacheBuild             ,


-- ** cacheRelease #method:cacheRelease#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceInfoCacheReleaseMethodInfo ,
#endif
    dBusInterfaceInfoCacheRelease           ,


-- ** generateXml #method:generateXml#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceInfoGenerateXmlMethodInfo  ,
#endif
    dBusInterfaceInfoGenerateXml            ,


-- ** lookupMethod #method:lookupMethod#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceInfoLookupMethodMethodInfo ,
#endif
    dBusInterfaceInfoLookupMethod           ,


-- ** lookupProperty #method:lookupProperty#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceInfoLookupPropertyMethodInfo,
#endif
    dBusInterfaceInfoLookupProperty         ,


-- ** lookupSignal #method:lookupSignal#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceInfoLookupSignalMethodInfo ,
#endif
    dBusInterfaceInfoLookupSignal           ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceInfoRefMethodInfo          ,
#endif
    dBusInterfaceInfoRef                    ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    DBusInterfaceInfoUnrefMethodInfo        ,
#endif
    dBusInterfaceInfoUnref                  ,




 -- * Properties


-- ** annotations #attr:annotations#
-- | A pointer to a 'P.Nothing'-terminated array of pointers to t'GI.Gio.Structs.DBusAnnotationInfo.DBusAnnotationInfo' structures or 'P.Nothing' if there are no annotations.

    clearDBusInterfaceInfoAnnotations       ,
#if defined(ENABLE_OVERLOADING)
    dBusInterfaceInfo_annotations           ,
#endif
    getDBusInterfaceInfoAnnotations         ,
    setDBusInterfaceInfoAnnotations         ,


-- ** methods #attr:methods#
-- | A pointer to a 'P.Nothing'-terminated array of pointers to t'GI.Gio.Structs.DBusMethodInfo.DBusMethodInfo' structures or 'P.Nothing' if there are no methods.

    clearDBusInterfaceInfoMethods           ,
#if defined(ENABLE_OVERLOADING)
    dBusInterfaceInfo_methods               ,
#endif
    getDBusInterfaceInfoMethods             ,
    setDBusInterfaceInfoMethods             ,


-- ** name #attr:name#
-- | The name of the D-Bus interface, e.g. \"org.freedesktop.DBus.Properties\".

    clearDBusInterfaceInfoName              ,
#if defined(ENABLE_OVERLOADING)
    dBusInterfaceInfo_name                  ,
#endif
    getDBusInterfaceInfoName                ,
    setDBusInterfaceInfoName                ,


-- ** properties #attr:properties#
-- | A pointer to a 'P.Nothing'-terminated array of pointers to t'GI.Gio.Structs.DBusPropertyInfo.DBusPropertyInfo' structures or 'P.Nothing' if there are no properties.

    clearDBusInterfaceInfoProperties        ,
#if defined(ENABLE_OVERLOADING)
    dBusInterfaceInfo_properties            ,
#endif
    getDBusInterfaceInfoProperties          ,
    setDBusInterfaceInfoProperties          ,


-- ** refCount #attr:refCount#
-- | The reference count or -1 if statically allocated.

#if defined(ENABLE_OVERLOADING)
    dBusInterfaceInfo_refCount              ,
#endif
    getDBusInterfaceInfoRefCount            ,
    setDBusInterfaceInfoRefCount            ,


-- ** signals #attr:signals#
-- | A pointer to a 'P.Nothing'-terminated array of pointers to t'GI.Gio.Structs.DBusSignalInfo.DBusSignalInfo' structures or 'P.Nothing' if there are no signals.

    clearDBusInterfaceInfoSignals           ,
#if defined(ENABLE_OVERLOADING)
    dBusInterfaceInfo_signals               ,
#endif
    getDBusInterfaceInfoSignals             ,
    setDBusInterfaceInfoSignals             ,




    ) 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.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.GLib.Structs.String as GLib.String
import {-# SOURCE #-} qualified GI.Gio.Structs.DBusAnnotationInfo as Gio.DBusAnnotationInfo
import {-# SOURCE #-} qualified GI.Gio.Structs.DBusMethodInfo as Gio.DBusMethodInfo
import {-# SOURCE #-} qualified GI.Gio.Structs.DBusPropertyInfo as Gio.DBusPropertyInfo
import {-# SOURCE #-} qualified GI.Gio.Structs.DBusSignalInfo as Gio.DBusSignalInfo

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

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

foreign import ccall "g_dbus_interface_info_get_type" c_g_dbus_interface_info_get_type :: 
    IO GType

type instance O.ParentTypes DBusInterfaceInfo = '[]
instance O.HasParentTypes DBusInterfaceInfo

instance B.Types.TypedObject DBusInterfaceInfo where
    glibType :: IO GType
glibType = IO GType
c_g_dbus_interface_info_get_type

instance B.Types.GBoxed DBusInterfaceInfo

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

-- | Construct a `DBusInterfaceInfo` struct initialized to zero.
newZeroDBusInterfaceInfo :: MonadIO m => m DBusInterfaceInfo
newZeroDBusInterfaceInfo :: forall (m :: * -> *). MonadIO m => m DBusInterfaceInfo
newZeroDBusInterfaceInfo = IO DBusInterfaceInfo -> m DBusInterfaceInfo
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
$ Int -> IO (Ptr DBusInterfaceInfo)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
48 IO (Ptr DBusInterfaceInfo)
-> (Ptr DBusInterfaceInfo -> IO DBusInterfaceInfo)
-> IO DBusInterfaceInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr DBusInterfaceInfo -> DBusInterfaceInfo)
-> Ptr DBusInterfaceInfo -> IO DBusInterfaceInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DBusInterfaceInfo -> DBusInterfaceInfo
DBusInterfaceInfo

instance tag ~ 'AttrSet => Constructible DBusInterfaceInfo tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr DBusInterfaceInfo -> DBusInterfaceInfo)
-> [AttrOp DBusInterfaceInfo tag] -> m DBusInterfaceInfo
new ManagedPtr DBusInterfaceInfo -> DBusInterfaceInfo
_ [AttrOp DBusInterfaceInfo tag]
attrs = do
        DBusInterfaceInfo
o <- m DBusInterfaceInfo
forall (m :: * -> *). MonadIO m => m DBusInterfaceInfo
newZeroDBusInterfaceInfo
        DBusInterfaceInfo -> [AttrOp DBusInterfaceInfo 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set DBusInterfaceInfo
o [AttrOp DBusInterfaceInfo tag]
[AttrOp DBusInterfaceInfo 'AttrSet]
attrs
        DBusInterfaceInfo -> m DBusInterfaceInfo
forall (m :: * -> *) a. Monad m => a -> m a
return DBusInterfaceInfo
o


-- | Get the value of the “@ref_count@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusInterfaceInfo #refCount
-- @
getDBusInterfaceInfoRefCount :: MonadIO m => DBusInterfaceInfo -> m Int32
getDBusInterfaceInfoRefCount :: forall (m :: * -> *). MonadIO m => DBusInterfaceInfo -> m Int32
getDBusInterfaceInfoRefCount DBusInterfaceInfo
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo
-> (Ptr DBusInterfaceInfo -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO Int32) -> IO Int32)
-> (Ptr DBusInterfaceInfo -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@ref_count@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dBusInterfaceInfo [ #refCount 'Data.GI.Base.Attributes.:=' value ]
-- @
setDBusInterfaceInfoRefCount :: MonadIO m => DBusInterfaceInfo -> Int32 -> m ()
setDBusInterfaceInfoRefCount :: forall (m :: * -> *).
MonadIO m =>
DBusInterfaceInfo -> Int32 -> m ()
setDBusInterfaceInfoRefCount DBusInterfaceInfo
s Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo -> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO ()) -> IO ())
-> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceInfoRefCountFieldInfo
instance AttrInfo DBusInterfaceInfoRefCountFieldInfo where
    type AttrBaseTypeConstraint DBusInterfaceInfoRefCountFieldInfo = (~) DBusInterfaceInfo
    type AttrAllowedOps DBusInterfaceInfoRefCountFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DBusInterfaceInfoRefCountFieldInfo = (~) Int32
    type AttrTransferTypeConstraint DBusInterfaceInfoRefCountFieldInfo = (~)Int32
    type AttrTransferType DBusInterfaceInfoRefCountFieldInfo = Int32
    type AttrGetType DBusInterfaceInfoRefCountFieldInfo = Int32
    type AttrLabel DBusInterfaceInfoRefCountFieldInfo = "ref_count"
    type AttrOrigin DBusInterfaceInfoRefCountFieldInfo = DBusInterfaceInfo
    attrGet = getDBusInterfaceInfoRefCount
    attrSet = setDBusInterfaceInfoRefCount
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.DBusInterfaceInfo.refCount"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-DBusInterfaceInfo.html#g:attr:refCount"
        })

dBusInterfaceInfo_refCount :: AttrLabelProxy "refCount"
dBusInterfaceInfo_refCount = AttrLabelProxy

#endif


-- | Get the value of the “@name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusInterfaceInfo #name
-- @
getDBusInterfaceInfoName :: MonadIO m => DBusInterfaceInfo -> m (Maybe T.Text)
getDBusInterfaceInfoName :: forall (m :: * -> *).
MonadIO m =>
DBusInterfaceInfo -> m (Maybe Text)
getDBusInterfaceInfoName DBusInterfaceInfo
s = IO (Maybe Text) -> m (Maybe Text)
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
$ DBusInterfaceInfo
-> (Ptr DBusInterfaceInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr DBusInterfaceInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dBusInterfaceInfo [ #name 'Data.GI.Base.Attributes.:=' value ]
-- @
setDBusInterfaceInfoName :: MonadIO m => DBusInterfaceInfo -> CString -> m ()
setDBusInterfaceInfoName :: forall (m :: * -> *).
MonadIO m =>
DBusInterfaceInfo -> CString -> m ()
setDBusInterfaceInfoName DBusInterfaceInfo
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo -> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO ()) -> IO ())
-> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
val :: CString)

-- | Set the value of the “@name@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #name
-- @
clearDBusInterfaceInfoName :: MonadIO m => DBusInterfaceInfo -> m ()
clearDBusInterfaceInfoName :: forall (m :: * -> *). MonadIO m => DBusInterfaceInfo -> m ()
clearDBusInterfaceInfoName DBusInterfaceInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo -> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO ()) -> IO ())
-> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceInfoNameFieldInfo
instance AttrInfo DBusInterfaceInfoNameFieldInfo where
    type AttrBaseTypeConstraint DBusInterfaceInfoNameFieldInfo = (~) DBusInterfaceInfo
    type AttrAllowedOps DBusInterfaceInfoNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint DBusInterfaceInfoNameFieldInfo = (~) CString
    type AttrTransferTypeConstraint DBusInterfaceInfoNameFieldInfo = (~)CString
    type AttrTransferType DBusInterfaceInfoNameFieldInfo = CString
    type AttrGetType DBusInterfaceInfoNameFieldInfo = Maybe T.Text
    type AttrLabel DBusInterfaceInfoNameFieldInfo = "name"
    type AttrOrigin DBusInterfaceInfoNameFieldInfo = DBusInterfaceInfo
    attrGet = getDBusInterfaceInfoName
    attrSet = setDBusInterfaceInfoName
    attrConstruct = undefined
    attrClear = clearDBusInterfaceInfoName
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.DBusInterfaceInfo.name"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-DBusInterfaceInfo.html#g:attr:name"
        })

dBusInterfaceInfo_name :: AttrLabelProxy "name"
dBusInterfaceInfo_name = AttrLabelProxy

#endif


-- | Get the value of the “@methods@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusInterfaceInfo #methods
-- @
getDBusInterfaceInfoMethods :: MonadIO m => DBusInterfaceInfo -> m (Maybe [Gio.DBusMethodInfo.DBusMethodInfo])
getDBusInterfaceInfoMethods :: forall (m :: * -> *).
MonadIO m =>
DBusInterfaceInfo -> m (Maybe [DBusMethodInfo])
getDBusInterfaceInfoMethods DBusInterfaceInfo
s = IO (Maybe [DBusMethodInfo]) -> m (Maybe [DBusMethodInfo])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [DBusMethodInfo]) -> m (Maybe [DBusMethodInfo]))
-> IO (Maybe [DBusMethodInfo]) -> m (Maybe [DBusMethodInfo])
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo
-> (Ptr DBusInterfaceInfo -> IO (Maybe [DBusMethodInfo]))
-> IO (Maybe [DBusMethodInfo])
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO (Maybe [DBusMethodInfo]))
 -> IO (Maybe [DBusMethodInfo]))
-> (Ptr DBusInterfaceInfo -> IO (Maybe [DBusMethodInfo]))
-> IO (Maybe [DBusMethodInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Ptr (Ptr DBusMethodInfo)
val <- Ptr (Ptr (Ptr DBusMethodInfo)) -> IO (Ptr (Ptr DBusMethodInfo))
forall a. Storable a => Ptr a -> IO a
peek (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr (Ptr (Ptr DBusMethodInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO (Ptr (Ptr Gio.DBusMethodInfo.DBusMethodInfo))
    Maybe [DBusMethodInfo]
result <- Ptr (Ptr DBusMethodInfo)
-> (Ptr (Ptr DBusMethodInfo) -> IO [DBusMethodInfo])
-> IO (Maybe [DBusMethodInfo])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr (Ptr DBusMethodInfo)
val ((Ptr (Ptr DBusMethodInfo) -> IO [DBusMethodInfo])
 -> IO (Maybe [DBusMethodInfo]))
-> (Ptr (Ptr DBusMethodInfo) -> IO [DBusMethodInfo])
-> IO (Maybe [DBusMethodInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr DBusMethodInfo)
val' -> do
        [Ptr DBusMethodInfo]
val'' <- Ptr (Ptr DBusMethodInfo) -> IO [Ptr DBusMethodInfo]
forall a. Ptr (Ptr a) -> IO [Ptr a]
unpackZeroTerminatedPtrArray Ptr (Ptr DBusMethodInfo)
val'
        [DBusMethodInfo]
val''' <- (Ptr DBusMethodInfo -> IO DBusMethodInfo)
-> [Ptr DBusMethodInfo] -> IO [DBusMethodInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr DBusMethodInfo -> DBusMethodInfo)
-> Ptr DBusMethodInfo -> IO DBusMethodInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DBusMethodInfo -> DBusMethodInfo
Gio.DBusMethodInfo.DBusMethodInfo) [Ptr DBusMethodInfo]
val''
        [DBusMethodInfo] -> IO [DBusMethodInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [DBusMethodInfo]
val'''
    Maybe [DBusMethodInfo] -> IO (Maybe [DBusMethodInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [DBusMethodInfo]
result

-- | Set the value of the “@methods@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dBusInterfaceInfo [ #methods 'Data.GI.Base.Attributes.:=' value ]
-- @
setDBusInterfaceInfoMethods :: MonadIO m => DBusInterfaceInfo -> Ptr (Ptr Gio.DBusMethodInfo.DBusMethodInfo) -> m ()
setDBusInterfaceInfoMethods :: forall (m :: * -> *).
MonadIO m =>
DBusInterfaceInfo -> Ptr (Ptr DBusMethodInfo) -> m ()
setDBusInterfaceInfoMethods DBusInterfaceInfo
s Ptr (Ptr DBusMethodInfo)
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo -> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO ()) -> IO ())
-> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Ptr (Ptr (Ptr DBusMethodInfo)) -> Ptr (Ptr DBusMethodInfo) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr (Ptr (Ptr DBusMethodInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Ptr (Ptr DBusMethodInfo)
val :: Ptr (Ptr Gio.DBusMethodInfo.DBusMethodInfo))

-- | Set the value of the “@methods@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #methods
-- @
clearDBusInterfaceInfoMethods :: MonadIO m => DBusInterfaceInfo -> m ()
clearDBusInterfaceInfoMethods :: forall (m :: * -> *). MonadIO m => DBusInterfaceInfo -> m ()
clearDBusInterfaceInfoMethods DBusInterfaceInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo -> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO ()) -> IO ())
-> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Ptr (Ptr (Ptr DBusMethodInfo)) -> Ptr (Ptr DBusMethodInfo) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr (Ptr (Ptr DBusMethodInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Ptr (Ptr DBusMethodInfo)
forall a. Ptr a
FP.nullPtr :: Ptr (Ptr Gio.DBusMethodInfo.DBusMethodInfo))

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceInfoMethodsFieldInfo
instance AttrInfo DBusInterfaceInfoMethodsFieldInfo where
    type AttrBaseTypeConstraint DBusInterfaceInfoMethodsFieldInfo = (~) DBusInterfaceInfo
    type AttrAllowedOps DBusInterfaceInfoMethodsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint DBusInterfaceInfoMethodsFieldInfo = (~) (Ptr (Ptr Gio.DBusMethodInfo.DBusMethodInfo))
    type AttrTransferTypeConstraint DBusInterfaceInfoMethodsFieldInfo = (~)(Ptr (Ptr Gio.DBusMethodInfo.DBusMethodInfo))
    type AttrTransferType DBusInterfaceInfoMethodsFieldInfo = (Ptr (Ptr Gio.DBusMethodInfo.DBusMethodInfo))
    type AttrGetType DBusInterfaceInfoMethodsFieldInfo = Maybe [Gio.DBusMethodInfo.DBusMethodInfo]
    type AttrLabel DBusInterfaceInfoMethodsFieldInfo = "methods"
    type AttrOrigin DBusInterfaceInfoMethodsFieldInfo = DBusInterfaceInfo
    attrGet = getDBusInterfaceInfoMethods
    attrSet = setDBusInterfaceInfoMethods
    attrConstruct = undefined
    attrClear = clearDBusInterfaceInfoMethods
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.DBusInterfaceInfo.methods"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-DBusInterfaceInfo.html#g:attr:methods"
        })

dBusInterfaceInfo_methods :: AttrLabelProxy "methods"
dBusInterfaceInfo_methods = AttrLabelProxy

#endif


-- | Get the value of the “@signals@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusInterfaceInfo #signals
-- @
getDBusInterfaceInfoSignals :: MonadIO m => DBusInterfaceInfo -> m (Maybe [Gio.DBusSignalInfo.DBusSignalInfo])
getDBusInterfaceInfoSignals :: forall (m :: * -> *).
MonadIO m =>
DBusInterfaceInfo -> m (Maybe [DBusSignalInfo])
getDBusInterfaceInfoSignals DBusInterfaceInfo
s = IO (Maybe [DBusSignalInfo]) -> m (Maybe [DBusSignalInfo])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [DBusSignalInfo]) -> m (Maybe [DBusSignalInfo]))
-> IO (Maybe [DBusSignalInfo]) -> m (Maybe [DBusSignalInfo])
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo
-> (Ptr DBusInterfaceInfo -> IO (Maybe [DBusSignalInfo]))
-> IO (Maybe [DBusSignalInfo])
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO (Maybe [DBusSignalInfo]))
 -> IO (Maybe [DBusSignalInfo]))
-> (Ptr DBusInterfaceInfo -> IO (Maybe [DBusSignalInfo]))
-> IO (Maybe [DBusSignalInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Ptr (Ptr DBusSignalInfo)
val <- Ptr (Ptr (Ptr DBusSignalInfo)) -> IO (Ptr (Ptr DBusSignalInfo))
forall a. Storable a => Ptr a -> IO a
peek (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr (Ptr (Ptr DBusSignalInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO (Ptr (Ptr Gio.DBusSignalInfo.DBusSignalInfo))
    Maybe [DBusSignalInfo]
result <- Ptr (Ptr DBusSignalInfo)
-> (Ptr (Ptr DBusSignalInfo) -> IO [DBusSignalInfo])
-> IO (Maybe [DBusSignalInfo])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr (Ptr DBusSignalInfo)
val ((Ptr (Ptr DBusSignalInfo) -> IO [DBusSignalInfo])
 -> IO (Maybe [DBusSignalInfo]))
-> (Ptr (Ptr DBusSignalInfo) -> IO [DBusSignalInfo])
-> IO (Maybe [DBusSignalInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr DBusSignalInfo)
val' -> do
        [Ptr DBusSignalInfo]
val'' <- Ptr (Ptr DBusSignalInfo) -> IO [Ptr DBusSignalInfo]
forall a. Ptr (Ptr a) -> IO [Ptr a]
unpackZeroTerminatedPtrArray Ptr (Ptr DBusSignalInfo)
val'
        [DBusSignalInfo]
val''' <- (Ptr DBusSignalInfo -> IO DBusSignalInfo)
-> [Ptr DBusSignalInfo] -> IO [DBusSignalInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr DBusSignalInfo -> DBusSignalInfo)
-> Ptr DBusSignalInfo -> IO DBusSignalInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DBusSignalInfo -> DBusSignalInfo
Gio.DBusSignalInfo.DBusSignalInfo) [Ptr DBusSignalInfo]
val''
        [DBusSignalInfo] -> IO [DBusSignalInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [DBusSignalInfo]
val'''
    Maybe [DBusSignalInfo] -> IO (Maybe [DBusSignalInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [DBusSignalInfo]
result

-- | Set the value of the “@signals@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dBusInterfaceInfo [ #signals 'Data.GI.Base.Attributes.:=' value ]
-- @
setDBusInterfaceInfoSignals :: MonadIO m => DBusInterfaceInfo -> Ptr (Ptr Gio.DBusSignalInfo.DBusSignalInfo) -> m ()
setDBusInterfaceInfoSignals :: forall (m :: * -> *).
MonadIO m =>
DBusInterfaceInfo -> Ptr (Ptr DBusSignalInfo) -> m ()
setDBusInterfaceInfoSignals DBusInterfaceInfo
s Ptr (Ptr DBusSignalInfo)
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo -> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO ()) -> IO ())
-> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Ptr (Ptr (Ptr DBusSignalInfo)) -> Ptr (Ptr DBusSignalInfo) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr (Ptr (Ptr DBusSignalInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (Ptr (Ptr DBusSignalInfo)
val :: Ptr (Ptr Gio.DBusSignalInfo.DBusSignalInfo))

-- | Set the value of the “@signals@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #signals
-- @
clearDBusInterfaceInfoSignals :: MonadIO m => DBusInterfaceInfo -> m ()
clearDBusInterfaceInfoSignals :: forall (m :: * -> *). MonadIO m => DBusInterfaceInfo -> m ()
clearDBusInterfaceInfoSignals DBusInterfaceInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo -> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO ()) -> IO ())
-> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Ptr (Ptr (Ptr DBusSignalInfo)) -> Ptr (Ptr DBusSignalInfo) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr (Ptr (Ptr DBusSignalInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (Ptr (Ptr DBusSignalInfo)
forall a. Ptr a
FP.nullPtr :: Ptr (Ptr Gio.DBusSignalInfo.DBusSignalInfo))

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceInfoSignalsFieldInfo
instance AttrInfo DBusInterfaceInfoSignalsFieldInfo where
    type AttrBaseTypeConstraint DBusInterfaceInfoSignalsFieldInfo = (~) DBusInterfaceInfo
    type AttrAllowedOps DBusInterfaceInfoSignalsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint DBusInterfaceInfoSignalsFieldInfo = (~) (Ptr (Ptr Gio.DBusSignalInfo.DBusSignalInfo))
    type AttrTransferTypeConstraint DBusInterfaceInfoSignalsFieldInfo = (~)(Ptr (Ptr Gio.DBusSignalInfo.DBusSignalInfo))
    type AttrTransferType DBusInterfaceInfoSignalsFieldInfo = (Ptr (Ptr Gio.DBusSignalInfo.DBusSignalInfo))
    type AttrGetType DBusInterfaceInfoSignalsFieldInfo = Maybe [Gio.DBusSignalInfo.DBusSignalInfo]
    type AttrLabel DBusInterfaceInfoSignalsFieldInfo = "signals"
    type AttrOrigin DBusInterfaceInfoSignalsFieldInfo = DBusInterfaceInfo
    attrGet = getDBusInterfaceInfoSignals
    attrSet = setDBusInterfaceInfoSignals
    attrConstruct = undefined
    attrClear = clearDBusInterfaceInfoSignals
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.DBusInterfaceInfo.signals"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-DBusInterfaceInfo.html#g:attr:signals"
        })

dBusInterfaceInfo_signals :: AttrLabelProxy "signals"
dBusInterfaceInfo_signals = AttrLabelProxy

#endif


-- | Get the value of the “@properties@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusInterfaceInfo #properties
-- @
getDBusInterfaceInfoProperties :: MonadIO m => DBusInterfaceInfo -> m (Maybe [Gio.DBusPropertyInfo.DBusPropertyInfo])
getDBusInterfaceInfoProperties :: forall (m :: * -> *).
MonadIO m =>
DBusInterfaceInfo -> m (Maybe [DBusPropertyInfo])
getDBusInterfaceInfoProperties DBusInterfaceInfo
s = IO (Maybe [DBusPropertyInfo]) -> m (Maybe [DBusPropertyInfo])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [DBusPropertyInfo]) -> m (Maybe [DBusPropertyInfo]))
-> IO (Maybe [DBusPropertyInfo]) -> m (Maybe [DBusPropertyInfo])
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo
-> (Ptr DBusInterfaceInfo -> IO (Maybe [DBusPropertyInfo]))
-> IO (Maybe [DBusPropertyInfo])
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO (Maybe [DBusPropertyInfo]))
 -> IO (Maybe [DBusPropertyInfo]))
-> (Ptr DBusInterfaceInfo -> IO (Maybe [DBusPropertyInfo]))
-> IO (Maybe [DBusPropertyInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Ptr (Ptr DBusPropertyInfo)
val <- Ptr (Ptr (Ptr DBusPropertyInfo)) -> IO (Ptr (Ptr DBusPropertyInfo))
forall a. Storable a => Ptr a -> IO a
peek (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr (Ptr (Ptr DBusPropertyInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO (Ptr (Ptr Gio.DBusPropertyInfo.DBusPropertyInfo))
    Maybe [DBusPropertyInfo]
result <- Ptr (Ptr DBusPropertyInfo)
-> (Ptr (Ptr DBusPropertyInfo) -> IO [DBusPropertyInfo])
-> IO (Maybe [DBusPropertyInfo])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr (Ptr DBusPropertyInfo)
val ((Ptr (Ptr DBusPropertyInfo) -> IO [DBusPropertyInfo])
 -> IO (Maybe [DBusPropertyInfo]))
-> (Ptr (Ptr DBusPropertyInfo) -> IO [DBusPropertyInfo])
-> IO (Maybe [DBusPropertyInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr DBusPropertyInfo)
val' -> do
        [Ptr DBusPropertyInfo]
val'' <- Ptr (Ptr DBusPropertyInfo) -> IO [Ptr DBusPropertyInfo]
forall a. Ptr (Ptr a) -> IO [Ptr a]
unpackZeroTerminatedPtrArray Ptr (Ptr DBusPropertyInfo)
val'
        [DBusPropertyInfo]
val''' <- (Ptr DBusPropertyInfo -> IO DBusPropertyInfo)
-> [Ptr DBusPropertyInfo] -> IO [DBusPropertyInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr DBusPropertyInfo -> DBusPropertyInfo)
-> Ptr DBusPropertyInfo -> IO DBusPropertyInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DBusPropertyInfo -> DBusPropertyInfo
Gio.DBusPropertyInfo.DBusPropertyInfo) [Ptr DBusPropertyInfo]
val''
        [DBusPropertyInfo] -> IO [DBusPropertyInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [DBusPropertyInfo]
val'''
    Maybe [DBusPropertyInfo] -> IO (Maybe [DBusPropertyInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [DBusPropertyInfo]
result

-- | Set the value of the “@properties@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dBusInterfaceInfo [ #properties 'Data.GI.Base.Attributes.:=' value ]
-- @
setDBusInterfaceInfoProperties :: MonadIO m => DBusInterfaceInfo -> Ptr (Ptr Gio.DBusPropertyInfo.DBusPropertyInfo) -> m ()
setDBusInterfaceInfoProperties :: forall (m :: * -> *).
MonadIO m =>
DBusInterfaceInfo -> Ptr (Ptr DBusPropertyInfo) -> m ()
setDBusInterfaceInfoProperties DBusInterfaceInfo
s Ptr (Ptr DBusPropertyInfo)
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo -> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO ()) -> IO ())
-> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Ptr (Ptr (Ptr DBusPropertyInfo))
-> Ptr (Ptr DBusPropertyInfo) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr (Ptr (Ptr DBusPropertyInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (Ptr (Ptr DBusPropertyInfo)
val :: Ptr (Ptr Gio.DBusPropertyInfo.DBusPropertyInfo))

-- | Set the value of the “@properties@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #properties
-- @
clearDBusInterfaceInfoProperties :: MonadIO m => DBusInterfaceInfo -> m ()
clearDBusInterfaceInfoProperties :: forall (m :: * -> *). MonadIO m => DBusInterfaceInfo -> m ()
clearDBusInterfaceInfoProperties DBusInterfaceInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo -> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO ()) -> IO ())
-> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Ptr (Ptr (Ptr DBusPropertyInfo))
-> Ptr (Ptr DBusPropertyInfo) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr (Ptr (Ptr DBusPropertyInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (Ptr (Ptr DBusPropertyInfo)
forall a. Ptr a
FP.nullPtr :: Ptr (Ptr Gio.DBusPropertyInfo.DBusPropertyInfo))

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceInfoPropertiesFieldInfo
instance AttrInfo DBusInterfaceInfoPropertiesFieldInfo where
    type AttrBaseTypeConstraint DBusInterfaceInfoPropertiesFieldInfo = (~) DBusInterfaceInfo
    type AttrAllowedOps DBusInterfaceInfoPropertiesFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint DBusInterfaceInfoPropertiesFieldInfo = (~) (Ptr (Ptr Gio.DBusPropertyInfo.DBusPropertyInfo))
    type AttrTransferTypeConstraint DBusInterfaceInfoPropertiesFieldInfo = (~)(Ptr (Ptr Gio.DBusPropertyInfo.DBusPropertyInfo))
    type AttrTransferType DBusInterfaceInfoPropertiesFieldInfo = (Ptr (Ptr Gio.DBusPropertyInfo.DBusPropertyInfo))
    type AttrGetType DBusInterfaceInfoPropertiesFieldInfo = Maybe [Gio.DBusPropertyInfo.DBusPropertyInfo]
    type AttrLabel DBusInterfaceInfoPropertiesFieldInfo = "properties"
    type AttrOrigin DBusInterfaceInfoPropertiesFieldInfo = DBusInterfaceInfo
    attrGet = getDBusInterfaceInfoProperties
    attrSet = setDBusInterfaceInfoProperties
    attrConstruct = undefined
    attrClear = clearDBusInterfaceInfoProperties
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.DBusInterfaceInfo.properties"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-DBusInterfaceInfo.html#g:attr:properties"
        })

dBusInterfaceInfo_properties :: AttrLabelProxy "properties"
dBusInterfaceInfo_properties = AttrLabelProxy

#endif


-- | Get the value of the “@annotations@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusInterfaceInfo #annotations
-- @
getDBusInterfaceInfoAnnotations :: MonadIO m => DBusInterfaceInfo -> m (Maybe [Gio.DBusAnnotationInfo.DBusAnnotationInfo])
getDBusInterfaceInfoAnnotations :: forall (m :: * -> *).
MonadIO m =>
DBusInterfaceInfo -> m (Maybe [DBusAnnotationInfo])
getDBusInterfaceInfoAnnotations DBusInterfaceInfo
s = IO (Maybe [DBusAnnotationInfo]) -> m (Maybe [DBusAnnotationInfo])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [DBusAnnotationInfo]) -> m (Maybe [DBusAnnotationInfo]))
-> IO (Maybe [DBusAnnotationInfo])
-> m (Maybe [DBusAnnotationInfo])
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo
-> (Ptr DBusInterfaceInfo -> IO (Maybe [DBusAnnotationInfo]))
-> IO (Maybe [DBusAnnotationInfo])
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO (Maybe [DBusAnnotationInfo]))
 -> IO (Maybe [DBusAnnotationInfo]))
-> (Ptr DBusInterfaceInfo -> IO (Maybe [DBusAnnotationInfo]))
-> IO (Maybe [DBusAnnotationInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Ptr (Ptr DBusAnnotationInfo)
val <- Ptr (Ptr (Ptr DBusAnnotationInfo))
-> IO (Ptr (Ptr DBusAnnotationInfo))
forall a. Storable a => Ptr a -> IO a
peek (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr (Ptr (Ptr DBusAnnotationInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) :: IO (Ptr (Ptr Gio.DBusAnnotationInfo.DBusAnnotationInfo))
    Maybe [DBusAnnotationInfo]
result <- Ptr (Ptr DBusAnnotationInfo)
-> (Ptr (Ptr DBusAnnotationInfo) -> IO [DBusAnnotationInfo])
-> IO (Maybe [DBusAnnotationInfo])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr (Ptr DBusAnnotationInfo)
val ((Ptr (Ptr DBusAnnotationInfo) -> IO [DBusAnnotationInfo])
 -> IO (Maybe [DBusAnnotationInfo]))
-> (Ptr (Ptr DBusAnnotationInfo) -> IO [DBusAnnotationInfo])
-> IO (Maybe [DBusAnnotationInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr DBusAnnotationInfo)
val' -> do
        [Ptr DBusAnnotationInfo]
val'' <- Ptr (Ptr DBusAnnotationInfo) -> IO [Ptr DBusAnnotationInfo]
forall a. Ptr (Ptr a) -> IO [Ptr a]
unpackZeroTerminatedPtrArray Ptr (Ptr DBusAnnotationInfo)
val'
        [DBusAnnotationInfo]
val''' <- (Ptr DBusAnnotationInfo -> IO DBusAnnotationInfo)
-> [Ptr DBusAnnotationInfo] -> IO [DBusAnnotationInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr DBusAnnotationInfo -> DBusAnnotationInfo)
-> Ptr DBusAnnotationInfo -> IO DBusAnnotationInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DBusAnnotationInfo -> DBusAnnotationInfo
Gio.DBusAnnotationInfo.DBusAnnotationInfo) [Ptr DBusAnnotationInfo]
val''
        [DBusAnnotationInfo] -> IO [DBusAnnotationInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [DBusAnnotationInfo]
val'''
    Maybe [DBusAnnotationInfo] -> IO (Maybe [DBusAnnotationInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [DBusAnnotationInfo]
result

-- | Set the value of the “@annotations@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dBusInterfaceInfo [ #annotations 'Data.GI.Base.Attributes.:=' value ]
-- @
setDBusInterfaceInfoAnnotations :: MonadIO m => DBusInterfaceInfo -> Ptr (Ptr Gio.DBusAnnotationInfo.DBusAnnotationInfo) -> m ()
setDBusInterfaceInfoAnnotations :: forall (m :: * -> *).
MonadIO m =>
DBusInterfaceInfo -> Ptr (Ptr DBusAnnotationInfo) -> m ()
setDBusInterfaceInfoAnnotations DBusInterfaceInfo
s Ptr (Ptr DBusAnnotationInfo)
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo -> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO ()) -> IO ())
-> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Ptr (Ptr (Ptr DBusAnnotationInfo))
-> Ptr (Ptr DBusAnnotationInfo) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr (Ptr (Ptr DBusAnnotationInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (Ptr (Ptr DBusAnnotationInfo)
val :: Ptr (Ptr Gio.DBusAnnotationInfo.DBusAnnotationInfo))

-- | Set the value of the “@annotations@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #annotations
-- @
clearDBusInterfaceInfoAnnotations :: MonadIO m => DBusInterfaceInfo -> m ()
clearDBusInterfaceInfoAnnotations :: forall (m :: * -> *). MonadIO m => DBusInterfaceInfo -> m ()
clearDBusInterfaceInfoAnnotations DBusInterfaceInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusInterfaceInfo -> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusInterfaceInfo
s ((Ptr DBusInterfaceInfo -> IO ()) -> IO ())
-> (Ptr DBusInterfaceInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusInterfaceInfo
ptr -> do
    Ptr (Ptr (Ptr DBusAnnotationInfo))
-> Ptr (Ptr DBusAnnotationInfo) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusInterfaceInfo
ptr Ptr DBusInterfaceInfo -> Int -> Ptr (Ptr (Ptr DBusAnnotationInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (Ptr (Ptr DBusAnnotationInfo)
forall a. Ptr a
FP.nullPtr :: Ptr (Ptr Gio.DBusAnnotationInfo.DBusAnnotationInfo))

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceInfoAnnotationsFieldInfo
instance AttrInfo DBusInterfaceInfoAnnotationsFieldInfo where
    type AttrBaseTypeConstraint DBusInterfaceInfoAnnotationsFieldInfo = (~) DBusInterfaceInfo
    type AttrAllowedOps DBusInterfaceInfoAnnotationsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint DBusInterfaceInfoAnnotationsFieldInfo = (~) (Ptr (Ptr Gio.DBusAnnotationInfo.DBusAnnotationInfo))
    type AttrTransferTypeConstraint DBusInterfaceInfoAnnotationsFieldInfo = (~)(Ptr (Ptr Gio.DBusAnnotationInfo.DBusAnnotationInfo))
    type AttrTransferType DBusInterfaceInfoAnnotationsFieldInfo = (Ptr (Ptr Gio.DBusAnnotationInfo.DBusAnnotationInfo))
    type AttrGetType DBusInterfaceInfoAnnotationsFieldInfo = Maybe [Gio.DBusAnnotationInfo.DBusAnnotationInfo]
    type AttrLabel DBusInterfaceInfoAnnotationsFieldInfo = "annotations"
    type AttrOrigin DBusInterfaceInfoAnnotationsFieldInfo = DBusInterfaceInfo
    attrGet = getDBusInterfaceInfoAnnotations
    attrSet = setDBusInterfaceInfoAnnotations
    attrConstruct = undefined
    attrClear = clearDBusInterfaceInfoAnnotations
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.DBusInterfaceInfo.annotations"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-DBusInterfaceInfo.html#g:attr:annotations"
        })

dBusInterfaceInfo_annotations :: AttrLabelProxy "annotations"
dBusInterfaceInfo_annotations = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DBusInterfaceInfo
type instance O.AttributeList DBusInterfaceInfo = DBusInterfaceInfoAttributeList
type DBusInterfaceInfoAttributeList = ('[ '("refCount", DBusInterfaceInfoRefCountFieldInfo), '("name", DBusInterfaceInfoNameFieldInfo), '("methods", DBusInterfaceInfoMethodsFieldInfo), '("signals", DBusInterfaceInfoSignalsFieldInfo), '("properties", DBusInterfaceInfoPropertiesFieldInfo), '("annotations", DBusInterfaceInfoAnnotationsFieldInfo)] :: [(Symbol, *)])
#endif

-- method DBusInterfaceInfo::cache_build
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusInterfaceInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusInterfaceInfo."
--                 , 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_info_cache_build" g_dbus_interface_info_cache_build :: 
    Ptr DBusInterfaceInfo ->                -- info : TInterface (Name {namespace = "Gio", name = "DBusInterfaceInfo"})
    IO ()

-- | Builds a lookup-cache to speed up
-- 'GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoLookupMethod',
-- 'GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoLookupSignal' and
-- 'GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoLookupProperty'.
-- 
-- If this has already been called with /@info@/, the existing cache is
-- used and its use count is increased.
-- 
-- Note that /@info@/ cannot be modified until
-- 'GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoCacheRelease' is called.
-- 
-- /Since: 2.30/
dBusInterfaceInfoCacheBuild ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DBusInterfaceInfo
    -- ^ /@info@/: A t'GI.Gio.Structs.DBusInterfaceInfo.DBusInterfaceInfo'.
    -> m ()
dBusInterfaceInfoCacheBuild :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DBusInterfaceInfo -> m ()
dBusInterfaceInfoCacheBuild DBusInterfaceInfo
info = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusInterfaceInfo
info' <- DBusInterfaceInfo -> IO (Ptr DBusInterfaceInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DBusInterfaceInfo
info
    Ptr DBusInterfaceInfo -> IO ()
g_dbus_interface_info_cache_build Ptr DBusInterfaceInfo
info'
    DBusInterfaceInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DBusInterfaceInfo
info
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceInfoCacheBuildMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod DBusInterfaceInfoCacheBuildMethodInfo DBusInterfaceInfo signature where
    overloadedMethod = dBusInterfaceInfoCacheBuild

instance O.OverloadedMethodInfo DBusInterfaceInfoCacheBuildMethodInfo DBusInterfaceInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoCacheBuild",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-DBusInterfaceInfo.html#v:dBusInterfaceInfoCacheBuild"
        })


#endif

-- method DBusInterfaceInfo::cache_release
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusInterfaceInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A GDBusInterfaceInfo"
--                 , 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_info_cache_release" g_dbus_interface_info_cache_release :: 
    Ptr DBusInterfaceInfo ->                -- info : TInterface (Name {namespace = "Gio", name = "DBusInterfaceInfo"})
    IO ()

-- | Decrements the usage count for the cache for /@info@/ built by
-- 'GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoCacheBuild' (if any) and frees the
-- resources used by the cache if the usage count drops to zero.
-- 
-- /Since: 2.30/
dBusInterfaceInfoCacheRelease ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DBusInterfaceInfo
    -- ^ /@info@/: A GDBusInterfaceInfo
    -> m ()
dBusInterfaceInfoCacheRelease :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DBusInterfaceInfo -> m ()
dBusInterfaceInfoCacheRelease DBusInterfaceInfo
info = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusInterfaceInfo
info' <- DBusInterfaceInfo -> IO (Ptr DBusInterfaceInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DBusInterfaceInfo
info
    Ptr DBusInterfaceInfo -> IO ()
g_dbus_interface_info_cache_release Ptr DBusInterfaceInfo
info'
    DBusInterfaceInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DBusInterfaceInfo
info
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceInfoCacheReleaseMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod DBusInterfaceInfoCacheReleaseMethodInfo DBusInterfaceInfo signature where
    overloadedMethod = dBusInterfaceInfoCacheRelease

instance O.OverloadedMethodInfo DBusInterfaceInfoCacheReleaseMethodInfo DBusInterfaceInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoCacheRelease",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-DBusInterfaceInfo.html#v:dBusInterfaceInfoCacheRelease"
        })


#endif

-- method DBusInterfaceInfo::generate_xml
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusInterfaceInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusNodeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "indent"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Indentation level." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "string_builder"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "String" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GString to to append XML data to."
--                 , 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_info_generate_xml" g_dbus_interface_info_generate_xml :: 
    Ptr DBusInterfaceInfo ->                -- info : TInterface (Name {namespace = "Gio", name = "DBusInterfaceInfo"})
    Word32 ->                               -- indent : TBasicType TUInt
    Ptr GLib.String.String ->               -- string_builder : TInterface (Name {namespace = "GLib", name = "String"})
    IO ()

-- | Appends an XML representation of /@info@/ (and its children) to /@stringBuilder@/.
-- 
-- This function is typically used for generating introspection XML
-- documents at run-time for handling the
-- @org.freedesktop.DBus.Introspectable.Introspect@
-- method.
-- 
-- /Since: 2.26/
dBusInterfaceInfoGenerateXml ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DBusInterfaceInfo
    -- ^ /@info@/: A t'GI.Gio.Structs.DBusNodeInfo.DBusNodeInfo'
    -> Word32
    -- ^ /@indent@/: Indentation level.
    -> GLib.String.String
    -- ^ /@stringBuilder@/: A t'GI.GLib.Structs.String.String' to to append XML data to.
    -> m ()
dBusInterfaceInfoGenerateXml :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DBusInterfaceInfo -> Word32 -> String -> m ()
dBusInterfaceInfoGenerateXml DBusInterfaceInfo
info Word32
indent String
stringBuilder = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusInterfaceInfo
info' <- DBusInterfaceInfo -> IO (Ptr DBusInterfaceInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DBusInterfaceInfo
info
    Ptr String
stringBuilder' <- String -> IO (Ptr String)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr String
stringBuilder
    Ptr DBusInterfaceInfo -> Word32 -> Ptr String -> IO ()
g_dbus_interface_info_generate_xml Ptr DBusInterfaceInfo
info' Word32
indent Ptr String
stringBuilder'
    DBusInterfaceInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DBusInterfaceInfo
info
    String -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr String
stringBuilder
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceInfoGenerateXmlMethodInfo
instance (signature ~ (Word32 -> GLib.String.String -> m ()), MonadIO m) => O.OverloadedMethod DBusInterfaceInfoGenerateXmlMethodInfo DBusInterfaceInfo signature where
    overloadedMethod = dBusInterfaceInfoGenerateXml

instance O.OverloadedMethodInfo DBusInterfaceInfoGenerateXmlMethodInfo DBusInterfaceInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoGenerateXml",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-DBusInterfaceInfo.html#v:dBusInterfaceInfoGenerateXml"
        })


#endif

-- method DBusInterfaceInfo::lookup_method
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusInterfaceInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusInterfaceInfo."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A D-Bus method name (typically in CamelCase)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "DBusMethodInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_interface_info_lookup_method" g_dbus_interface_info_lookup_method :: 
    Ptr DBusInterfaceInfo ->                -- info : TInterface (Name {namespace = "Gio", name = "DBusInterfaceInfo"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Gio.DBusMethodInfo.DBusMethodInfo)

-- | Looks up information about a method.
-- 
-- The cost of this function is O(n) in number of methods unless
-- 'GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoCacheBuild' has been used on /@info@/.
-- 
-- /Since: 2.26/
dBusInterfaceInfoLookupMethod ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DBusInterfaceInfo
    -- ^ /@info@/: A t'GI.Gio.Structs.DBusInterfaceInfo.DBusInterfaceInfo'.
    -> T.Text
    -- ^ /@name@/: A D-Bus method name (typically in CamelCase)
    -> m (Maybe Gio.DBusMethodInfo.DBusMethodInfo)
    -- ^ __Returns:__ A t'GI.Gio.Structs.DBusMethodInfo.DBusMethodInfo' or 'P.Nothing' if not found. Do not free, it is owned by /@info@/.
dBusInterfaceInfoLookupMethod :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DBusInterfaceInfo -> Text -> m (Maybe DBusMethodInfo)
dBusInterfaceInfoLookupMethod DBusInterfaceInfo
info Text
name = IO (Maybe DBusMethodInfo) -> m (Maybe DBusMethodInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DBusMethodInfo) -> m (Maybe DBusMethodInfo))
-> IO (Maybe DBusMethodInfo) -> m (Maybe DBusMethodInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusInterfaceInfo
info' <- DBusInterfaceInfo -> IO (Ptr DBusInterfaceInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DBusInterfaceInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr DBusMethodInfo
result <- Ptr DBusInterfaceInfo -> CString -> IO (Ptr DBusMethodInfo)
g_dbus_interface_info_lookup_method Ptr DBusInterfaceInfo
info' CString
name'
    Maybe DBusMethodInfo
maybeResult <- Ptr DBusMethodInfo
-> (Ptr DBusMethodInfo -> IO DBusMethodInfo)
-> IO (Maybe DBusMethodInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DBusMethodInfo
result ((Ptr DBusMethodInfo -> IO DBusMethodInfo)
 -> IO (Maybe DBusMethodInfo))
-> (Ptr DBusMethodInfo -> IO DBusMethodInfo)
-> IO (Maybe DBusMethodInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr DBusMethodInfo
result' -> do
        DBusMethodInfo
result'' <- ((ManagedPtr DBusMethodInfo -> DBusMethodInfo)
-> Ptr DBusMethodInfo -> IO DBusMethodInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DBusMethodInfo -> DBusMethodInfo
Gio.DBusMethodInfo.DBusMethodInfo) Ptr DBusMethodInfo
result'
        DBusMethodInfo -> IO DBusMethodInfo
forall (m :: * -> *) a. Monad m => a -> m a
return DBusMethodInfo
result''
    DBusInterfaceInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DBusInterfaceInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Maybe DBusMethodInfo -> IO (Maybe DBusMethodInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DBusMethodInfo
maybeResult

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceInfoLookupMethodMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gio.DBusMethodInfo.DBusMethodInfo)), MonadIO m) => O.OverloadedMethod DBusInterfaceInfoLookupMethodMethodInfo DBusInterfaceInfo signature where
    overloadedMethod = dBusInterfaceInfoLookupMethod

instance O.OverloadedMethodInfo DBusInterfaceInfoLookupMethodMethodInfo DBusInterfaceInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoLookupMethod",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-DBusInterfaceInfo.html#v:dBusInterfaceInfoLookupMethod"
        })


#endif

-- method DBusInterfaceInfo::lookup_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusInterfaceInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusInterfaceInfo."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A D-Bus property name (typically in CamelCase)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "DBusPropertyInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_interface_info_lookup_property" g_dbus_interface_info_lookup_property :: 
    Ptr DBusInterfaceInfo ->                -- info : TInterface (Name {namespace = "Gio", name = "DBusInterfaceInfo"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Gio.DBusPropertyInfo.DBusPropertyInfo)

-- | Looks up information about a property.
-- 
-- The cost of this function is O(n) in number of properties unless
-- 'GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoCacheBuild' has been used on /@info@/.
-- 
-- /Since: 2.26/
dBusInterfaceInfoLookupProperty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DBusInterfaceInfo
    -- ^ /@info@/: A t'GI.Gio.Structs.DBusInterfaceInfo.DBusInterfaceInfo'.
    -> T.Text
    -- ^ /@name@/: A D-Bus property name (typically in CamelCase).
    -> m (Maybe Gio.DBusPropertyInfo.DBusPropertyInfo)
    -- ^ __Returns:__ A t'GI.Gio.Structs.DBusPropertyInfo.DBusPropertyInfo' or 'P.Nothing' if not found. Do not free, it is owned by /@info@/.
dBusInterfaceInfoLookupProperty :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DBusInterfaceInfo -> Text -> m (Maybe DBusPropertyInfo)
dBusInterfaceInfoLookupProperty DBusInterfaceInfo
info Text
name = IO (Maybe DBusPropertyInfo) -> m (Maybe DBusPropertyInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DBusPropertyInfo) -> m (Maybe DBusPropertyInfo))
-> IO (Maybe DBusPropertyInfo) -> m (Maybe DBusPropertyInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusInterfaceInfo
info' <- DBusInterfaceInfo -> IO (Ptr DBusInterfaceInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DBusInterfaceInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr DBusPropertyInfo
result <- Ptr DBusInterfaceInfo -> CString -> IO (Ptr DBusPropertyInfo)
g_dbus_interface_info_lookup_property Ptr DBusInterfaceInfo
info' CString
name'
    Maybe DBusPropertyInfo
maybeResult <- Ptr DBusPropertyInfo
-> (Ptr DBusPropertyInfo -> IO DBusPropertyInfo)
-> IO (Maybe DBusPropertyInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DBusPropertyInfo
result ((Ptr DBusPropertyInfo -> IO DBusPropertyInfo)
 -> IO (Maybe DBusPropertyInfo))
-> (Ptr DBusPropertyInfo -> IO DBusPropertyInfo)
-> IO (Maybe DBusPropertyInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr DBusPropertyInfo
result' -> do
        DBusPropertyInfo
result'' <- ((ManagedPtr DBusPropertyInfo -> DBusPropertyInfo)
-> Ptr DBusPropertyInfo -> IO DBusPropertyInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DBusPropertyInfo -> DBusPropertyInfo
Gio.DBusPropertyInfo.DBusPropertyInfo) Ptr DBusPropertyInfo
result'
        DBusPropertyInfo -> IO DBusPropertyInfo
forall (m :: * -> *) a. Monad m => a -> m a
return DBusPropertyInfo
result''
    DBusInterfaceInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DBusInterfaceInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Maybe DBusPropertyInfo -> IO (Maybe DBusPropertyInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DBusPropertyInfo
maybeResult

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceInfoLookupPropertyMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gio.DBusPropertyInfo.DBusPropertyInfo)), MonadIO m) => O.OverloadedMethod DBusInterfaceInfoLookupPropertyMethodInfo DBusInterfaceInfo signature where
    overloadedMethod = dBusInterfaceInfoLookupProperty

instance O.OverloadedMethodInfo DBusInterfaceInfoLookupPropertyMethodInfo DBusInterfaceInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoLookupProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-DBusInterfaceInfo.html#v:dBusInterfaceInfoLookupProperty"
        })


#endif

-- method DBusInterfaceInfo::lookup_signal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusInterfaceInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusInterfaceInfo."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A D-Bus signal name (typically in CamelCase)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "DBusSignalInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_interface_info_lookup_signal" g_dbus_interface_info_lookup_signal :: 
    Ptr DBusInterfaceInfo ->                -- info : TInterface (Name {namespace = "Gio", name = "DBusInterfaceInfo"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Gio.DBusSignalInfo.DBusSignalInfo)

-- | Looks up information about a signal.
-- 
-- The cost of this function is O(n) in number of signals unless
-- 'GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoCacheBuild' has been used on /@info@/.
-- 
-- /Since: 2.26/
dBusInterfaceInfoLookupSignal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DBusInterfaceInfo
    -- ^ /@info@/: A t'GI.Gio.Structs.DBusInterfaceInfo.DBusInterfaceInfo'.
    -> T.Text
    -- ^ /@name@/: A D-Bus signal name (typically in CamelCase)
    -> m (Maybe Gio.DBusSignalInfo.DBusSignalInfo)
    -- ^ __Returns:__ A t'GI.Gio.Structs.DBusSignalInfo.DBusSignalInfo' or 'P.Nothing' if not found. Do not free, it is owned by /@info@/.
dBusInterfaceInfoLookupSignal :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DBusInterfaceInfo -> Text -> m (Maybe DBusSignalInfo)
dBusInterfaceInfoLookupSignal DBusInterfaceInfo
info Text
name = IO (Maybe DBusSignalInfo) -> m (Maybe DBusSignalInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DBusSignalInfo) -> m (Maybe DBusSignalInfo))
-> IO (Maybe DBusSignalInfo) -> m (Maybe DBusSignalInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusInterfaceInfo
info' <- DBusInterfaceInfo -> IO (Ptr DBusInterfaceInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DBusInterfaceInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr DBusSignalInfo
result <- Ptr DBusInterfaceInfo -> CString -> IO (Ptr DBusSignalInfo)
g_dbus_interface_info_lookup_signal Ptr DBusInterfaceInfo
info' CString
name'
    Maybe DBusSignalInfo
maybeResult <- Ptr DBusSignalInfo
-> (Ptr DBusSignalInfo -> IO DBusSignalInfo)
-> IO (Maybe DBusSignalInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DBusSignalInfo
result ((Ptr DBusSignalInfo -> IO DBusSignalInfo)
 -> IO (Maybe DBusSignalInfo))
-> (Ptr DBusSignalInfo -> IO DBusSignalInfo)
-> IO (Maybe DBusSignalInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr DBusSignalInfo
result' -> do
        DBusSignalInfo
result'' <- ((ManagedPtr DBusSignalInfo -> DBusSignalInfo)
-> Ptr DBusSignalInfo -> IO DBusSignalInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DBusSignalInfo -> DBusSignalInfo
Gio.DBusSignalInfo.DBusSignalInfo) Ptr DBusSignalInfo
result'
        DBusSignalInfo -> IO DBusSignalInfo
forall (m :: * -> *) a. Monad m => a -> m a
return DBusSignalInfo
result''
    DBusInterfaceInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DBusInterfaceInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Maybe DBusSignalInfo -> IO (Maybe DBusSignalInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DBusSignalInfo
maybeResult

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceInfoLookupSignalMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gio.DBusSignalInfo.DBusSignalInfo)), MonadIO m) => O.OverloadedMethod DBusInterfaceInfoLookupSignalMethodInfo DBusInterfaceInfo signature where
    overloadedMethod = dBusInterfaceInfoLookupSignal

instance O.OverloadedMethodInfo DBusInterfaceInfoLookupSignalMethodInfo DBusInterfaceInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoLookupSignal",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-DBusInterfaceInfo.html#v:dBusInterfaceInfoLookupSignal"
        })


#endif

-- method DBusInterfaceInfo::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusInterfaceInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusInterfaceInfo"
--                 , 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_info_ref" g_dbus_interface_info_ref :: 
    Ptr DBusInterfaceInfo ->                -- info : TInterface (Name {namespace = "Gio", name = "DBusInterfaceInfo"})
    IO (Ptr DBusInterfaceInfo)

-- | If /@info@/ is statically allocated does nothing. Otherwise increases
-- the reference count.
-- 
-- /Since: 2.26/
dBusInterfaceInfoRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DBusInterfaceInfo
    -- ^ /@info@/: A t'GI.Gio.Structs.DBusInterfaceInfo.DBusInterfaceInfo'
    -> m DBusInterfaceInfo
    -- ^ __Returns:__ The same /@info@/.
dBusInterfaceInfoRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DBusInterfaceInfo -> m DBusInterfaceInfo
dBusInterfaceInfoRef DBusInterfaceInfo
info = IO DBusInterfaceInfo -> m DBusInterfaceInfo
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 DBusInterfaceInfo
info' <- DBusInterfaceInfo -> IO (Ptr DBusInterfaceInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DBusInterfaceInfo
info
    Ptr DBusInterfaceInfo
result <- Ptr DBusInterfaceInfo -> IO (Ptr DBusInterfaceInfo)
g_dbus_interface_info_ref Ptr DBusInterfaceInfo
info'
    Text -> Ptr DBusInterfaceInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dBusInterfaceInfoRef" Ptr DBusInterfaceInfo
result
    DBusInterfaceInfo
result' <- ((ManagedPtr DBusInterfaceInfo -> DBusInterfaceInfo)
-> Ptr DBusInterfaceInfo -> IO DBusInterfaceInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DBusInterfaceInfo -> DBusInterfaceInfo
DBusInterfaceInfo) Ptr DBusInterfaceInfo
result
    DBusInterfaceInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DBusInterfaceInfo
info
    DBusInterfaceInfo -> IO DBusInterfaceInfo
forall (m :: * -> *) a. Monad m => a -> m a
return DBusInterfaceInfo
result'

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceInfoRefMethodInfo
instance (signature ~ (m DBusInterfaceInfo), MonadIO m) => O.OverloadedMethod DBusInterfaceInfoRefMethodInfo DBusInterfaceInfo signature where
    overloadedMethod = dBusInterfaceInfoRef

instance O.OverloadedMethodInfo DBusInterfaceInfoRefMethodInfo DBusInterfaceInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-DBusInterfaceInfo.html#v:dBusInterfaceInfoRef"
        })


#endif

-- method DBusInterfaceInfo::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusInterfaceInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusInterfaceInfo."
--                 , 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_info_unref" g_dbus_interface_info_unref :: 
    Ptr DBusInterfaceInfo ->                -- info : TInterface (Name {namespace = "Gio", name = "DBusInterfaceInfo"})
    IO ()

-- | If /@info@/ is statically allocated, does nothing. Otherwise decreases
-- the reference count of /@info@/. When its reference count drops to 0,
-- the memory used is freed.
-- 
-- /Since: 2.26/
dBusInterfaceInfoUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DBusInterfaceInfo
    -- ^ /@info@/: A t'GI.Gio.Structs.DBusInterfaceInfo.DBusInterfaceInfo'.
    -> m ()
dBusInterfaceInfoUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DBusInterfaceInfo -> m ()
dBusInterfaceInfoUnref DBusInterfaceInfo
info = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusInterfaceInfo
info' <- DBusInterfaceInfo -> IO (Ptr DBusInterfaceInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DBusInterfaceInfo
info
    Ptr DBusInterfaceInfo -> IO ()
g_dbus_interface_info_unref Ptr DBusInterfaceInfo
info'
    DBusInterfaceInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DBusInterfaceInfo
info
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusInterfaceInfoUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod DBusInterfaceInfoUnrefMethodInfo DBusInterfaceInfo signature where
    overloadedMethod = dBusInterfaceInfoUnref

instance O.OverloadedMethodInfo DBusInterfaceInfoUnrefMethodInfo DBusInterfaceInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.DBusInterfaceInfo.dBusInterfaceInfoUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-DBusInterfaceInfo.html#v:dBusInterfaceInfoUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDBusInterfaceInfoMethod (t :: Symbol) (o :: *) :: * where
    ResolveDBusInterfaceInfoMethod "cacheBuild" o = DBusInterfaceInfoCacheBuildMethodInfo
    ResolveDBusInterfaceInfoMethod "cacheRelease" o = DBusInterfaceInfoCacheReleaseMethodInfo
    ResolveDBusInterfaceInfoMethod "generateXml" o = DBusInterfaceInfoGenerateXmlMethodInfo
    ResolveDBusInterfaceInfoMethod "lookupMethod" o = DBusInterfaceInfoLookupMethodMethodInfo
    ResolveDBusInterfaceInfoMethod "lookupProperty" o = DBusInterfaceInfoLookupPropertyMethodInfo
    ResolveDBusInterfaceInfoMethod "lookupSignal" o = DBusInterfaceInfoLookupSignalMethodInfo
    ResolveDBusInterfaceInfoMethod "ref" o = DBusInterfaceInfoRefMethodInfo
    ResolveDBusInterfaceInfoMethod "unref" o = DBusInterfaceInfoUnrefMethodInfo
    ResolveDBusInterfaceInfoMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif