{-# LANGUAGE TypeApplications #-}


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

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

module GI.Gio.Structs.DBusAnnotationInfo
    ( 

-- * Exported types
    DBusAnnotationInfo(..)                  ,
    newZeroDBusAnnotationInfo               ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDBusAnnotationInfoMethod         ,
#endif

-- ** lookup #method:lookup#

    dBusAnnotationInfoLookup                ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    DBusAnnotationInfoRefMethodInfo         ,
#endif
    dBusAnnotationInfoRef                   ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    DBusAnnotationInfoUnrefMethodInfo       ,
#endif
    dBusAnnotationInfoUnref                 ,




 -- * 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.

    clearDBusAnnotationInfoAnnotations      ,
#if defined(ENABLE_OVERLOADING)
    dBusAnnotationInfo_annotations          ,
#endif
    getDBusAnnotationInfoAnnotations        ,
    setDBusAnnotationInfoAnnotations        ,


-- ** key #attr:key#
-- | The name of the annotation, e.g. \"org.freedesktop.DBus.Deprecated\".

    clearDBusAnnotationInfoKey              ,
#if defined(ENABLE_OVERLOADING)
    dBusAnnotationInfo_key                  ,
#endif
    getDBusAnnotationInfoKey                ,
    setDBusAnnotationInfoKey                ,


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

#if defined(ENABLE_OVERLOADING)
    dBusAnnotationInfo_refCount             ,
#endif
    getDBusAnnotationInfoRefCount           ,
    setDBusAnnotationInfoRefCount           ,


-- ** value #attr:value#
-- | The value of the annotation.

    clearDBusAnnotationInfoValue            ,
#if defined(ENABLE_OVERLOADING)
    dBusAnnotationInfo_value                ,
#endif
    getDBusAnnotationInfoValue              ,
    setDBusAnnotationInfoValue              ,




    ) 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


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

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

foreign import ccall "g_dbus_annotation_info_get_type" c_g_dbus_annotation_info_get_type :: 
    IO GType

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

instance B.Types.TypedObject DBusAnnotationInfo where
    glibType :: IO GType
glibType = IO GType
c_g_dbus_annotation_info_get_type

instance B.Types.GBoxed DBusAnnotationInfo

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

-- | Construct a `DBusAnnotationInfo` struct initialized to zero.
newZeroDBusAnnotationInfo :: MonadIO m => m DBusAnnotationInfo
newZeroDBusAnnotationInfo :: forall (m :: * -> *). MonadIO m => m DBusAnnotationInfo
newZeroDBusAnnotationInfo = IO DBusAnnotationInfo -> m DBusAnnotationInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DBusAnnotationInfo -> m DBusAnnotationInfo)
-> IO DBusAnnotationInfo -> m DBusAnnotationInfo
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr DBusAnnotationInfo)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
32 IO (Ptr DBusAnnotationInfo)
-> (Ptr DBusAnnotationInfo -> IO DBusAnnotationInfo)
-> IO DBusAnnotationInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr DBusAnnotationInfo -> DBusAnnotationInfo)
-> Ptr DBusAnnotationInfo -> IO DBusAnnotationInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DBusAnnotationInfo -> DBusAnnotationInfo
DBusAnnotationInfo

instance tag ~ 'AttrSet => Constructible DBusAnnotationInfo tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr DBusAnnotationInfo -> DBusAnnotationInfo)
-> [AttrOp DBusAnnotationInfo tag] -> m DBusAnnotationInfo
new ManagedPtr DBusAnnotationInfo -> DBusAnnotationInfo
_ [AttrOp DBusAnnotationInfo tag]
attrs = do
        DBusAnnotationInfo
o <- m DBusAnnotationInfo
forall (m :: * -> *). MonadIO m => m DBusAnnotationInfo
newZeroDBusAnnotationInfo
        DBusAnnotationInfo -> [AttrOp DBusAnnotationInfo 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set DBusAnnotationInfo
o [AttrOp DBusAnnotationInfo tag]
[AttrOp DBusAnnotationInfo 'AttrSet]
attrs
        DBusAnnotationInfo -> m DBusAnnotationInfo
forall (m :: * -> *) a. Monad m => a -> m a
return DBusAnnotationInfo
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' dBusAnnotationInfo #refCount
-- @
getDBusAnnotationInfoRefCount :: MonadIO m => DBusAnnotationInfo -> m Int32
getDBusAnnotationInfoRefCount :: forall (m :: * -> *). MonadIO m => DBusAnnotationInfo -> m Int32
getDBusAnnotationInfoRefCount DBusAnnotationInfo
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
$ DBusAnnotationInfo
-> (Ptr DBusAnnotationInfo -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusAnnotationInfo
s ((Ptr DBusAnnotationInfo -> IO Int32) -> IO Int32)
-> (Ptr DBusAnnotationInfo -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr DBusAnnotationInfo
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr DBusAnnotationInfo
ptr Ptr DBusAnnotationInfo -> 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' dBusAnnotationInfo [ #refCount 'Data.GI.Base.Attributes.:=' value ]
-- @
setDBusAnnotationInfoRefCount :: MonadIO m => DBusAnnotationInfo -> Int32 -> m ()
setDBusAnnotationInfoRefCount :: forall (m :: * -> *).
MonadIO m =>
DBusAnnotationInfo -> Int32 -> m ()
setDBusAnnotationInfoRefCount DBusAnnotationInfo
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
$ DBusAnnotationInfo -> (Ptr DBusAnnotationInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusAnnotationInfo
s ((Ptr DBusAnnotationInfo -> IO ()) -> IO ())
-> (Ptr DBusAnnotationInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusAnnotationInfo
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusAnnotationInfo
ptr Ptr DBusAnnotationInfo -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Int32
val :: Int32)

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

dBusAnnotationInfo_refCount :: AttrLabelProxy "refCount"
dBusAnnotationInfo_refCount = AttrLabelProxy

#endif


-- | Get the value of the “@key@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusAnnotationInfo #key
-- @
getDBusAnnotationInfoKey :: MonadIO m => DBusAnnotationInfo -> m (Maybe T.Text)
getDBusAnnotationInfoKey :: forall (m :: * -> *).
MonadIO m =>
DBusAnnotationInfo -> m (Maybe Text)
getDBusAnnotationInfoKey DBusAnnotationInfo
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
$ DBusAnnotationInfo
-> (Ptr DBusAnnotationInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusAnnotationInfo
s ((Ptr DBusAnnotationInfo -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr DBusAnnotationInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr DBusAnnotationInfo
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr DBusAnnotationInfo
ptr Ptr DBusAnnotationInfo -> 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 “@key@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dBusAnnotationInfo [ #key 'Data.GI.Base.Attributes.:=' value ]
-- @
setDBusAnnotationInfoKey :: MonadIO m => DBusAnnotationInfo -> CString -> m ()
setDBusAnnotationInfoKey :: forall (m :: * -> *).
MonadIO m =>
DBusAnnotationInfo -> CString -> m ()
setDBusAnnotationInfoKey DBusAnnotationInfo
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
$ DBusAnnotationInfo -> (Ptr DBusAnnotationInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusAnnotationInfo
s ((Ptr DBusAnnotationInfo -> IO ()) -> IO ())
-> (Ptr DBusAnnotationInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusAnnotationInfo
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusAnnotationInfo
ptr Ptr DBusAnnotationInfo -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
val :: CString)

-- | Set the value of the “@key@” 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' #key
-- @
clearDBusAnnotationInfoKey :: MonadIO m => DBusAnnotationInfo -> m ()
clearDBusAnnotationInfoKey :: forall (m :: * -> *). MonadIO m => DBusAnnotationInfo -> m ()
clearDBusAnnotationInfoKey DBusAnnotationInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusAnnotationInfo -> (Ptr DBusAnnotationInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusAnnotationInfo
s ((Ptr DBusAnnotationInfo -> IO ()) -> IO ())
-> (Ptr DBusAnnotationInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusAnnotationInfo
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusAnnotationInfo
ptr Ptr DBusAnnotationInfo -> 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 DBusAnnotationInfoKeyFieldInfo
instance AttrInfo DBusAnnotationInfoKeyFieldInfo where
    type AttrBaseTypeConstraint DBusAnnotationInfoKeyFieldInfo = (~) DBusAnnotationInfo
    type AttrAllowedOps DBusAnnotationInfoKeyFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint DBusAnnotationInfoKeyFieldInfo = (~) CString
    type AttrTransferTypeConstraint DBusAnnotationInfoKeyFieldInfo = (~)CString
    type AttrTransferType DBusAnnotationInfoKeyFieldInfo = CString
    type AttrGetType DBusAnnotationInfoKeyFieldInfo = Maybe T.Text
    type AttrLabel DBusAnnotationInfoKeyFieldInfo = "key"
    type AttrOrigin DBusAnnotationInfoKeyFieldInfo = DBusAnnotationInfo
    attrGet = getDBusAnnotationInfoKey
    attrSet = setDBusAnnotationInfoKey
    attrConstruct = undefined
    attrClear = clearDBusAnnotationInfoKey
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.DBusAnnotationInfo.key"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-DBusAnnotationInfo.html#g:attr:key"
        })

dBusAnnotationInfo_key :: AttrLabelProxy "key"
dBusAnnotationInfo_key = AttrLabelProxy

#endif


-- | Get the value of the “@value@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dBusAnnotationInfo #value
-- @
getDBusAnnotationInfoValue :: MonadIO m => DBusAnnotationInfo -> m (Maybe T.Text)
getDBusAnnotationInfoValue :: forall (m :: * -> *).
MonadIO m =>
DBusAnnotationInfo -> m (Maybe Text)
getDBusAnnotationInfoValue DBusAnnotationInfo
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
$ DBusAnnotationInfo
-> (Ptr DBusAnnotationInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusAnnotationInfo
s ((Ptr DBusAnnotationInfo -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr DBusAnnotationInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr DBusAnnotationInfo
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr DBusAnnotationInfo
ptr Ptr DBusAnnotationInfo -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: 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 “@value@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dBusAnnotationInfo [ #value 'Data.GI.Base.Attributes.:=' value ]
-- @
setDBusAnnotationInfoValue :: MonadIO m => DBusAnnotationInfo -> CString -> m ()
setDBusAnnotationInfoValue :: forall (m :: * -> *).
MonadIO m =>
DBusAnnotationInfo -> CString -> m ()
setDBusAnnotationInfoValue DBusAnnotationInfo
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
$ DBusAnnotationInfo -> (Ptr DBusAnnotationInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusAnnotationInfo
s ((Ptr DBusAnnotationInfo -> IO ()) -> IO ())
-> (Ptr DBusAnnotationInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusAnnotationInfo
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusAnnotationInfo
ptr Ptr DBusAnnotationInfo -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
val :: CString)

-- | Set the value of the “@value@” 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' #value
-- @
clearDBusAnnotationInfoValue :: MonadIO m => DBusAnnotationInfo -> m ()
clearDBusAnnotationInfoValue :: forall (m :: * -> *). MonadIO m => DBusAnnotationInfo -> m ()
clearDBusAnnotationInfoValue DBusAnnotationInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusAnnotationInfo -> (Ptr DBusAnnotationInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusAnnotationInfo
s ((Ptr DBusAnnotationInfo -> IO ()) -> IO ())
-> (Ptr DBusAnnotationInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusAnnotationInfo
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusAnnotationInfo
ptr Ptr DBusAnnotationInfo -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
forall a. Ptr a
FP.nullPtr :: CString)

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

dBusAnnotationInfo_value :: AttrLabelProxy "value"
dBusAnnotationInfo_value = 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' dBusAnnotationInfo #annotations
-- @
getDBusAnnotationInfoAnnotations :: MonadIO m => DBusAnnotationInfo -> m (Maybe [DBusAnnotationInfo])
getDBusAnnotationInfoAnnotations :: forall (m :: * -> *).
MonadIO m =>
DBusAnnotationInfo -> m (Maybe [DBusAnnotationInfo])
getDBusAnnotationInfoAnnotations DBusAnnotationInfo
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
$ DBusAnnotationInfo
-> (Ptr DBusAnnotationInfo -> IO (Maybe [DBusAnnotationInfo]))
-> IO (Maybe [DBusAnnotationInfo])
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusAnnotationInfo
s ((Ptr DBusAnnotationInfo -> IO (Maybe [DBusAnnotationInfo]))
 -> IO (Maybe [DBusAnnotationInfo]))
-> (Ptr DBusAnnotationInfo -> IO (Maybe [DBusAnnotationInfo]))
-> IO (Maybe [DBusAnnotationInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr DBusAnnotationInfo
ptr -> do
    Ptr (Ptr DBusAnnotationInfo)
val <- Ptr (Ptr (Ptr DBusAnnotationInfo))
-> IO (Ptr (Ptr DBusAnnotationInfo))
forall a. Storable a => Ptr a -> IO a
peek (Ptr DBusAnnotationInfo
ptr Ptr DBusAnnotationInfo -> Int -> Ptr (Ptr (Ptr DBusAnnotationInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO (Ptr (Ptr 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
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' dBusAnnotationInfo [ #annotations 'Data.GI.Base.Attributes.:=' value ]
-- @
setDBusAnnotationInfoAnnotations :: MonadIO m => DBusAnnotationInfo -> Ptr (Ptr DBusAnnotationInfo) -> m ()
setDBusAnnotationInfoAnnotations :: forall (m :: * -> *).
MonadIO m =>
DBusAnnotationInfo -> Ptr (Ptr DBusAnnotationInfo) -> m ()
setDBusAnnotationInfoAnnotations DBusAnnotationInfo
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
$ DBusAnnotationInfo -> (Ptr DBusAnnotationInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusAnnotationInfo
s ((Ptr DBusAnnotationInfo -> IO ()) -> IO ())
-> (Ptr DBusAnnotationInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusAnnotationInfo
ptr -> do
    Ptr (Ptr (Ptr DBusAnnotationInfo))
-> Ptr (Ptr DBusAnnotationInfo) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusAnnotationInfo
ptr Ptr DBusAnnotationInfo -> Int -> Ptr (Ptr (Ptr DBusAnnotationInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (Ptr (Ptr DBusAnnotationInfo)
val :: Ptr (Ptr 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
-- @
clearDBusAnnotationInfoAnnotations :: MonadIO m => DBusAnnotationInfo -> m ()
clearDBusAnnotationInfoAnnotations :: forall (m :: * -> *). MonadIO m => DBusAnnotationInfo -> m ()
clearDBusAnnotationInfoAnnotations DBusAnnotationInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusAnnotationInfo -> (Ptr DBusAnnotationInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusAnnotationInfo
s ((Ptr DBusAnnotationInfo -> IO ()) -> IO ())
-> (Ptr DBusAnnotationInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusAnnotationInfo
ptr -> do
    Ptr (Ptr (Ptr DBusAnnotationInfo))
-> Ptr (Ptr DBusAnnotationInfo) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusAnnotationInfo
ptr Ptr DBusAnnotationInfo -> Int -> Ptr (Ptr (Ptr DBusAnnotationInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (Ptr (Ptr DBusAnnotationInfo)
forall a. Ptr a
FP.nullPtr :: Ptr (Ptr DBusAnnotationInfo))

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

dBusAnnotationInfo_annotations :: AttrLabelProxy "annotations"
dBusAnnotationInfo_annotations = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DBusAnnotationInfo
type instance O.AttributeList DBusAnnotationInfo = DBusAnnotationInfoAttributeList
type DBusAnnotationInfoAttributeList = ('[ '("refCount", DBusAnnotationInfoRefCountFieldInfo), '("key", DBusAnnotationInfoKeyFieldInfo), '("value", DBusAnnotationInfoValueFieldInfo), '("annotations", DBusAnnotationInfoAnnotationsFieldInfo)] :: [(Symbol, *)])
#endif

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

foreign import ccall "g_dbus_annotation_info_ref" g_dbus_annotation_info_ref :: 
    Ptr DBusAnnotationInfo ->               -- info : TInterface (Name {namespace = "Gio", name = "DBusAnnotationInfo"})
    IO (Ptr DBusAnnotationInfo)

-- | If /@info@/ is statically allocated does nothing. Otherwise increases
-- the reference count.
-- 
-- /Since: 2.26/
dBusAnnotationInfoRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DBusAnnotationInfo
    -- ^ /@info@/: A t'GI.Gio.Structs.DBusNodeInfo.DBusNodeInfo'
    -> m DBusAnnotationInfo
    -- ^ __Returns:__ The same /@info@/.
dBusAnnotationInfoRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DBusAnnotationInfo -> m DBusAnnotationInfo
dBusAnnotationInfoRef DBusAnnotationInfo
info = IO DBusAnnotationInfo -> m DBusAnnotationInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DBusAnnotationInfo -> m DBusAnnotationInfo)
-> IO DBusAnnotationInfo -> m DBusAnnotationInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusAnnotationInfo
info' <- DBusAnnotationInfo -> IO (Ptr DBusAnnotationInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DBusAnnotationInfo
info
    Ptr DBusAnnotationInfo
result <- Ptr DBusAnnotationInfo -> IO (Ptr DBusAnnotationInfo)
g_dbus_annotation_info_ref Ptr DBusAnnotationInfo
info'
    Text -> Ptr DBusAnnotationInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dBusAnnotationInfoRef" Ptr DBusAnnotationInfo
result
    DBusAnnotationInfo
result' <- ((ManagedPtr DBusAnnotationInfo -> DBusAnnotationInfo)
-> Ptr DBusAnnotationInfo -> IO DBusAnnotationInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DBusAnnotationInfo -> DBusAnnotationInfo
DBusAnnotationInfo) Ptr DBusAnnotationInfo
result
    DBusAnnotationInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DBusAnnotationInfo
info
    DBusAnnotationInfo -> IO DBusAnnotationInfo
forall (m :: * -> *) a. Monad m => a -> m a
return DBusAnnotationInfo
result'

#if defined(ENABLE_OVERLOADING)
data DBusAnnotationInfoRefMethodInfo
instance (signature ~ (m DBusAnnotationInfo), MonadIO m) => O.OverloadedMethod DBusAnnotationInfoRefMethodInfo DBusAnnotationInfo signature where
    overloadedMethod = dBusAnnotationInfoRef

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


#endif

-- method DBusAnnotationInfo::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusAnnotationInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GDBusAnnotationInfo."
--                 , 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_annotation_info_unref" g_dbus_annotation_info_unref :: 
    Ptr DBusAnnotationInfo ->               -- info : TInterface (Name {namespace = "Gio", name = "DBusAnnotationInfo"})
    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/
dBusAnnotationInfoUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DBusAnnotationInfo
    -- ^ /@info@/: A t'GI.Gio.Structs.DBusAnnotationInfo.DBusAnnotationInfo'.
    -> m ()
dBusAnnotationInfoUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DBusAnnotationInfo -> m ()
dBusAnnotationInfoUnref DBusAnnotationInfo
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 DBusAnnotationInfo
info' <- DBusAnnotationInfo -> IO (Ptr DBusAnnotationInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DBusAnnotationInfo
info
    Ptr DBusAnnotationInfo -> IO ()
g_dbus_annotation_info_unref Ptr DBusAnnotationInfo
info'
    DBusAnnotationInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DBusAnnotationInfo
info
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DBusAnnotationInfoUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod DBusAnnotationInfoUnrefMethodInfo DBusAnnotationInfo signature where
    overloadedMethod = dBusAnnotationInfoUnref

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


#endif

-- method DBusAnnotationInfo::lookup
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "annotations"
--           , argType =
--               TCArray
--                 True
--                 (-1)
--                 (-1)
--                 (TInterface
--                    Name { namespace = "Gio" , name = "DBusAnnotationInfo" })
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A %NULL-terminated array of annotations or %NULL."
--                 , 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 "The name of the annotation to look up."
--                 , 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_annotation_info_lookup" g_dbus_annotation_info_lookup :: 
    Ptr (Ptr DBusAnnotationInfo) ->         -- annotations : TCArray True (-1) (-1) (TInterface (Name {namespace = "Gio", name = "DBusAnnotationInfo"}))
    CString ->                              -- name : TBasicType TUTF8
    IO CString

-- | Looks up the value of an annotation.
-- 
-- The cost of this function is O(n) in number of annotations.
-- 
-- /Since: 2.26/
dBusAnnotationInfoLookup ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe ([DBusAnnotationInfo])
    -- ^ /@annotations@/: A 'P.Nothing'-terminated array of annotations or 'P.Nothing'.
    -> T.Text
    -- ^ /@name@/: The name of the annotation to look up.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The value or 'P.Nothing' if not found. Do not free, it is owned by /@annotations@/.
dBusAnnotationInfoLookup :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe [DBusAnnotationInfo] -> Text -> m (Maybe Text)
dBusAnnotationInfoLookup Maybe [DBusAnnotationInfo]
annotations Text
name = 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
$ do
    Ptr (Ptr DBusAnnotationInfo)
maybeAnnotations <- case Maybe [DBusAnnotationInfo]
annotations of
        Maybe [DBusAnnotationInfo]
Nothing -> Ptr (Ptr DBusAnnotationInfo) -> IO (Ptr (Ptr DBusAnnotationInfo))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr DBusAnnotationInfo)
forall a. Ptr a
nullPtr
        Just [DBusAnnotationInfo]
jAnnotations -> do
            [Ptr DBusAnnotationInfo]
jAnnotations' <- (DBusAnnotationInfo -> IO (Ptr DBusAnnotationInfo))
-> [DBusAnnotationInfo] -> IO [Ptr DBusAnnotationInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM DBusAnnotationInfo -> IO (Ptr DBusAnnotationInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [DBusAnnotationInfo]
jAnnotations
            Ptr (Ptr DBusAnnotationInfo)
jAnnotations'' <- [Ptr DBusAnnotationInfo] -> IO (Ptr (Ptr DBusAnnotationInfo))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packZeroTerminatedPtrArray [Ptr DBusAnnotationInfo]
jAnnotations'
            Ptr (Ptr DBusAnnotationInfo) -> IO (Ptr (Ptr DBusAnnotationInfo))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr DBusAnnotationInfo)
jAnnotations''
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
result <- Ptr (Ptr DBusAnnotationInfo) -> CString -> IO CString
g_dbus_annotation_info_lookup Ptr (Ptr DBusAnnotationInfo)
maybeAnnotations CString
name'
    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 (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Maybe [DBusAnnotationInfo]
-> ([DBusAnnotationInfo] -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe [DBusAnnotationInfo]
annotations ((DBusAnnotationInfo -> IO ()) -> [DBusAnnotationInfo] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DBusAnnotationInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr)
    Ptr (Ptr DBusAnnotationInfo) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr DBusAnnotationInfo)
maybeAnnotations
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDBusAnnotationInfoMethod (t :: Symbol) (o :: *) :: * where
    ResolveDBusAnnotationInfoMethod "ref" o = DBusAnnotationInfoRefMethodInfo
    ResolveDBusAnnotationInfoMethod "unref" o = DBusAnnotationInfoUnrefMethodInfo
    ResolveDBusAnnotationInfoMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif