{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Information about an argument for a method or a signal.
-- 
-- /Since: 2.26/

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

module GI.Gio.Structs.DBusArgInfo
    ( 

-- * Exported types
    DBusArgInfo(..)                         ,
    newZeroDBusArgInfo                      ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveDBusArgInfoMethod                ,
#endif


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    DBusArgInfoRefMethodInfo                ,
#endif
    dBusArgInfoRef                          ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    DBusArgInfoUnrefMethodInfo              ,
#endif
    dBusArgInfoUnref                        ,




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

    clearDBusArgInfoAnnotations             ,
#if defined(ENABLE_OVERLOADING)
    dBusArgInfo_annotations                 ,
#endif
    getDBusArgInfoAnnotations               ,
    setDBusArgInfoAnnotations               ,


-- ** name #attr:name#
-- | Name of the argument, e.g. /@unixUserId@/.

    clearDBusArgInfoName                    ,
#if defined(ENABLE_OVERLOADING)
    dBusArgInfo_name                        ,
#endif
    getDBusArgInfoName                      ,
    setDBusArgInfoName                      ,


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

#if defined(ENABLE_OVERLOADING)
    dBusArgInfo_refCount                    ,
#endif
    getDBusArgInfoRefCount                  ,
    setDBusArgInfoRefCount                  ,


-- ** signature #attr:signature#
-- | D-Bus signature of the argument (a single complete type).

    clearDBusArgInfoSignature               ,
#if defined(ENABLE_OVERLOADING)
    dBusArgInfo_signature                   ,
#endif
    getDBusArgInfoSignature                 ,
    setDBusArgInfoSignature                 ,




    ) 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.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.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 {-# SOURCE #-} qualified GI.Gio.Structs.DBusAnnotationInfo as Gio.DBusAnnotationInfo

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

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

foreign import ccall "g_dbus_arg_info_get_type" c_g_dbus_arg_info_get_type :: 
    IO GType

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

instance B.Types.TypedObject DBusArgInfo where
    glibType :: IO GType
glibType = IO GType
c_g_dbus_arg_info_get_type

instance B.Types.GBoxed DBusArgInfo

-- | Convert 'DBusArgInfo' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue DBusArgInfo where
    toGValue :: DBusArgInfo -> IO GValue
toGValue DBusArgInfo
o = do
        GType
gtype <- IO GType
c_g_dbus_arg_info_get_type
        DBusArgInfo -> (Ptr DBusArgInfo -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DBusArgInfo
o (GType
-> (GValue -> Ptr DBusArgInfo -> IO ())
-> Ptr DBusArgInfo
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr DBusArgInfo -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO DBusArgInfo
fromGValue GValue
gv = do
        Ptr DBusArgInfo
ptr <- GValue -> IO (Ptr DBusArgInfo)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr DBusArgInfo)
        (ManagedPtr DBusArgInfo -> DBusArgInfo)
-> Ptr DBusArgInfo -> IO DBusArgInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr DBusArgInfo -> DBusArgInfo
DBusArgInfo Ptr DBusArgInfo
ptr
        
    

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

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

#if defined(ENABLE_OVERLOADING)
data DBusArgInfoRefCountFieldInfo
instance AttrInfo DBusArgInfoRefCountFieldInfo where
    type AttrBaseTypeConstraint DBusArgInfoRefCountFieldInfo = (~) DBusArgInfo
    type AttrAllowedOps DBusArgInfoRefCountFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DBusArgInfoRefCountFieldInfo = (~) Int32
    type AttrTransferTypeConstraint DBusArgInfoRefCountFieldInfo = (~)Int32
    type AttrTransferType DBusArgInfoRefCountFieldInfo = Int32
    type AttrGetType DBusArgInfoRefCountFieldInfo = Int32
    type AttrLabel DBusArgInfoRefCountFieldInfo = "ref_count"
    type AttrOrigin DBusArgInfoRefCountFieldInfo = DBusArgInfo
    attrGet = getDBusArgInfoRefCount
    attrSet = setDBusArgInfoRefCount
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

dBusArgInfo_refCount :: AttrLabelProxy "refCount"
dBusArgInfo_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' dBusArgInfo #name
-- @
getDBusArgInfoName :: MonadIO m => DBusArgInfo -> m (Maybe T.Text)
getDBusArgInfoName :: DBusArgInfo -> m (Maybe Text)
getDBusArgInfoName DBusArgInfo
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
$ DBusArgInfo
-> (Ptr DBusArgInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusArgInfo
s ((Ptr DBusArgInfo -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr DBusArgInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr DBusArgInfo
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr DBusArgInfo
ptr Ptr DBusArgInfo -> 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' dBusArgInfo [ #name 'Data.GI.Base.Attributes.:=' value ]
-- @
setDBusArgInfoName :: MonadIO m => DBusArgInfo -> CString -> m ()
setDBusArgInfoName :: DBusArgInfo -> CString -> m ()
setDBusArgInfoName DBusArgInfo
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
$ DBusArgInfo -> (Ptr DBusArgInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusArgInfo
s ((Ptr DBusArgInfo -> IO ()) -> IO ())
-> (Ptr DBusArgInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusArgInfo
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusArgInfo
ptr Ptr DBusArgInfo -> 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
-- @
clearDBusArgInfoName :: MonadIO m => DBusArgInfo -> m ()
clearDBusArgInfoName :: DBusArgInfo -> m ()
clearDBusArgInfoName DBusArgInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusArgInfo -> (Ptr DBusArgInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusArgInfo
s ((Ptr DBusArgInfo -> IO ()) -> IO ())
-> (Ptr DBusArgInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusArgInfo
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusArgInfo
ptr Ptr DBusArgInfo -> 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 DBusArgInfoNameFieldInfo
instance AttrInfo DBusArgInfoNameFieldInfo where
    type AttrBaseTypeConstraint DBusArgInfoNameFieldInfo = (~) DBusArgInfo
    type AttrAllowedOps DBusArgInfoNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint DBusArgInfoNameFieldInfo = (~) CString
    type AttrTransferTypeConstraint DBusArgInfoNameFieldInfo = (~)CString
    type AttrTransferType DBusArgInfoNameFieldInfo = CString
    type AttrGetType DBusArgInfoNameFieldInfo = Maybe T.Text
    type AttrLabel DBusArgInfoNameFieldInfo = "name"
    type AttrOrigin DBusArgInfoNameFieldInfo = DBusArgInfo
    attrGet = getDBusArgInfoName
    attrSet = setDBusArgInfoName
    attrConstruct = undefined
    attrClear = clearDBusArgInfoName
    attrTransfer _ v = do
        return v

dBusArgInfo_name :: AttrLabelProxy "name"
dBusArgInfo_name = AttrLabelProxy

#endif


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

-- | Set the value of the “@signature@” 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' #signature
-- @
clearDBusArgInfoSignature :: MonadIO m => DBusArgInfo -> m ()
clearDBusArgInfoSignature :: DBusArgInfo -> m ()
clearDBusArgInfoSignature DBusArgInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusArgInfo -> (Ptr DBusArgInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusArgInfo
s ((Ptr DBusArgInfo -> IO ()) -> IO ())
-> (Ptr DBusArgInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusArgInfo
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusArgInfo
ptr Ptr DBusArgInfo -> 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 DBusArgInfoSignatureFieldInfo
instance AttrInfo DBusArgInfoSignatureFieldInfo where
    type AttrBaseTypeConstraint DBusArgInfoSignatureFieldInfo = (~) DBusArgInfo
    type AttrAllowedOps DBusArgInfoSignatureFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint DBusArgInfoSignatureFieldInfo = (~) CString
    type AttrTransferTypeConstraint DBusArgInfoSignatureFieldInfo = (~)CString
    type AttrTransferType DBusArgInfoSignatureFieldInfo = CString
    type AttrGetType DBusArgInfoSignatureFieldInfo = Maybe T.Text
    type AttrLabel DBusArgInfoSignatureFieldInfo = "signature"
    type AttrOrigin DBusArgInfoSignatureFieldInfo = DBusArgInfo
    attrGet = getDBusArgInfoSignature
    attrSet = setDBusArgInfoSignature
    attrConstruct = undefined
    attrClear = clearDBusArgInfoSignature
    attrTransfer _ v = do
        return v

dBusArgInfo_signature :: AttrLabelProxy "signature"
dBusArgInfo_signature = 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' dBusArgInfo #annotations
-- @
getDBusArgInfoAnnotations :: MonadIO m => DBusArgInfo -> m (Maybe [Gio.DBusAnnotationInfo.DBusAnnotationInfo])
getDBusArgInfoAnnotations :: DBusArgInfo -> m (Maybe [DBusAnnotationInfo])
getDBusArgInfoAnnotations DBusArgInfo
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
$ DBusArgInfo
-> (Ptr DBusArgInfo -> IO (Maybe [DBusAnnotationInfo]))
-> IO (Maybe [DBusAnnotationInfo])
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusArgInfo
s ((Ptr DBusArgInfo -> IO (Maybe [DBusAnnotationInfo]))
 -> IO (Maybe [DBusAnnotationInfo]))
-> (Ptr DBusArgInfo -> IO (Maybe [DBusAnnotationInfo]))
-> IO (Maybe [DBusAnnotationInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr DBusArgInfo
ptr -> do
    Ptr (Ptr DBusAnnotationInfo)
val <- Ptr (Ptr (Ptr DBusAnnotationInfo))
-> IO (Ptr (Ptr DBusAnnotationInfo))
forall a. Storable a => Ptr a -> IO a
peek (Ptr DBusArgInfo
ptr Ptr DBusArgInfo -> Int -> Ptr (Ptr (Ptr DBusAnnotationInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: 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' dBusArgInfo [ #annotations 'Data.GI.Base.Attributes.:=' value ]
-- @
setDBusArgInfoAnnotations :: MonadIO m => DBusArgInfo -> Ptr (Ptr Gio.DBusAnnotationInfo.DBusAnnotationInfo) -> m ()
setDBusArgInfoAnnotations :: DBusArgInfo -> Ptr (Ptr DBusAnnotationInfo) -> m ()
setDBusArgInfoAnnotations DBusArgInfo
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
$ DBusArgInfo -> (Ptr DBusArgInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusArgInfo
s ((Ptr DBusArgInfo -> IO ()) -> IO ())
-> (Ptr DBusArgInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusArgInfo
ptr -> do
    Ptr (Ptr (Ptr DBusAnnotationInfo))
-> Ptr (Ptr DBusAnnotationInfo) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusArgInfo
ptr Ptr DBusArgInfo -> Int -> Ptr (Ptr (Ptr DBusAnnotationInfo))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (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
-- @
clearDBusArgInfoAnnotations :: MonadIO m => DBusArgInfo -> m ()
clearDBusArgInfoAnnotations :: DBusArgInfo -> m ()
clearDBusArgInfoAnnotations DBusArgInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DBusArgInfo -> (Ptr DBusArgInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DBusArgInfo
s ((Ptr DBusArgInfo -> IO ()) -> IO ())
-> (Ptr DBusArgInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DBusArgInfo
ptr -> do
    Ptr (Ptr (Ptr DBusAnnotationInfo))
-> Ptr (Ptr DBusAnnotationInfo) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DBusArgInfo
ptr Ptr DBusArgInfo -> 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 Gio.DBusAnnotationInfo.DBusAnnotationInfo))

#if defined(ENABLE_OVERLOADING)
data DBusArgInfoAnnotationsFieldInfo
instance AttrInfo DBusArgInfoAnnotationsFieldInfo where
    type AttrBaseTypeConstraint DBusArgInfoAnnotationsFieldInfo = (~) DBusArgInfo
    type AttrAllowedOps DBusArgInfoAnnotationsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint DBusArgInfoAnnotationsFieldInfo = (~) (Ptr (Ptr Gio.DBusAnnotationInfo.DBusAnnotationInfo))
    type AttrTransferTypeConstraint DBusArgInfoAnnotationsFieldInfo = (~)(Ptr (Ptr Gio.DBusAnnotationInfo.DBusAnnotationInfo))
    type AttrTransferType DBusArgInfoAnnotationsFieldInfo = (Ptr (Ptr Gio.DBusAnnotationInfo.DBusAnnotationInfo))
    type AttrGetType DBusArgInfoAnnotationsFieldInfo = Maybe [Gio.DBusAnnotationInfo.DBusAnnotationInfo]
    type AttrLabel DBusArgInfoAnnotationsFieldInfo = "annotations"
    type AttrOrigin DBusArgInfoAnnotationsFieldInfo = DBusArgInfo
    attrGet = getDBusArgInfoAnnotations
    attrSet = setDBusArgInfoAnnotations
    attrConstruct = undefined
    attrClear = clearDBusArgInfoAnnotations
    attrTransfer _ v = do
        return v

dBusArgInfo_annotations :: AttrLabelProxy "annotations"
dBusArgInfo_annotations = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DBusArgInfo
type instance O.AttributeList DBusArgInfo = DBusArgInfoAttributeList
type DBusArgInfoAttributeList = ('[ '("refCount", DBusArgInfoRefCountFieldInfo), '("name", DBusArgInfoNameFieldInfo), '("signature", DBusArgInfoSignatureFieldInfo), '("annotations", DBusArgInfoAnnotationsFieldInfo)] :: [(Symbol, *)])
#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data DBusArgInfoRefMethodInfo
instance (signature ~ (m DBusArgInfo), MonadIO m) => O.MethodInfo DBusArgInfoRefMethodInfo DBusArgInfo signature where
    overloadedMethod = dBusArgInfoRef

#endif

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

#if defined(ENABLE_OVERLOADING)
data DBusArgInfoUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo DBusArgInfoUnrefMethodInfo DBusArgInfo signature where
    overloadedMethod = dBusArgInfoUnref

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDBusArgInfoMethod (t :: Symbol) (o :: *) :: * where
    ResolveDBusArgInfoMethod "ref" o = DBusArgInfoRefMethodInfo
    ResolveDBusArgInfoMethod "unref" o = DBusArgInfoUnrefMethodInfo
    ResolveDBusArgInfoMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDBusArgInfoMethod t DBusArgInfo, O.MethodInfo info DBusArgInfo p) => OL.IsLabel t (DBusArgInfo -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif