-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria

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

module GI.GIRepository.Functions
    ( 

 -- * Methods


-- ** argInfoGetClosure #method:argInfoGetClosure#

    argInfoGetClosure                       ,


-- ** argInfoGetDestroy #method:argInfoGetDestroy#

    argInfoGetDestroy                       ,


-- ** argInfoGetDirection #method:argInfoGetDirection#

    argInfoGetDirection                     ,


-- ** argInfoGetOwnershipTransfer #method:argInfoGetOwnershipTransfer#

    argInfoGetOwnershipTransfer             ,


-- ** argInfoGetScope #method:argInfoGetScope#

    argInfoGetScope                         ,


-- ** argInfoGetType #method:argInfoGetType#

    argInfoGetType                          ,


-- ** argInfoIsCallerAllocates #method:argInfoIsCallerAllocates#

    argInfoIsCallerAllocates                ,


-- ** argInfoIsOptional #method:argInfoIsOptional#

    argInfoIsOptional                       ,


-- ** argInfoIsReturnValue #method:argInfoIsReturnValue#

    argInfoIsReturnValue                    ,


-- ** argInfoIsSkip #method:argInfoIsSkip#

    argInfoIsSkip                           ,


-- ** argInfoLoadType #method:argInfoLoadType#

    argInfoLoadType                         ,


-- ** argInfoMayBeNull #method:argInfoMayBeNull#

    argInfoMayBeNull                        ,


-- ** callableInfoCanThrowGerror #method:callableInfoCanThrowGerror#

    callableInfoCanThrowGerror              ,


-- ** callableInfoGetArg #method:callableInfoGetArg#

    callableInfoGetArg                      ,


-- ** callableInfoGetCallerOwns #method:callableInfoGetCallerOwns#

    callableInfoGetCallerOwns               ,


-- ** callableInfoGetInstanceOwnershipTransfer #method:callableInfoGetInstanceOwnershipTransfer#

    callableInfoGetInstanceOwnershipTransfer,


-- ** callableInfoGetNArgs #method:callableInfoGetNArgs#

    callableInfoGetNArgs                    ,


-- ** callableInfoGetReturnAttribute #method:callableInfoGetReturnAttribute#

    callableInfoGetReturnAttribute          ,


-- ** callableInfoGetReturnType #method:callableInfoGetReturnType#

    callableInfoGetReturnType               ,


-- ** callableInfoInvoke #method:callableInfoInvoke#

    callableInfoInvoke                      ,


-- ** callableInfoIsMethod #method:callableInfoIsMethod#

    callableInfoIsMethod                    ,


-- ** callableInfoIterateReturnAttributes #method:callableInfoIterateReturnAttributes#

    callableInfoIterateReturnAttributes     ,


-- ** callableInfoLoadArg #method:callableInfoLoadArg#

    callableInfoLoadArg                     ,


-- ** callableInfoLoadReturnType #method:callableInfoLoadReturnType#

    callableInfoLoadReturnType              ,


-- ** callableInfoMayReturnNull #method:callableInfoMayReturnNull#

    callableInfoMayReturnNull               ,


-- ** callableInfoSkipReturn #method:callableInfoSkipReturn#

    callableInfoSkipReturn                  ,


-- ** cclosureMarshalGeneric #method:cclosureMarshalGeneric#

    cclosureMarshalGeneric                  ,


-- ** constantInfoGetType #method:constantInfoGetType#

    constantInfoGetType                     ,


-- ** enumInfoGetErrorDomain #method:enumInfoGetErrorDomain#

    enumInfoGetErrorDomain                  ,


-- ** enumInfoGetMethod #method:enumInfoGetMethod#

    enumInfoGetMethod                       ,


-- ** enumInfoGetNMethods #method:enumInfoGetNMethods#

    enumInfoGetNMethods                     ,


-- ** enumInfoGetNValues #method:enumInfoGetNValues#

    enumInfoGetNValues                      ,


-- ** enumInfoGetStorageType #method:enumInfoGetStorageType#

    enumInfoGetStorageType                  ,


-- ** enumInfoGetValue #method:enumInfoGetValue#

    enumInfoGetValue                        ,


-- ** fieldInfoGetFlags #method:fieldInfoGetFlags#

    fieldInfoGetFlags                       ,


-- ** fieldInfoGetOffset #method:fieldInfoGetOffset#

    fieldInfoGetOffset                      ,


-- ** fieldInfoGetSize #method:fieldInfoGetSize#

    fieldInfoGetSize                        ,


-- ** fieldInfoGetType #method:fieldInfoGetType#

    fieldInfoGetType                        ,


-- ** functionInfoGetFlags #method:functionInfoGetFlags#

    functionInfoGetFlags                    ,


-- ** functionInfoGetProperty #method:functionInfoGetProperty#

    functionInfoGetProperty                 ,


-- ** functionInfoGetSymbol #method:functionInfoGetSymbol#

    functionInfoGetSymbol                   ,


-- ** functionInfoGetVfunc #method:functionInfoGetVfunc#

    functionInfoGetVfunc                    ,


-- ** getMajorVersion #method:getMajorVersion#

    getMajorVersion                         ,


-- ** getMicroVersion #method:getMicroVersion#

    getMicroVersion                         ,


-- ** getMinorVersion #method:getMinorVersion#

    getMinorVersion                         ,


-- ** infoNew #method:infoNew#

    infoNew                                 ,


-- ** infoTypeToString #method:infoTypeToString#

    infoTypeToString                        ,


-- ** interfaceInfoFindMethod #method:interfaceInfoFindMethod#

    interfaceInfoFindMethod                 ,


-- ** interfaceInfoFindSignal #method:interfaceInfoFindSignal#

    interfaceInfoFindSignal                 ,


-- ** interfaceInfoFindVfunc #method:interfaceInfoFindVfunc#

    interfaceInfoFindVfunc                  ,


-- ** interfaceInfoGetConstant #method:interfaceInfoGetConstant#

    interfaceInfoGetConstant                ,


-- ** interfaceInfoGetIfaceStruct #method:interfaceInfoGetIfaceStruct#

    interfaceInfoGetIfaceStruct             ,


-- ** interfaceInfoGetMethod #method:interfaceInfoGetMethod#

    interfaceInfoGetMethod                  ,


-- ** interfaceInfoGetNConstants #method:interfaceInfoGetNConstants#

    interfaceInfoGetNConstants              ,


-- ** interfaceInfoGetNMethods #method:interfaceInfoGetNMethods#

    interfaceInfoGetNMethods                ,


-- ** interfaceInfoGetNPrerequisites #method:interfaceInfoGetNPrerequisites#

    interfaceInfoGetNPrerequisites          ,


-- ** interfaceInfoGetNProperties #method:interfaceInfoGetNProperties#

    interfaceInfoGetNProperties             ,


-- ** interfaceInfoGetNSignals #method:interfaceInfoGetNSignals#

    interfaceInfoGetNSignals                ,


-- ** interfaceInfoGetNVfuncs #method:interfaceInfoGetNVfuncs#

    interfaceInfoGetNVfuncs                 ,


-- ** interfaceInfoGetPrerequisite #method:interfaceInfoGetPrerequisite#

    interfaceInfoGetPrerequisite            ,


-- ** interfaceInfoGetProperty #method:interfaceInfoGetProperty#

    interfaceInfoGetProperty                ,


-- ** interfaceInfoGetSignal #method:interfaceInfoGetSignal#

    interfaceInfoGetSignal                  ,


-- ** interfaceInfoGetVfunc #method:interfaceInfoGetVfunc#

    interfaceInfoGetVfunc                   ,


-- ** invokeErrorQuark #method:invokeErrorQuark#

    invokeErrorQuark                        ,


-- ** objectInfoFindMethod #method:objectInfoFindMethod#

    objectInfoFindMethod                    ,


-- ** objectInfoFindMethodUsingInterfaces #method:objectInfoFindMethodUsingInterfaces#

    objectInfoFindMethodUsingInterfaces     ,


-- ** objectInfoFindSignal #method:objectInfoFindSignal#

    objectInfoFindSignal                    ,


-- ** objectInfoFindVfunc #method:objectInfoFindVfunc#

    objectInfoFindVfunc                     ,


-- ** objectInfoFindVfuncUsingInterfaces #method:objectInfoFindVfuncUsingInterfaces#

    objectInfoFindVfuncUsingInterfaces      ,


-- ** objectInfoGetAbstract #method:objectInfoGetAbstract#

    objectInfoGetAbstract                   ,


-- ** objectInfoGetClassStruct #method:objectInfoGetClassStruct#

    objectInfoGetClassStruct                ,


-- ** objectInfoGetConstant #method:objectInfoGetConstant#

    objectInfoGetConstant                   ,


-- ** objectInfoGetField #method:objectInfoGetField#

    objectInfoGetField                      ,


-- ** objectInfoGetFinal #method:objectInfoGetFinal#

    objectInfoGetFinal                      ,


-- ** objectInfoGetFundamental #method:objectInfoGetFundamental#

    objectInfoGetFundamental                ,


-- ** objectInfoGetGetValueFunction #method:objectInfoGetGetValueFunction#

    objectInfoGetGetValueFunction           ,


-- ** objectInfoGetInterface #method:objectInfoGetInterface#

    objectInfoGetInterface                  ,


-- ** objectInfoGetMethod #method:objectInfoGetMethod#

    objectInfoGetMethod                     ,


-- ** objectInfoGetNConstants #method:objectInfoGetNConstants#

    objectInfoGetNConstants                 ,


-- ** objectInfoGetNFields #method:objectInfoGetNFields#

    objectInfoGetNFields                    ,


-- ** objectInfoGetNInterfaces #method:objectInfoGetNInterfaces#

    objectInfoGetNInterfaces                ,


-- ** objectInfoGetNMethods #method:objectInfoGetNMethods#

    objectInfoGetNMethods                   ,


-- ** objectInfoGetNProperties #method:objectInfoGetNProperties#

    objectInfoGetNProperties                ,


-- ** objectInfoGetNSignals #method:objectInfoGetNSignals#

    objectInfoGetNSignals                   ,


-- ** objectInfoGetNVfuncs #method:objectInfoGetNVfuncs#

    objectInfoGetNVfuncs                    ,


-- ** objectInfoGetParent #method:objectInfoGetParent#

    objectInfoGetParent                     ,


-- ** objectInfoGetProperty #method:objectInfoGetProperty#

    objectInfoGetProperty                   ,


-- ** objectInfoGetRefFunction #method:objectInfoGetRefFunction#

    objectInfoGetRefFunction                ,


-- ** objectInfoGetSetValueFunction #method:objectInfoGetSetValueFunction#

    objectInfoGetSetValueFunction           ,


-- ** objectInfoGetSignal #method:objectInfoGetSignal#

    objectInfoGetSignal                     ,


-- ** objectInfoGetTypeInit #method:objectInfoGetTypeInit#

    objectInfoGetTypeInit                   ,


-- ** objectInfoGetTypeName #method:objectInfoGetTypeName#

    objectInfoGetTypeName                   ,


-- ** objectInfoGetUnrefFunction #method:objectInfoGetUnrefFunction#

    objectInfoGetUnrefFunction              ,


-- ** objectInfoGetVfunc #method:objectInfoGetVfunc#

    objectInfoGetVfunc                      ,


-- ** propertyInfoGetFlags #method:propertyInfoGetFlags#

    propertyInfoGetFlags                    ,


-- ** propertyInfoGetGetter #method:propertyInfoGetGetter#

    propertyInfoGetGetter                   ,


-- ** propertyInfoGetOwnershipTransfer #method:propertyInfoGetOwnershipTransfer#

    propertyInfoGetOwnershipTransfer        ,


-- ** propertyInfoGetSetter #method:propertyInfoGetSetter#

    propertyInfoGetSetter                   ,


-- ** propertyInfoGetType #method:propertyInfoGetType#

    propertyInfoGetType                     ,


-- ** registeredTypeInfoGetGType #method:registeredTypeInfoGetGType#

    registeredTypeInfoGetGType              ,


-- ** registeredTypeInfoGetTypeInit #method:registeredTypeInfoGetTypeInit#

    registeredTypeInfoGetTypeInit           ,


-- ** registeredTypeInfoGetTypeName #method:registeredTypeInfoGetTypeName#

    registeredTypeInfoGetTypeName           ,


-- ** signalInfoGetClassClosure #method:signalInfoGetClassClosure#

    signalInfoGetClassClosure               ,


-- ** signalInfoGetFlags #method:signalInfoGetFlags#

    signalInfoGetFlags                      ,


-- ** signalInfoTrueStopsEmit #method:signalInfoTrueStopsEmit#

    signalInfoTrueStopsEmit                 ,


-- ** structInfoFindField #method:structInfoFindField#

    structInfoFindField                     ,


-- ** structInfoFindMethod #method:structInfoFindMethod#

    structInfoFindMethod                    ,


-- ** structInfoGetAlignment #method:structInfoGetAlignment#

    structInfoGetAlignment                  ,


-- ** structInfoGetField #method:structInfoGetField#

    structInfoGetField                      ,


-- ** structInfoGetMethod #method:structInfoGetMethod#

    structInfoGetMethod                     ,


-- ** structInfoGetNFields #method:structInfoGetNFields#

    structInfoGetNFields                    ,


-- ** structInfoGetNMethods #method:structInfoGetNMethods#

    structInfoGetNMethods                   ,


-- ** structInfoGetSize #method:structInfoGetSize#

    structInfoGetSize                       ,


-- ** structInfoIsForeign #method:structInfoIsForeign#

    structInfoIsForeign                     ,


-- ** structInfoIsGtypeStruct #method:structInfoIsGtypeStruct#

    structInfoIsGtypeStruct                 ,


-- ** typeInfoArgumentFromHashPointer #method:typeInfoArgumentFromHashPointer#

    typeInfoArgumentFromHashPointer         ,


-- ** typeInfoGetArrayFixedSize #method:typeInfoGetArrayFixedSize#

    typeInfoGetArrayFixedSize               ,


-- ** typeInfoGetArrayLength #method:typeInfoGetArrayLength#

    typeInfoGetArrayLength                  ,


-- ** typeInfoGetArrayType #method:typeInfoGetArrayType#

    typeInfoGetArrayType                    ,


-- ** typeInfoGetInterface #method:typeInfoGetInterface#

    typeInfoGetInterface                    ,


-- ** typeInfoGetParamType #method:typeInfoGetParamType#

    typeInfoGetParamType                    ,


-- ** typeInfoGetStorageType #method:typeInfoGetStorageType#

    typeInfoGetStorageType                  ,


-- ** typeInfoGetTag #method:typeInfoGetTag#

    typeInfoGetTag                          ,


-- ** typeInfoHashPointerFromArgument #method:typeInfoHashPointerFromArgument#

    typeInfoHashPointerFromArgument         ,


-- ** typeInfoIsPointer #method:typeInfoIsPointer#

    typeInfoIsPointer                       ,


-- ** typeInfoIsZeroTerminated #method:typeInfoIsZeroTerminated#

    typeInfoIsZeroTerminated                ,


-- ** typeTagArgumentFromHashPointer #method:typeTagArgumentFromHashPointer#

    typeTagArgumentFromHashPointer          ,


-- ** typeTagHashPointerFromArgument #method:typeTagHashPointerFromArgument#

    typeTagHashPointerFromArgument          ,


-- ** typeTagToString #method:typeTagToString#

    typeTagToString                         ,


-- ** unionInfoFindMethod #method:unionInfoFindMethod#

    unionInfoFindMethod                     ,


-- ** unionInfoGetAlignment #method:unionInfoGetAlignment#

    unionInfoGetAlignment                   ,


-- ** unionInfoGetDiscriminator #method:unionInfoGetDiscriminator#

    unionInfoGetDiscriminator               ,


-- ** unionInfoGetDiscriminatorOffset #method:unionInfoGetDiscriminatorOffset#

    unionInfoGetDiscriminatorOffset         ,


-- ** unionInfoGetDiscriminatorType #method:unionInfoGetDiscriminatorType#

    unionInfoGetDiscriminatorType           ,


-- ** unionInfoGetField #method:unionInfoGetField#

    unionInfoGetField                       ,


-- ** unionInfoGetMethod #method:unionInfoGetMethod#

    unionInfoGetMethod                      ,


-- ** unionInfoGetNFields #method:unionInfoGetNFields#

    unionInfoGetNFields                     ,


-- ** unionInfoGetNMethods #method:unionInfoGetNMethods#

    unionInfoGetNMethods                    ,


-- ** unionInfoGetSize #method:unionInfoGetSize#

    unionInfoGetSize                        ,


-- ** unionInfoIsDiscriminated #method:unionInfoIsDiscriminated#

    unionInfoIsDiscriminated                ,


-- ** valueInfoGetValue #method:valueInfoGetValue#

    valueInfoGetValue                       ,


-- ** vfuncInfoGetAddress #method:vfuncInfoGetAddress#

    vfuncInfoGetAddress                     ,


-- ** vfuncInfoGetFlags #method:vfuncInfoGetFlags#

    vfuncInfoGetFlags                       ,


-- ** vfuncInfoGetInvoker #method:vfuncInfoGetInvoker#

    vfuncInfoGetInvoker                     ,


-- ** vfuncInfoGetOffset #method:vfuncInfoGetOffset#

    vfuncInfoGetOffset                      ,


-- ** vfuncInfoGetSignal #method:vfuncInfoGetSignal#

    vfuncInfoGetSignal                      ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.GIRepository.Enums as GIRepository.Enums
import {-# SOURCE #-} qualified GI.GIRepository.Flags as GIRepository.Flags
import {-# SOURCE #-} qualified GI.GIRepository.Structs.AttributeIter as GIRepository.AttributeIter
import {-# SOURCE #-} qualified GI.GIRepository.Structs.BaseInfo as GIRepository.BaseInfo
import {-# SOURCE #-} qualified GI.GIRepository.Structs.Typelib as GIRepository.Typelib
import {-# SOURCE #-} qualified GI.GIRepository.Unions.Argument as GIRepository.Argument
import qualified GI.GObject.Flags as GObject.Flags

-- function vfunc_info_get_signal
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIVFuncInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_vfunc_info_get_signal" g_vfunc_info_get_signal :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the signal for the virtual function if one is set.
-- The signal comes from the object or interface to which
-- this virtual function belongs.
vfuncInfoGetSignal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIVFuncInfo/@
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the signal or 'P.Nothing' if none set
vfuncInfoGetSignal :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
vfuncInfoGetSignal BaseInfo
info = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_vfunc_info_get_signal Ptr BaseInfo
info'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vfuncInfoGetSignal" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function vfunc_info_get_offset
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIVFuncInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_vfunc_info_get_offset" g_vfunc_info_get_offset :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the offset of the function pointer in the class struct. The value
-- 0xFFFF indicates that the struct offset is unknown.
vfuncInfoGetOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIVFuncInfo/@
    -> m Int32
    -- ^ __Returns:__ the struct offset or 0xFFFF if it\'s unknown
vfuncInfoGetOffset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
vfuncInfoGetOffset BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_vfunc_info_get_offset Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function vfunc_info_get_invoker
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIVFuncInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_vfunc_info_get_invoker" g_vfunc_info_get_invoker :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | If this virtual function has an associated invoker method, this
-- method will return it.  An invoker method is a C entry point.
-- 
-- Not all virtuals will have invokers.
vfuncInfoGetInvoker ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIVFuncInfo/@
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIVFuncInfo/@ or 'P.Nothing'. Free it with
    -- @/g_base_info_unref()/@ when done.
vfuncInfoGetInvoker :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
vfuncInfoGetInvoker BaseInfo
info = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_vfunc_info_get_invoker Ptr BaseInfo
info'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vfuncInfoGetInvoker" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function vfunc_info_get_flags
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIVFuncInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "VFuncInfoFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "g_vfunc_info_get_flags" g_vfunc_info_get_flags :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CUInt

-- | Obtain the flags for this virtual function info. See t'GI.GIRepository.Flags.VFuncInfoFlags' for
-- more information about possible flag values.
vfuncInfoGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIVFuncInfo/@
    -> m [GIRepository.Flags.VFuncInfoFlags]
    -- ^ __Returns:__ the flags
vfuncInfoGetFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m [VFuncInfoFlags]
vfuncInfoGetFlags BaseInfo
info = IO [VFuncInfoFlags] -> m [VFuncInfoFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [VFuncInfoFlags] -> m [VFuncInfoFlags])
-> IO [VFuncInfoFlags] -> m [VFuncInfoFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CUInt
result <- Ptr BaseInfo -> IO CUInt
g_vfunc_info_get_flags Ptr BaseInfo
info'
    let result' :: [VFuncInfoFlags]
result' = CUInt -> [VFuncInfoFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    [VFuncInfoFlags] -> IO [VFuncInfoFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [VFuncInfoFlags]
result'


-- function vfunc_info_get_address
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIVFuncInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "implementor_gtype"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GType implementing this virtual function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : True
-- Skip return : False

foreign import ccall "g_vfunc_info_get_address" g_vfunc_info_get_address :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    CGType ->                               -- implementor_gtype : TBasicType TGType
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr ())

-- | This method will look up where inside the type struct of /@implementorGtype@/
-- is the implementation for /@info@/.
vfuncInfoGetAddress ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIVFuncInfo/@
    -> GType
    -- ^ /@implementorGtype@/: t'GType' implementing this virtual function
    -> m (Ptr ())
    -- ^ __Returns:__ address to a function or 'P.Nothing' if an error happened /(Can throw 'Data.GI.Base.GError.GError')/
vfuncInfoGetAddress :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> GType -> m (Ptr ())
vfuncInfoGetAddress BaseInfo
info GType
implementorGtype = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    let implementorGtype' :: CGType
implementorGtype' = GType -> CGType
gtypeToCGType GType
implementorGtype
    IO (Ptr ()) -> IO () -> IO (Ptr ())
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr ()
result <- (Ptr (Ptr GError) -> IO (Ptr ())) -> IO (Ptr ())
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr (Ptr GError) -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Ptr BaseInfo -> CGType -> Ptr (Ptr GError) -> IO (Ptr ())
g_vfunc_info_get_address Ptr BaseInfo
info' CGType
implementorGtype'
        BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
        Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )


-- function value_info_get_value
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIValueInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt64)
-- throws : False
-- Skip return : False

foreign import ccall "g_value_info_get_value" g_value_info_get_value :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int64

-- | Obtain the enumeration value of the @/GIValueInfo/@.
valueInfoGetValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIValueInfo/@
    -> m Int64
    -- ^ __Returns:__ the enumeration value. This will always be representable
    --   as a 32-bit signed or unsigned value. The use of gint64 as the
    --   return type is to allow both.
valueInfoGetValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int64
valueInfoGetValue BaseInfo
info = IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int64
result <- Ptr BaseInfo -> IO Int64
g_value_info_get_value Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int64 -> IO Int64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result


-- function union_info_is_discriminated
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIUnionInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_union_info_is_discriminated" g_union_info_is_discriminated :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Return true if this union contains discriminator field.
unionInfoIsDiscriminated ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIUnionInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this is a discriminated union, 'P.False' otherwise
unionInfoIsDiscriminated :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
unionInfoIsDiscriminated BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_union_info_is_discriminated Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function union_info_get_size
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIUnionInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "g_union_info_get_size" g_union_info_get_size :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Word64

-- | Obtain the total size of the union.
unionInfoGetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIUnionInfo/@
    -> m Word64
    -- ^ __Returns:__ size of the union in bytes
unionInfoGetSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m CGType
unionInfoGetSize BaseInfo
info = IO CGType -> m CGType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CGType -> m CGType) -> IO CGType -> m CGType
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CGType
result <- Ptr BaseInfo -> IO CGType
g_union_info_get_size Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CGType -> IO CGType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CGType
result


-- function union_info_get_n_methods
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIUnionInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_union_info_get_n_methods" g_union_info_get_n_methods :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of methods this union has.
unionInfoGetNMethods ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIUnionInfo/@
    -> m Int32
    -- ^ __Returns:__ number of methods
unionInfoGetNMethods :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
unionInfoGetNMethods BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_union_info_get_n_methods Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function union_info_get_n_fields
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIUnionInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_union_info_get_n_fields" g_union_info_get_n_fields :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of fields this union has.
unionInfoGetNFields ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIUnionInfo/@
    -> m Int32
    -- ^ __Returns:__ number of fields
unionInfoGetNFields :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
unionInfoGetNFields BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_union_info_get_n_fields Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function union_info_get_method
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIUnionInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a method index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_union_info_get_method" g_union_info_get_method :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the type information for method with specified index.
unionInfoGetMethod ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIUnionInfo/@
    -> Int32
    -- ^ /@n@/: a method index
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIFunctionInfo/@, free it with @/g_base_info_unref()/@
    -- when done.
unionInfoGetMethod :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
unionInfoGetMethod BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_union_info_get_method Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unionInfoGetMethod" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function union_info_get_field
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIUnionInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a field index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_union_info_get_field" g_union_info_get_field :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the type information for field with specified index.
unionInfoGetField ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIUnionInfo/@
    -> Int32
    -- ^ /@n@/: a field index
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIFieldInfo/@, free it with @/g_base_info_unref()/@
    -- when done.
unionInfoGetField :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
unionInfoGetField BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_union_info_get_field Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unionInfoGetField" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function union_info_get_discriminator_type
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIUnionInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_union_info_get_discriminator_type" g_union_info_get_discriminator_type :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the type information of the union discriminator.
unionInfoGetDiscriminatorType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIUnionInfo/@
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GITypeInfo/@, free it with @/g_base_info_unref()/@
    -- when done.
unionInfoGetDiscriminatorType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
unionInfoGetDiscriminatorType BaseInfo
info = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_union_info_get_discriminator_type Ptr BaseInfo
info'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unionInfoGetDiscriminatorType" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function union_info_get_discriminator_offset
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIUnionInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_union_info_get_discriminator_offset" g_union_info_get_discriminator_offset :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Returns offset of the discriminator field in the structure.
unionInfoGetDiscriminatorOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIUnionInfo/@
    -> m Int32
    -- ^ __Returns:__ offset in bytes of the discriminator
unionInfoGetDiscriminatorOffset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
unionInfoGetDiscriminatorOffset BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_union_info_get_discriminator_offset Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function union_info_get_discriminator
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIUnionInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a union field index"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_union_info_get_discriminator" g_union_info_get_discriminator :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain discriminator value assigned for n-th union field, i.e. n-th
-- union field is the active one if discriminator contains this
-- constant.
unionInfoGetDiscriminator ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIUnionInfo/@
    -> Int32
    -- ^ /@n@/: a union field index
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIConstantInfo/@, free it with @/g_base_info_unref()/@
    -- when done.
unionInfoGetDiscriminator :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
unionInfoGetDiscriminator BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_union_info_get_discriminator Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unionInfoGetDiscriminator" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function union_info_get_alignment
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIUnionInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "g_union_info_get_alignment" g_union_info_get_alignment :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Word64

-- | Obtain the required alignment of the union.
unionInfoGetAlignment ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIUnionInfo/@
    -> m Word64
    -- ^ __Returns:__ required alignment in bytes
unionInfoGetAlignment :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m CGType
unionInfoGetAlignment BaseInfo
info = IO CGType -> m CGType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CGType -> m CGType) -> IO CGType -> m CGType
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CGType
result <- Ptr BaseInfo -> IO CGType
g_union_info_get_alignment Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CGType -> IO CGType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CGType
result


-- function union_info_find_method
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIUnionInfo" , 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 method name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_union_info_find_method" g_union_info_find_method :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the type information for method named /@name@/.
unionInfoFindMethod ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIUnionInfo/@
    -> T.Text
    -- ^ /@name@/: a method name
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIFunctionInfo/@, free it with @/g_base_info_unref()/@
    -- when done.
unionInfoFindMethod :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Text -> m BaseInfo
unionInfoFindMethod BaseInfo
info Text
name = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr BaseInfo
result <- Ptr BaseInfo -> CString -> IO (Ptr BaseInfo)
g_union_info_find_method Ptr BaseInfo
info' CString
name'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unionInfoFindMethod" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function type_tag_to_string
-- Args: [ Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "TypeTag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the type_tag" , 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_type_tag_to_string" g_type_tag_to_string :: 
    CUInt ->                                -- type : TInterface (Name {namespace = "GIRepository", name = "TypeTag"})
    IO CString

-- | Obtain a string representation of /@type@/
typeTagToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.Enums.TypeTag
    -- ^ /@type@/: the type_tag
    -> m T.Text
    -- ^ __Returns:__ the string
typeTagToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TypeTag -> m Text
typeTagToString TypeTag
type_ = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TypeTag -> Int) -> TypeTag -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeTag -> Int
forall a. Enum a => a -> Int
fromEnum) TypeTag
type_
    CString
result <- CUInt -> IO CString
g_type_tag_to_string CUInt
type_'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"typeTagToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'


-- function type_tag_hash_pointer_from_argument
-- Args: [ Arg
--           { argCName = "storage_type"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "TypeTag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GITypeTag obtained from g_type_info_get_storage_type()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "arg"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "Argument" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A #GIArgument with the value to stuff into a pointer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "gi_type_tag_hash_pointer_from_argument" gi_type_tag_hash_pointer_from_argument :: 
    CUInt ->                                -- storage_type : TInterface (Name {namespace = "GIRepository", name = "TypeTag"})
    Ptr GIRepository.Argument.Argument ->   -- arg : TInterface (Name {namespace = "GIRepository", name = "Argument"})
    IO (Ptr ())

-- | GLib data structures, such as t'GI.GLib.Structs.List.List', t'GI.GLib.Structs.SList.SList', and t'GI.GLib.Structs.HashTable.HashTable', all store
-- data pointers.
-- In the case where the list or hash table is storing single types rather than
-- structs, these data pointers may have values stuffed into them via macros
-- such as @/GPOINTER_TO_INT/@.
-- 
-- Use this function to ensure that all values are correctly stuffed into
-- pointers, regardless of the machine\'s architecture or endianness.
-- 
-- This function returns a pointer stuffed with the appropriate field of /@arg@/,
-- depending on /@storageType@/.
-- 
-- /Since: 1.72/
typeTagHashPointerFromArgument ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.Enums.TypeTag
    -- ^ /@storageType@/: a t'GI.GIRepository.Enums.TypeTag' obtained from 'GI.GIRepository.Functions.typeInfoGetStorageType'
    -> GIRepository.Argument.Argument
    -- ^ /@arg@/: A t'GI.GIRepository.Unions.Argument.Argument' with the value to stuff into a pointer
    -> m (Ptr ())
    -- ^ __Returns:__ A stuffed pointer, that can be stored in a t'GI.GLib.Structs.HashTable.HashTable', for example
typeTagHashPointerFromArgument :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TypeTag -> Argument -> m (Ptr ())
typeTagHashPointerFromArgument TypeTag
storageType Argument
arg = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    let storageType' :: CUInt
storageType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TypeTag -> Int) -> TypeTag -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeTag -> Int
forall a. Enum a => a -> Int
fromEnum) TypeTag
storageType
    Ptr Argument
arg' <- Argument -> IO (Ptr Argument)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Argument
arg
    Ptr ()
result <- CUInt -> Ptr Argument -> IO (Ptr ())
gi_type_tag_hash_pointer_from_argument CUInt
storageType' Ptr Argument
arg'
    Argument -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Argument
arg
    Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result


-- function type_tag_argument_from_hash_pointer
-- Args: [ Arg
--           { argCName = "storage_type"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "TypeTag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GITypeTag obtained from g_type_info_get_storage_type()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hash_pointer"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer, such as a #GHashTable data pointer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "arg"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "Argument" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GIArgument to fill in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gi_type_tag_argument_from_hash_pointer" gi_type_tag_argument_from_hash_pointer :: 
    CUInt ->                                -- storage_type : TInterface (Name {namespace = "GIRepository", name = "TypeTag"})
    Ptr () ->                               -- hash_pointer : TBasicType TPtr
    Ptr GIRepository.Argument.Argument ->   -- arg : TInterface (Name {namespace = "GIRepository", name = "Argument"})
    IO ()

-- | GLib data structures, such as t'GI.GLib.Structs.List.List', t'GI.GLib.Structs.SList.SList', and t'GI.GLib.Structs.HashTable.HashTable', all store
-- data pointers.
-- In the case where the list or hash table is storing single types rather than
-- structs, these data pointers may have values stuffed into them via macros
-- such as @/GPOINTER_TO_INT/@.
-- 
-- Use this function to ensure that all values are correctly extracted from
-- stuffed pointers, regardless of the machine\'s architecture or endianness.
-- 
-- This function fills in the appropriate field of /@arg@/ with the value extracted
-- from /@hashPointer@/, depending on /@storageType@/.
-- 
-- /Since: 1.72/
typeTagArgumentFromHashPointer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.Enums.TypeTag
    -- ^ /@storageType@/: a t'GI.GIRepository.Enums.TypeTag' obtained from 'GI.GIRepository.Functions.typeInfoGetStorageType'
    -> Ptr ()
    -- ^ /@hashPointer@/: A pointer, such as a t'GI.GLib.Structs.HashTable.HashTable' data pointer
    -> GIRepository.Argument.Argument
    -- ^ /@arg@/: A t'GI.GIRepository.Unions.Argument.Argument' to fill in
    -> m ()
typeTagArgumentFromHashPointer :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TypeTag -> Ptr () -> Argument -> m ()
typeTagArgumentFromHashPointer TypeTag
storageType Ptr ()
hashPointer Argument
arg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let storageType' :: CUInt
storageType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TypeTag -> Int) -> TypeTag -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeTag -> Int
forall a. Enum a => a -> Int
fromEnum) TypeTag
storageType
    Ptr Argument
arg' <- Argument -> IO (Ptr Argument)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Argument
arg
    CUInt -> Ptr () -> Ptr Argument -> IO ()
gi_type_tag_argument_from_hash_pointer CUInt
storageType' Ptr ()
hashPointer Ptr Argument
arg'
    Argument -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Argument
arg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function type_info_is_zero_terminated
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GITypeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_type_info_is_zero_terminated" g_type_info_is_zero_terminated :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Obtain if the last element of the array is 'P.Nothing'. The type tag must be a
-- @/GI_TYPE_TAG_ARRAY/@ or 'P.False' will be returned.
typeInfoIsZeroTerminated ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GITypeInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if zero terminated
typeInfoIsZeroTerminated :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
typeInfoIsZeroTerminated BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_type_info_is_zero_terminated Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function type_info_is_pointer
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GITypeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_type_info_is_pointer" g_type_info_is_pointer :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Obtain if the type is passed as a reference.
-- 
-- Note that the types of 'GI.GIRepository.Enums.DirectionOut' and 'GI.GIRepository.Enums.DirectionInout' parameters
-- will only be pointers if the underlying type being transferred is a pointer
-- (i.e. only if the type of the C function’s formal parameter is a pointer to a
-- pointer).
typeInfoIsPointer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GITypeInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if it is a pointer
typeInfoIsPointer :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
typeInfoIsPointer BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_type_info_is_pointer Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function type_info_hash_pointer_from_argument
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GITypeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "arg"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "Argument" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A #GIArgument with the value to stuff into a pointer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "g_type_info_hash_pointer_from_argument" g_type_info_hash_pointer_from_argument :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Ptr GIRepository.Argument.Argument ->   -- arg : TInterface (Name {namespace = "GIRepository", name = "Argument"})
    IO (Ptr ())

-- | GLib data structures, such as t'GI.GLib.Structs.List.List', t'GI.GLib.Structs.SList.SList', and t'GI.GLib.Structs.HashTable.HashTable', all store
-- data pointers.
-- In the case where the list or hash table is storing single types rather than
-- structs, these data pointers may have values stuffed into them via macros
-- such as @/GPOINTER_TO_INT/@.
-- 
-- Use this function to ensure that all values are correctly stuffed into
-- pointers, regardless of the machine\'s architecture or endianness.
-- 
-- This function returns a pointer stuffed with the appropriate field of /@arg@/,
-- depending on the storage type of /@info@/.
-- 
-- /Since: 1.66/
typeInfoHashPointerFromArgument ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GITypeInfo/@
    -> GIRepository.Argument.Argument
    -- ^ /@arg@/: A t'GI.GIRepository.Unions.Argument.Argument' with the value to stuff into a pointer
    -> m (Ptr ())
    -- ^ __Returns:__ A stuffed pointer, that can be stored in a t'GI.GLib.Structs.HashTable.HashTable', for example
typeInfoHashPointerFromArgument :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Argument -> m (Ptr ())
typeInfoHashPointerFromArgument BaseInfo
info Argument
arg = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr Argument
arg' <- Argument -> IO (Ptr Argument)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Argument
arg
    Ptr ()
result <- Ptr BaseInfo -> Ptr Argument -> IO (Ptr ())
g_type_info_hash_pointer_from_argument Ptr BaseInfo
info' Ptr Argument
arg'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Argument -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Argument
arg
    Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result


-- function type_info_get_tag
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GITypeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GIRepository" , name = "TypeTag" })
-- throws : False
-- Skip return : False

foreign import ccall "g_type_info_get_tag" g_type_info_get_tag :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CUInt

-- | Obtain the type tag for the type. See t'GI.GIRepository.Enums.TypeTag' for a list
-- of type tags.
typeInfoGetTag ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GITypeInfo/@
    -> m GIRepository.Enums.TypeTag
    -- ^ __Returns:__ the type tag
typeInfoGetTag :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m TypeTag
typeInfoGetTag BaseInfo
info = IO TypeTag -> m TypeTag
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TypeTag -> m TypeTag) -> IO TypeTag -> m TypeTag
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CUInt
result <- Ptr BaseInfo -> IO CUInt
g_type_info_get_tag Ptr BaseInfo
info'
    let result' :: TypeTag
result' = (Int -> TypeTag
forall a. Enum a => Int -> a
toEnum (Int -> TypeTag) -> (CUInt -> Int) -> CUInt -> TypeTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    TypeTag -> IO TypeTag
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeTag
result'


-- function type_info_get_storage_type
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GITypeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GIRepository" , name = "TypeTag" })
-- throws : False
-- Skip return : False

foreign import ccall "g_type_info_get_storage_type" g_type_info_get_storage_type :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CUInt

-- | Obtain the type tag corresponding to the underlying storage type in C for
-- the type.
-- See t'GI.GIRepository.Enums.TypeTag' for a list of type tags.
-- 
-- /Since: 1.66/
typeInfoGetStorageType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GITypeInfo/@
    -> m GIRepository.Enums.TypeTag
    -- ^ __Returns:__ the type tag
typeInfoGetStorageType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m TypeTag
typeInfoGetStorageType BaseInfo
info = IO TypeTag -> m TypeTag
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TypeTag -> m TypeTag) -> IO TypeTag -> m TypeTag
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CUInt
result <- Ptr BaseInfo -> IO CUInt
g_type_info_get_storage_type Ptr BaseInfo
info'
    let result' :: TypeTag
result' = (Int -> TypeTag
forall a. Enum a => Int -> a
toEnum (Int -> TypeTag) -> (CUInt -> Int) -> CUInt -> TypeTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    TypeTag -> IO TypeTag
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeTag
result'


-- function type_info_get_param_type
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GITypeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of the parameter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_type_info_get_param_type" g_type_info_get_param_type :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the parameter type /@n@/.
typeInfoGetParamType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GITypeInfo/@
    -> Int32
    -- ^ /@n@/: index of the parameter
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the param type info
typeInfoGetParamType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
typeInfoGetParamType BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_type_info_get_param_type Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"typeInfoGetParamType" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function type_info_get_interface
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GITypeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_type_info_get_interface" g_type_info_get_interface :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | For types which have @/GI_TYPE_TAG_INTERFACE/@ such as GObjects and boxed values,
-- this function returns full information about the referenced type.  You can then
-- inspect the type of the returned t'GI.GIRepository.Structs.BaseInfo.BaseInfo' to further query whether it is
-- a concrete GObject, a GInterface, a structure, etc. using 'GI.GIRepository.Structs.BaseInfo.baseInfoGetType'.
typeInfoGetInterface ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GITypeInfo/@
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the t'GI.GIRepository.Structs.BaseInfo.BaseInfo', or 'P.Nothing'. Free it with
    -- @/g_base_info_unref()/@ when done.
typeInfoGetInterface :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
typeInfoGetInterface BaseInfo
info = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_type_info_get_interface Ptr BaseInfo
info'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"typeInfoGetInterface" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function type_info_get_array_type
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GITypeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "ArrayType" })
-- throws : False
-- Skip return : False

foreign import ccall "g_type_info_get_array_type" g_type_info_get_array_type :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CUInt

-- | Obtain the array type for this type. See t'GI.GIRepository.Enums.ArrayType' for a list of
-- possible values. If the type tag of this type is not array, -1 will be
-- returned.
typeInfoGetArrayType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GITypeInfo/@
    -> m GIRepository.Enums.ArrayType
    -- ^ __Returns:__ the array type or -1
typeInfoGetArrayType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m ArrayType
typeInfoGetArrayType BaseInfo
info = IO ArrayType -> m ArrayType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ArrayType -> m ArrayType) -> IO ArrayType -> m ArrayType
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CUInt
result <- Ptr BaseInfo -> IO CUInt
g_type_info_get_array_type Ptr BaseInfo
info'
    let result' :: ArrayType
result' = (Int -> ArrayType
forall a. Enum a => Int -> a
toEnum (Int -> ArrayType) -> (CUInt -> Int) -> CUInt -> ArrayType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    ArrayType -> IO ArrayType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ArrayType
result'


-- function type_info_get_array_length
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GITypeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_type_info_get_array_length" g_type_info_get_array_length :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the position of the argument which gives the array length of the type.
-- The type tag must be a @/GI_TYPE_TAG_ARRAY/@ or -1 will be returned.
typeInfoGetArrayLength ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GITypeInfo/@
    -> m Int32
    -- ^ __Returns:__ the array length, or -1 if the type is not an array
typeInfoGetArrayLength :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
typeInfoGetArrayLength BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_type_info_get_array_length Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function type_info_get_array_fixed_size
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GITypeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_type_info_get_array_fixed_size" g_type_info_get_array_fixed_size :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the fixed array size of the type. The type tag must be a
-- @/GI_TYPE_TAG_ARRAY/@ or -1 will be returned.
typeInfoGetArrayFixedSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GITypeInfo/@
    -> m Int32
    -- ^ __Returns:__ the size or -1 if it\'s not an array
typeInfoGetArrayFixedSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
typeInfoGetArrayFixedSize BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_type_info_get_array_fixed_size Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function type_info_argument_from_hash_pointer
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GITypeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hash_pointer"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer, such as a #GHashTable data pointer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "arg"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "Argument" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GIArgument to fill in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_type_info_argument_from_hash_pointer" g_type_info_argument_from_hash_pointer :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Ptr () ->                               -- hash_pointer : TBasicType TPtr
    Ptr GIRepository.Argument.Argument ->   -- arg : TInterface (Name {namespace = "GIRepository", name = "Argument"})
    IO ()

-- | GLib data structures, such as t'GI.GLib.Structs.List.List', t'GI.GLib.Structs.SList.SList', and t'GI.GLib.Structs.HashTable.HashTable', all store
-- data pointers.
-- In the case where the list or hash table is storing single types rather than
-- structs, these data pointers may have values stuffed into them via macros
-- such as @/GPOINTER_TO_INT/@.
-- 
-- Use this function to ensure that all values are correctly extracted from
-- stuffed pointers, regardless of the machine\'s architecture or endianness.
-- 
-- This function fills in the appropriate field of /@arg@/ with the value extracted
-- from /@hashPointer@/, depending on the storage type of /@info@/.
-- 
-- /Since: 1.66/
typeInfoArgumentFromHashPointer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GITypeInfo/@
    -> Ptr ()
    -- ^ /@hashPointer@/: A pointer, such as a t'GI.GLib.Structs.HashTable.HashTable' data pointer
    -> GIRepository.Argument.Argument
    -- ^ /@arg@/: A t'GI.GIRepository.Unions.Argument.Argument' to fill in
    -> m ()
typeInfoArgumentFromHashPointer :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Ptr () -> Argument -> m ()
typeInfoArgumentFromHashPointer BaseInfo
info Ptr ()
hashPointer Argument
arg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr Argument
arg' <- Argument -> IO (Ptr Argument)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Argument
arg
    Ptr BaseInfo -> Ptr () -> Ptr Argument -> IO ()
g_type_info_argument_from_hash_pointer Ptr BaseInfo
info' Ptr ()
hashPointer Ptr Argument
arg'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Argument -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Argument
arg
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function struct_info_is_gtype_struct
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIStructInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_struct_info_is_gtype_struct" g_struct_info_is_gtype_struct :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Return true if this structure represents the \"class structure\" for some
-- t'GI.GObject.Objects.Object.Object' or @/GInterface/@.  This function is mainly useful to hide this kind of structure
-- from generated public APIs.
structInfoIsGtypeStruct ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIStructInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this is a class struct, 'P.False' otherwise
structInfoIsGtypeStruct :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
structInfoIsGtypeStruct BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_struct_info_is_gtype_struct Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function struct_info_is_foreign
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_struct_info_is_foreign" g_struct_info_is_foreign :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | TODO
structInfoIsForeign ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: TODO
    -> m Bool
    -- ^ __Returns:__ TODO
structInfoIsForeign :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
structInfoIsForeign BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_struct_info_is_foreign Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function struct_info_get_size
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIStructInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "g_struct_info_get_size" g_struct_info_get_size :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Word64

-- | Obtain the total size of the structure.
structInfoGetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIStructInfo/@
    -> m Word64
    -- ^ __Returns:__ size of the structure in bytes
structInfoGetSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m CGType
structInfoGetSize BaseInfo
info = IO CGType -> m CGType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CGType -> m CGType) -> IO CGType -> m CGType
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CGType
result <- Ptr BaseInfo -> IO CGType
g_struct_info_get_size Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CGType -> IO CGType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CGType
result


-- function struct_info_get_n_methods
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIStructInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_struct_info_get_n_methods" g_struct_info_get_n_methods :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of methods this structure has.
structInfoGetNMethods ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIStructInfo/@
    -> m Int32
    -- ^ __Returns:__ number of methods
structInfoGetNMethods :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
structInfoGetNMethods BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_struct_info_get_n_methods Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function struct_info_get_n_fields
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIStructInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_struct_info_get_n_fields" g_struct_info_get_n_fields :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of fields this structure has.
structInfoGetNFields ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIStructInfo/@
    -> m Int32
    -- ^ __Returns:__ number of fields
structInfoGetNFields :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
structInfoGetNFields BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_struct_info_get_n_fields Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function struct_info_get_method
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIStructInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a method index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_struct_info_get_method" g_struct_info_get_method :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the type information for method with specified index.
structInfoGetMethod ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIStructInfo/@
    -> Int32
    -- ^ /@n@/: a method index
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIFunctionInfo/@, free it with @/g_base_info_unref()/@
    -- when done.
structInfoGetMethod :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
structInfoGetMethod BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_struct_info_get_method Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"structInfoGetMethod" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function struct_info_get_field
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIStructInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a field index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_struct_info_get_field" g_struct_info_get_field :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the type information for field with specified index.
structInfoGetField ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIStructInfo/@
    -> Int32
    -- ^ /@n@/: a field index
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIFieldInfo/@, free it with @/g_base_info_unref()/@
    -- when done.
structInfoGetField :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
structInfoGetField BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_struct_info_get_field Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"structInfoGetField" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function struct_info_get_alignment
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIStructInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "g_struct_info_get_alignment" g_struct_info_get_alignment :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Word64

-- | Obtain the required alignment of the structure.
structInfoGetAlignment ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIStructInfo/@
    -> m Word64
    -- ^ __Returns:__ required alignment in bytes
structInfoGetAlignment :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m CGType
structInfoGetAlignment BaseInfo
info = IO CGType -> m CGType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CGType -> m CGType) -> IO CGType -> m CGType
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CGType
result <- Ptr BaseInfo -> IO CGType
g_struct_info_get_alignment Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CGType -> IO CGType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CGType
result


-- function struct_info_find_method
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIStructInfo" , 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 method name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_struct_info_find_method" g_struct_info_find_method :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the type information for method named /@name@/.
structInfoFindMethod ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIStructInfo/@
    -> T.Text
    -- ^ /@name@/: a method name
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIFunctionInfo/@, free it with @/g_base_info_unref()/@
    -- when done.
structInfoFindMethod :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Text -> m BaseInfo
structInfoFindMethod BaseInfo
info Text
name = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr BaseInfo
result <- Ptr BaseInfo -> CString -> IO (Ptr BaseInfo)
g_struct_info_find_method Ptr BaseInfo
info' CString
name'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"structInfoFindMethod" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function struct_info_find_field
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIStructInfo" , 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 field name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_struct_info_find_field" g_struct_info_find_field :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the type information for field named /@name@/.
-- 
-- /Since: 1.46/
structInfoFindField ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIStructInfo/@
    -> T.Text
    -- ^ /@name@/: a field name
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIFieldInfo/@ or 'P.Nothing' if not found,
    -- free it with @/g_base_info_unref()/@ when done.
structInfoFindField :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Text -> m BaseInfo
structInfoFindField BaseInfo
info Text
name = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr BaseInfo
result <- Ptr BaseInfo -> CString -> IO (Ptr BaseInfo)
g_struct_info_find_field Ptr BaseInfo
info' CString
name'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"structInfoFindField" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function signal_info_true_stops_emit
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GISignalInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_signal_info_true_stops_emit" g_signal_info_true_stops_emit :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Obtain if the returning true in the signal handler will
-- stop the emission of the signal.
signalInfoTrueStopsEmit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GISignalInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if returning true stops the signal emission
signalInfoTrueStopsEmit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
signalInfoTrueStopsEmit BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_signal_info_true_stops_emit Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function signal_info_get_flags
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GISignalInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GObject" , name = "SignalFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "g_signal_info_get_flags" g_signal_info_get_flags :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CUInt

-- | Obtain the flags for this signal info. See t'GI.GObject.Flags.SignalFlags' for
-- more information about possible flag values.
signalInfoGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GISignalInfo/@
    -> m [GObject.Flags.SignalFlags]
    -- ^ __Returns:__ the flags
signalInfoGetFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m [SignalFlags]
signalInfoGetFlags BaseInfo
info = IO [SignalFlags] -> m [SignalFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SignalFlags] -> m [SignalFlags])
-> IO [SignalFlags] -> m [SignalFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CUInt
result <- Ptr BaseInfo -> IO CUInt
g_signal_info_get_flags Ptr BaseInfo
info'
    let result' :: [SignalFlags]
result' = CUInt -> [SignalFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    [SignalFlags] -> IO [SignalFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [SignalFlags]
result'


-- function signal_info_get_class_closure
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GISignalInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_signal_info_get_class_closure" g_signal_info_get_class_closure :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the class closure for this signal if one is set. The class
-- closure is a virtual function on the type that the signal belongs to.
-- If the signal lacks a closure 'P.Nothing' will be returned.
signalInfoGetClassClosure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GISignalInfo/@
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the class closure or 'P.Nothing'
signalInfoGetClassClosure :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
signalInfoGetClassClosure BaseInfo
info = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_signal_info_get_class_closure Ptr BaseInfo
info'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"signalInfoGetClassClosure" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function registered_type_info_get_type_name
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIRegisteredTypeInfo"
--                 , 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_registered_type_info_get_type_name" g_registered_type_info_get_type_name :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CString

-- | Obtain the type name of the struct within the GObject type system.
-- This type can be passed to 'GI.GObject.Functions.typeName' to get a t'GType'.
registeredTypeInfoGetTypeName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIRegisteredTypeInfo/@
    -> m T.Text
    -- ^ __Returns:__ the type name
registeredTypeInfoGetTypeName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Text
registeredTypeInfoGetTypeName BaseInfo
info = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
result <- Ptr BaseInfo -> IO CString
g_registered_type_info_get_type_name Ptr BaseInfo
info'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"registeredTypeInfoGetTypeName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'


-- function registered_type_info_get_type_init
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIRegisteredTypeInfo"
--                 , 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_registered_type_info_get_type_init" g_registered_type_info_get_type_init :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CString

-- | Obtain the type init function for /@info@/. The type init function is the
-- function which will register the GType within the GObject type system.
-- Usually this is not called by langauge bindings or applications, use
-- 'GI.GIRepository.Functions.registeredTypeInfoGetGType' directly instead.
registeredTypeInfoGetTypeInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIRegisteredTypeInfo/@
    -> m T.Text
    -- ^ __Returns:__ the symbol name of the type init function, suitable for
    -- passing into @/g_module_symbol()/@.
registeredTypeInfoGetTypeInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Text
registeredTypeInfoGetTypeInit BaseInfo
info = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
result <- Ptr BaseInfo -> IO CString
g_registered_type_info_get_type_init Ptr BaseInfo
info'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"registeredTypeInfoGetTypeInit" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'


-- function registered_type_info_get_g_type
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIRegisteredTypeInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "g_registered_type_info_get_g_type" g_registered_type_info_get_g_type :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CGType

-- | Obtain the t'GType' for this registered type or G_TYPE_NONE which a special meaning.
-- It means that either there is no type information associated with this /@info@/ or
-- that the shared library which provides the type_init function for this
-- /@info@/ cannot be called.
registeredTypeInfoGetGType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIRegisteredTypeInfo/@
    -> m GType
    -- ^ __Returns:__ the t'GType'.
registeredTypeInfoGetGType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m GType
registeredTypeInfoGetGType BaseInfo
info = IO GType -> m GType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CGType
result <- Ptr BaseInfo -> IO CGType
g_registered_type_info_get_g_type Ptr BaseInfo
info'
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    GType -> IO GType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'


-- function property_info_get_type
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIPropertyInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_property_info_get_type" g_property_info_get_type :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the type information for the property /@info@/.
propertyInfoGetType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIPropertyInfo/@
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GITypeInfo/@, free it with
    -- @/g_base_info_unref()/@ when done.
propertyInfoGetType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
propertyInfoGetType BaseInfo
info = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_property_info_get_type Ptr BaseInfo
info'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"propertyInfoGetType" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function property_info_get_setter
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIPropertyInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_property_info_get_setter" g_property_info_get_setter :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtains the setter function associated with this @/GIPropertyInfo/@.
-- 
-- The setter is only available for 'GI.GObject.Flags.ParamFlagsWritable' properties that
-- are also not 'GI.GObject.Flags.ParamFlagsConstructOnly'.
propertyInfoGetSetter ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIPropertyInfo/@
    -> m (Maybe GIRepository.BaseInfo.BaseInfo)
    -- ^ __Returns:__ the function info or 'P.Nothing' if not set.
    --   Free it with @/g_base_info_unref()/@ when done.
propertyInfoGetSetter :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m (Maybe BaseInfo)
propertyInfoGetSetter BaseInfo
info = IO (Maybe BaseInfo) -> m (Maybe BaseInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BaseInfo) -> m (Maybe BaseInfo))
-> IO (Maybe BaseInfo) -> m (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_property_info_get_setter Ptr BaseInfo
info'
    Maybe BaseInfo
maybeResult <- Ptr BaseInfo
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr BaseInfo
result ((Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo))
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr BaseInfo
result' -> do
        BaseInfo
result'' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result'
        BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result''
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Maybe BaseInfo -> IO (Maybe BaseInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseInfo
maybeResult


-- function property_info_get_ownership_transfer
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIPropertyInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "Transfer" })
-- throws : False
-- Skip return : False

foreign import ccall "g_property_info_get_ownership_transfer" g_property_info_get_ownership_transfer :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CUInt

-- | Obtain the ownership transfer for this property. See t'GI.GIRepository.Enums.Transfer' for more
-- information about transfer values.
propertyInfoGetOwnershipTransfer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIPropertyInfo/@
    -> m GIRepository.Enums.Transfer
    -- ^ __Returns:__ the transfer
propertyInfoGetOwnershipTransfer :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Transfer
propertyInfoGetOwnershipTransfer BaseInfo
info = IO Transfer -> m Transfer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Transfer -> m Transfer) -> IO Transfer -> m Transfer
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CUInt
result <- Ptr BaseInfo -> IO CUInt
g_property_info_get_ownership_transfer Ptr BaseInfo
info'
    let result' :: Transfer
result' = (Int -> Transfer
forall a. Enum a => Int -> a
toEnum (Int -> Transfer) -> (CUInt -> Int) -> CUInt -> Transfer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Transfer -> IO Transfer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Transfer
result'


-- function property_info_get_getter
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIPropertyInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_property_info_get_getter" g_property_info_get_getter :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtains the getter function associated with this @/GIPropertyInfo/@.
-- 
-- The setter is only available for 'GI.GObject.Flags.ParamFlagsReadable' properties.
propertyInfoGetGetter ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIPropertyInfo/@
    -> m (Maybe GIRepository.BaseInfo.BaseInfo)
    -- ^ __Returns:__ the function info or 'P.Nothing' if not set.
    --   Free it with @/g_base_info_unref()/@ when done.
propertyInfoGetGetter :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m (Maybe BaseInfo)
propertyInfoGetGetter BaseInfo
info = IO (Maybe BaseInfo) -> m (Maybe BaseInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BaseInfo) -> m (Maybe BaseInfo))
-> IO (Maybe BaseInfo) -> m (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_property_info_get_getter Ptr BaseInfo
info'
    Maybe BaseInfo
maybeResult <- Ptr BaseInfo
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr BaseInfo
result ((Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo))
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr BaseInfo
result' -> do
        BaseInfo
result'' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result'
        BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result''
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Maybe BaseInfo -> IO (Maybe BaseInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseInfo
maybeResult


-- function property_info_get_flags
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIPropertyInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GObject" , name = "ParamFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "g_property_info_get_flags" g_property_info_get_flags :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CUInt

-- | Obtain the flags for this property info. See t'GI.GObject.Flags.ParamFlags' for
-- more information about possible flag values.
propertyInfoGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIPropertyInfo/@
    -> m [GObject.Flags.ParamFlags]
    -- ^ __Returns:__ the flags
propertyInfoGetFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m [ParamFlags]
propertyInfoGetFlags BaseInfo
info = IO [ParamFlags] -> m [ParamFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ParamFlags] -> m [ParamFlags])
-> IO [ParamFlags] -> m [ParamFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CUInt
result <- Ptr BaseInfo -> IO CUInt
g_property_info_get_flags Ptr BaseInfo
info'
    let result' :: [ParamFlags]
result' = CUInt -> [ParamFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    [ParamFlags] -> IO [ParamFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParamFlags]
result'


-- function object_info_get_vfunc
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of virtual function to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_vfunc" g_object_info_get_vfunc :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain an object type virtual function at index /@n@/.
objectInfoGetVfunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> Int32
    -- ^ /@n@/: index of virtual function to get
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIVFuncInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
objectInfoGetVfunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
objectInfoGetVfunc BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_object_info_get_vfunc Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"objectInfoGetVfunc" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function object_info_get_unref_function
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , 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_object_info_get_unref_function" g_object_info_get_unref_function :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CString

-- | Obtain the symbol name of the function that should be called to unref this
-- object type. It\'s mainly used fundamental types. The type signature for
-- the symbol is @/GIObjectInfoUnrefFunction/@, to fetch the function pointer
-- see 'GI.GIRepository.Functions.objectInfoGetUnrefFunction'.
objectInfoGetUnrefFunction ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the symbol or 'P.Nothing'
objectInfoGetUnrefFunction :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m (Maybe Text)
objectInfoGetUnrefFunction BaseInfo
info = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
result <- Ptr BaseInfo -> IO CString
g_object_info_get_unref_function Ptr BaseInfo
info'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult


-- function object_info_get_type_name
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , 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_object_info_get_type_name" g_object_info_get_type_name :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CString

-- | Obtain the name of the objects class\/type.
objectInfoGetTypeName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m T.Text
    -- ^ __Returns:__ name of the objects type
objectInfoGetTypeName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Text
objectInfoGetTypeName BaseInfo
info = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
result <- Ptr BaseInfo -> IO CString
g_object_info_get_type_name Ptr BaseInfo
info'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"objectInfoGetTypeName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'


-- function object_info_get_type_init
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , 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_object_info_get_type_init" g_object_info_get_type_init :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CString

-- | Obtain the function which when called will return the GType
-- function for which this object type is registered.
objectInfoGetTypeInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m T.Text
    -- ^ __Returns:__ the type init function
objectInfoGetTypeInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Text
objectInfoGetTypeInit BaseInfo
info = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
result <- Ptr BaseInfo -> IO CString
g_object_info_get_type_init Ptr BaseInfo
info'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"objectInfoGetTypeInit" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'


-- function object_info_get_signal
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of signal to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_signal" g_object_info_get_signal :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain an object type signal at index /@n@/.
objectInfoGetSignal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> Int32
    -- ^ /@n@/: index of signal to get
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GISignalInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
objectInfoGetSignal :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
objectInfoGetSignal BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_object_info_get_signal Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"objectInfoGetSignal" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function object_info_get_set_value_function
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , 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_object_info_get_set_value_function" g_object_info_get_set_value_function :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CString

-- | Obtain the symbol name of the function that should be called to convert
-- set a GValue giving an object instance pointer of this object type.
-- I\'s mainly used fundamental types. The type signature for the symbol
-- is @/GIObjectInfoSetValueFunction/@, to fetch the function pointer
-- see 'GI.GIRepository.Functions.objectInfoGetSetValueFunction'.
objectInfoGetSetValueFunction ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the symbol or 'P.Nothing'
objectInfoGetSetValueFunction :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m (Maybe Text)
objectInfoGetSetValueFunction BaseInfo
info = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
result <- Ptr BaseInfo -> IO CString
g_object_info_get_set_value_function Ptr BaseInfo
info'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult


-- function object_info_get_ref_function
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , 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_object_info_get_ref_function" g_object_info_get_ref_function :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CString

-- | Obtain the symbol name of the function that should be called to ref this
-- object type. It\'s mainly used fundamental types. The type signature for
-- the symbol is @/GIObjectInfoRefFunction/@, to fetch the function pointer
-- see 'GI.GIRepository.Functions.objectInfoGetRefFunction'.
objectInfoGetRefFunction ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the symbol or 'P.Nothing'
objectInfoGetRefFunction :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m (Maybe Text)
objectInfoGetRefFunction BaseInfo
info = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
result <- Ptr BaseInfo -> IO CString
g_object_info_get_ref_function Ptr BaseInfo
info'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult


-- function object_info_get_property
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of property to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_property" g_object_info_get_property :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain an object type property at index /@n@/.
objectInfoGetProperty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> Int32
    -- ^ /@n@/: index of property to get
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIPropertyInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
objectInfoGetProperty :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
objectInfoGetProperty BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_object_info_get_property Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"objectInfoGetProperty" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function object_info_get_parent
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_parent" g_object_info_get_parent :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the parent of the object type.
objectInfoGetParent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m (Maybe GIRepository.BaseInfo.BaseInfo)
    -- ^ __Returns:__ the @/GIObjectInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
objectInfoGetParent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m (Maybe BaseInfo)
objectInfoGetParent BaseInfo
info = IO (Maybe BaseInfo) -> m (Maybe BaseInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BaseInfo) -> m (Maybe BaseInfo))
-> IO (Maybe BaseInfo) -> m (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_object_info_get_parent Ptr BaseInfo
info'
    Maybe BaseInfo
maybeResult <- Ptr BaseInfo
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr BaseInfo
result ((Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo))
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr BaseInfo
result' -> do
        BaseInfo
result'' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result'
        BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result''
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Maybe BaseInfo -> IO (Maybe BaseInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseInfo
maybeResult


-- function object_info_get_n_vfuncs
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_n_vfuncs" g_object_info_get_n_vfuncs :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of virtual functions that this object type has.
objectInfoGetNVfuncs ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m Int32
    -- ^ __Returns:__ number of virtual functions
objectInfoGetNVfuncs :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
objectInfoGetNVfuncs BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_object_info_get_n_vfuncs Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function object_info_get_n_signals
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_n_signals" g_object_info_get_n_signals :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of signals that this object type has.
objectInfoGetNSignals ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m Int32
    -- ^ __Returns:__ number of signals
objectInfoGetNSignals :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
objectInfoGetNSignals BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_object_info_get_n_signals Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function object_info_get_n_properties
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_n_properties" g_object_info_get_n_properties :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of properties that this object type has.
objectInfoGetNProperties ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m Int32
    -- ^ __Returns:__ number of properties
objectInfoGetNProperties :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
objectInfoGetNProperties BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_object_info_get_n_properties Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function object_info_get_n_methods
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_n_methods" g_object_info_get_n_methods :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of methods that this object type has.
objectInfoGetNMethods ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m Int32
    -- ^ __Returns:__ number of methods
objectInfoGetNMethods :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
objectInfoGetNMethods BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_object_info_get_n_methods Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function object_info_get_n_interfaces
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_n_interfaces" g_object_info_get_n_interfaces :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of interfaces that this object type has.
objectInfoGetNInterfaces ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m Int32
    -- ^ __Returns:__ number of interfaces
objectInfoGetNInterfaces :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
objectInfoGetNInterfaces BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_object_info_get_n_interfaces Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function object_info_get_n_fields
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_n_fields" g_object_info_get_n_fields :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of fields that this object type has.
objectInfoGetNFields ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m Int32
    -- ^ __Returns:__ number of fields
objectInfoGetNFields :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
objectInfoGetNFields BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_object_info_get_n_fields Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function object_info_get_n_constants
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_n_constants" g_object_info_get_n_constants :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of constants that this object type has.
objectInfoGetNConstants ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m Int32
    -- ^ __Returns:__ number of constants
objectInfoGetNConstants :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
objectInfoGetNConstants BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_object_info_get_n_constants Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function object_info_get_method
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of method to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_method" g_object_info_get_method :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain an object type method at index /@n@/.
objectInfoGetMethod ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> Int32
    -- ^ /@n@/: index of method to get
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIFunctionInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
objectInfoGetMethod :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
objectInfoGetMethod BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_object_info_get_method Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"objectInfoGetMethod" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function object_info_get_interface
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of interface to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_interface" g_object_info_get_interface :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain an object type interface at index /@n@/.
objectInfoGetInterface ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> Int32
    -- ^ /@n@/: index of interface to get
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIInterfaceInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
objectInfoGetInterface :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
objectInfoGetInterface BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_object_info_get_interface Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"objectInfoGetInterface" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function object_info_get_get_value_function
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , 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_object_info_get_get_value_function" g_object_info_get_get_value_function :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CString

-- | Obtain the symbol name of the function that should be called to convert
-- an object instance pointer of this object type to a GValue.
-- I\'s mainly used fundamental types. The type signature for the symbol
-- is @/GIObjectInfoGetValueFunction/@, to fetch the function pointer
-- see 'GI.GIRepository.Functions.objectInfoGetGetValueFunction'.
objectInfoGetGetValueFunction ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the symbol or 'P.Nothing'
objectInfoGetGetValueFunction :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m (Maybe Text)
objectInfoGetGetValueFunction BaseInfo
info = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
result <- Ptr BaseInfo -> IO CString
g_object_info_get_get_value_function Ptr BaseInfo
info'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult


-- function object_info_get_fundamental
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_fundamental" g_object_info_get_fundamental :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Obtain if the object type is of a fundamental type which is not
-- G_TYPE_OBJECT. This is mostly for supporting GstMiniObject.
objectInfoGetFundamental ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the object type is a fundamental type
objectInfoGetFundamental :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
objectInfoGetFundamental BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_object_info_get_fundamental Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function object_info_get_final
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_final" g_object_info_get_final :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Checks whether the object type is a final type, i.e. if it cannot
-- be derived
-- 
-- /Since: 1.70/
objectInfoGetFinal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the object type is final
objectInfoGetFinal :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
objectInfoGetFinal BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_object_info_get_final Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function object_info_get_field
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of field to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_field" g_object_info_get_field :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain an object type field at index /@n@/.
objectInfoGetField ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> Int32
    -- ^ /@n@/: index of field to get
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIFieldInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
objectInfoGetField :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
objectInfoGetField BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_object_info_get_field Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"objectInfoGetField" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function object_info_get_constant
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of constant to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_constant" g_object_info_get_constant :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain an object type constant at index /@n@/.
objectInfoGetConstant ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> Int32
    -- ^ /@n@/: index of constant to get
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIConstantInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
objectInfoGetConstant :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
objectInfoGetConstant BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_object_info_get_constant Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"objectInfoGetConstant" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function object_info_get_class_struct
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_class_struct" g_object_info_get_class_struct :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Every t'GI.GObject.Objects.Object.Object' has two structures; an instance structure and a class
-- structure.  This function returns the metadata for the class structure.
objectInfoGetClassStruct ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m (Maybe GIRepository.BaseInfo.BaseInfo)
    -- ^ __Returns:__ the @/GIStructInfo/@ or 'P.Nothing'. Free with
    -- @/g_base_info_unref()/@ when done.
objectInfoGetClassStruct :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m (Maybe BaseInfo)
objectInfoGetClassStruct BaseInfo
info = IO (Maybe BaseInfo) -> m (Maybe BaseInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BaseInfo) -> m (Maybe BaseInfo))
-> IO (Maybe BaseInfo) -> m (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_object_info_get_class_struct Ptr BaseInfo
info'
    Maybe BaseInfo
maybeResult <- Ptr BaseInfo
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr BaseInfo
result ((Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo))
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr BaseInfo
result' -> do
        BaseInfo
result'' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result'
        BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result''
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Maybe BaseInfo -> IO (Maybe BaseInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseInfo
maybeResult


-- function object_info_get_abstract
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_get_abstract" g_object_info_get_abstract :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Obtain if the object type is an abstract type, eg if it cannot be
-- instantiated
objectInfoGetAbstract ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the object type is abstract
objectInfoGetAbstract :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
objectInfoGetAbstract BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_object_info_get_abstract Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function object_info_find_vfunc_using_interfaces
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , 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 "name of vfunc to obtain"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "implementor"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The implementor of the interface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_find_vfunc_using_interfaces" g_object_info_find_vfunc_using_interfaces :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr (Ptr GIRepository.BaseInfo.BaseInfo) -> -- implementor : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Locate a virtual function slot with name /@name@/, searching both the object
-- /@info@/ and any interfaces it implements.  Note that the namespace for
-- virtuals is distinct from that of methods; there may or may not be a
-- concrete method associated for a virtual. If there is one, it may be
-- retrieved using 'GI.GIRepository.Functions.vfuncInfoGetInvoker', otherwise 'P.Nothing' will be
-- returned.
-- 
-- Note that this function does *not* search parent classes; you will have
-- to chain up if that\'s desired.
objectInfoFindVfuncUsingInterfaces ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> T.Text
    -- ^ /@name@/: name of vfunc to obtain
    -> m ((Maybe GIRepository.BaseInfo.BaseInfo, GIRepository.BaseInfo.BaseInfo))
    -- ^ __Returns:__ the @/GIVFuncInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
objectInfoFindVfuncUsingInterfaces :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Text -> m (Maybe BaseInfo, BaseInfo)
objectInfoFindVfuncUsingInterfaces BaseInfo
info Text
name = IO (Maybe BaseInfo, BaseInfo) -> m (Maybe BaseInfo, BaseInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BaseInfo, BaseInfo) -> m (Maybe BaseInfo, BaseInfo))
-> IO (Maybe BaseInfo, BaseInfo) -> m (Maybe BaseInfo, BaseInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr (Ptr BaseInfo)
implementor <- IO (Ptr (Ptr BaseInfo))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr GIRepository.BaseInfo.BaseInfo))
    Ptr BaseInfo
result <- Ptr BaseInfo -> CString -> Ptr (Ptr BaseInfo) -> IO (Ptr BaseInfo)
g_object_info_find_vfunc_using_interfaces Ptr BaseInfo
info' CString
name' Ptr (Ptr BaseInfo)
implementor
    Maybe BaseInfo
maybeResult <- Ptr BaseInfo
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr BaseInfo
result ((Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo))
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr BaseInfo
result' -> do
        BaseInfo
result'' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result'
        BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result''
    Ptr BaseInfo
implementor' <- Ptr (Ptr BaseInfo) -> IO (Ptr BaseInfo)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr BaseInfo)
implementor
    BaseInfo
implementor'' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
implementor'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr (Ptr BaseInfo) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr BaseInfo)
implementor
    (Maybe BaseInfo, BaseInfo) -> IO (Maybe BaseInfo, BaseInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseInfo
maybeResult, BaseInfo
implementor'')


-- function object_info_find_vfunc
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , 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 a virtual function to find."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_find_vfunc" g_object_info_find_vfunc :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Locate a virtual function slot with name /@name@/. Note that the namespace
-- for virtuals is distinct from that of methods; there may or may not be
-- a concrete method associated for a virtual. If there is one, it may
-- be retrieved using 'GI.GIRepository.Functions.vfuncInfoGetInvoker', otherwise 'P.Nothing' will be
-- returned.
-- See the documentation for 'GI.GIRepository.Functions.vfuncInfoGetInvoker' for more
-- information on invoking virtuals.
objectInfoFindVfunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> T.Text
    -- ^ /@name@/: The name of a virtual function to find.
    -> m (Maybe GIRepository.BaseInfo.BaseInfo)
    -- ^ __Returns:__ the @/GIVFuncInfo/@, or 'P.Nothing'. Free it with
    -- @/g_base_info_unref()/@ when done.
objectInfoFindVfunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Text -> m (Maybe BaseInfo)
objectInfoFindVfunc BaseInfo
info Text
name = IO (Maybe BaseInfo) -> m (Maybe BaseInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BaseInfo) -> m (Maybe BaseInfo))
-> IO (Maybe BaseInfo) -> m (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr BaseInfo
result <- Ptr BaseInfo -> CString -> IO (Ptr BaseInfo)
g_object_info_find_vfunc Ptr BaseInfo
info' CString
name'
    Maybe BaseInfo
maybeResult <- Ptr BaseInfo
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr BaseInfo
result ((Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo))
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr BaseInfo
result' -> do
        BaseInfo
result'' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result'
        BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result''
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Maybe BaseInfo -> IO (Maybe BaseInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseInfo
maybeResult


-- function object_info_find_signal
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , 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 "Name of signal" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_find_signal" g_object_info_find_signal :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | TODO
objectInfoFindSignal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> T.Text
    -- ^ /@name@/: Name of signal
    -> m (Maybe GIRepository.BaseInfo.BaseInfo)
    -- ^ __Returns:__ Info for the signal with name /@name@/ in /@info@/, or 'P.Nothing' on failure.
objectInfoFindSignal :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Text -> m (Maybe BaseInfo)
objectInfoFindSignal BaseInfo
info Text
name = IO (Maybe BaseInfo) -> m (Maybe BaseInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BaseInfo) -> m (Maybe BaseInfo))
-> IO (Maybe BaseInfo) -> m (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr BaseInfo
result <- Ptr BaseInfo -> CString -> IO (Ptr BaseInfo)
g_object_info_find_signal Ptr BaseInfo
info' CString
name'
    Maybe BaseInfo
maybeResult <- Ptr BaseInfo
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr BaseInfo
result ((Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo))
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr BaseInfo
result' -> do
        BaseInfo
result'' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result'
        BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result''
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Maybe BaseInfo -> IO (Maybe BaseInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseInfo
maybeResult


-- function object_info_find_method_using_interfaces
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , 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 "name of method to obtain"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "implementor"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The implementor of the interface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_find_method_using_interfaces" g_object_info_find_method_using_interfaces :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr (Ptr GIRepository.BaseInfo.BaseInfo) -> -- implementor : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain a method of the object given a /@name@/, searching both the
-- object /@info@/ and any interfaces it implements.  'P.Nothing' will be
-- returned if there\'s no method available with that name.
-- 
-- Note that this function does *not* search parent classes; you will have
-- to chain up if that\'s desired.
objectInfoFindMethodUsingInterfaces ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> T.Text
    -- ^ /@name@/: name of method to obtain
    -> m ((Maybe GIRepository.BaseInfo.BaseInfo, GIRepository.BaseInfo.BaseInfo))
    -- ^ __Returns:__ the @/GIFunctionInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
objectInfoFindMethodUsingInterfaces :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Text -> m (Maybe BaseInfo, BaseInfo)
objectInfoFindMethodUsingInterfaces BaseInfo
info Text
name = IO (Maybe BaseInfo, BaseInfo) -> m (Maybe BaseInfo, BaseInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BaseInfo, BaseInfo) -> m (Maybe BaseInfo, BaseInfo))
-> IO (Maybe BaseInfo, BaseInfo) -> m (Maybe BaseInfo, BaseInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr (Ptr BaseInfo)
implementor <- IO (Ptr (Ptr BaseInfo))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr GIRepository.BaseInfo.BaseInfo))
    Ptr BaseInfo
result <- Ptr BaseInfo -> CString -> Ptr (Ptr BaseInfo) -> IO (Ptr BaseInfo)
g_object_info_find_method_using_interfaces Ptr BaseInfo
info' CString
name' Ptr (Ptr BaseInfo)
implementor
    Maybe BaseInfo
maybeResult <- Ptr BaseInfo
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr BaseInfo
result ((Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo))
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr BaseInfo
result' -> do
        BaseInfo
result'' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result'
        BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result''
    Ptr BaseInfo
implementor' <- Ptr (Ptr BaseInfo) -> IO (Ptr BaseInfo)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr BaseInfo)
implementor
    BaseInfo
implementor'' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
implementor'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr (Ptr BaseInfo) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr BaseInfo)
implementor
    (Maybe BaseInfo, BaseInfo) -> IO (Maybe BaseInfo, BaseInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BaseInfo
maybeResult, BaseInfo
implementor'')


-- function object_info_find_method
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIObjectInfo" , 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 "name of method to obtain"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_object_info_find_method" g_object_info_find_method :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain a method of the object type given a /@name@/. 'P.Nothing' will be
-- returned if there\'s no method available with that name.
objectInfoFindMethod ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIObjectInfo/@
    -> T.Text
    -- ^ /@name@/: name of method to obtain
    -> m (Maybe GIRepository.BaseInfo.BaseInfo)
    -- ^ __Returns:__ the @/GIFunctionInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
objectInfoFindMethod :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Text -> m (Maybe BaseInfo)
objectInfoFindMethod BaseInfo
info Text
name = IO (Maybe BaseInfo) -> m (Maybe BaseInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BaseInfo) -> m (Maybe BaseInfo))
-> IO (Maybe BaseInfo) -> m (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr BaseInfo
result <- Ptr BaseInfo -> CString -> IO (Ptr BaseInfo)
g_object_info_find_method Ptr BaseInfo
info' CString
name'
    Maybe BaseInfo
maybeResult <- Ptr BaseInfo
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr BaseInfo
result ((Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo))
-> (Ptr BaseInfo -> IO BaseInfo) -> IO (Maybe BaseInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr BaseInfo
result' -> do
        BaseInfo
result'' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result'
        BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result''
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Maybe BaseInfo -> IO (Maybe BaseInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseInfo
maybeResult


-- function invoke_error_quark
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "g_invoke_error_quark" g_invoke_error_quark :: 
    IO Word32

-- | TODO
invokeErrorQuark ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Word32
    -- ^ __Returns:__ TODO
invokeErrorQuark :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Word32
invokeErrorQuark  = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Word32
result <- IO Word32
g_invoke_error_quark
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function interface_info_get_vfunc
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of virtual function to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_get_vfunc" g_interface_info_get_vfunc :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain an interface type virtual function at index /@n@/.
interfaceInfoGetVfunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> Int32
    -- ^ /@n@/: index of virtual function to get
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIVFuncInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
interfaceInfoGetVfunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
interfaceInfoGetVfunc BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_interface_info_get_vfunc Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"interfaceInfoGetVfunc" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function interface_info_get_signal
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of signal to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_get_signal" g_interface_info_get_signal :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain an interface type signal at index /@n@/.
interfaceInfoGetSignal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> Int32
    -- ^ /@n@/: index of signal to get
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GISignalInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
interfaceInfoGetSignal :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
interfaceInfoGetSignal BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_interface_info_get_signal Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"interfaceInfoGetSignal" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function interface_info_get_property
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of property to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_get_property" g_interface_info_get_property :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain an interface type property at index /@n@/.
interfaceInfoGetProperty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> Int32
    -- ^ /@n@/: index of property to get
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIPropertyInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
interfaceInfoGetProperty :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
interfaceInfoGetProperty BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_interface_info_get_property Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"interfaceInfoGetProperty" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function interface_info_get_prerequisite
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of prerequisites to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_get_prerequisite" g_interface_info_get_prerequisite :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain an interface type prerequisites index /@n@/.
interfaceInfoGetPrerequisite ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> Int32
    -- ^ /@n@/: index of prerequisites to get
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the prerequisites as a t'GI.GIRepository.Structs.BaseInfo.BaseInfo'. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
interfaceInfoGetPrerequisite :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
interfaceInfoGetPrerequisite BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_interface_info_get_prerequisite Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"interfaceInfoGetPrerequisite" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function interface_info_get_n_vfuncs
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_get_n_vfuncs" g_interface_info_get_n_vfuncs :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of virtual functions that this interface type has.
interfaceInfoGetNVfuncs ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> m Int32
    -- ^ __Returns:__ number of virtual functions
interfaceInfoGetNVfuncs :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
interfaceInfoGetNVfuncs BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_interface_info_get_n_vfuncs Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function interface_info_get_n_signals
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_get_n_signals" g_interface_info_get_n_signals :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of signals that this interface type has.
interfaceInfoGetNSignals ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> m Int32
    -- ^ __Returns:__ number of signals
interfaceInfoGetNSignals :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
interfaceInfoGetNSignals BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_interface_info_get_n_signals Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function interface_info_get_n_properties
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_get_n_properties" g_interface_info_get_n_properties :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of properties that this interface type has.
interfaceInfoGetNProperties ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> m Int32
    -- ^ __Returns:__ number of properties
interfaceInfoGetNProperties :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
interfaceInfoGetNProperties BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_interface_info_get_n_properties Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function interface_info_get_n_prerequisites
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_get_n_prerequisites" g_interface_info_get_n_prerequisites :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of prerequisites for this interface type.
-- A prerequisites is another interface that needs to be implemented for
-- interface, similar to an base class for GObjects.
interfaceInfoGetNPrerequisites ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> m Int32
    -- ^ __Returns:__ number of prerequisites
interfaceInfoGetNPrerequisites :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
interfaceInfoGetNPrerequisites BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_interface_info_get_n_prerequisites Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function interface_info_get_n_methods
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_get_n_methods" g_interface_info_get_n_methods :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of methods that this interface type has.
interfaceInfoGetNMethods ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> m Int32
    -- ^ __Returns:__ number of methods
interfaceInfoGetNMethods :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
interfaceInfoGetNMethods BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_interface_info_get_n_methods Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function interface_info_get_n_constants
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_get_n_constants" g_interface_info_get_n_constants :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of constants that this interface type has.
interfaceInfoGetNConstants ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> m Int32
    -- ^ __Returns:__ number of constants
interfaceInfoGetNConstants :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
interfaceInfoGetNConstants BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_interface_info_get_n_constants Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function interface_info_get_method
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of method to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_get_method" g_interface_info_get_method :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain an interface type method at index /@n@/.
interfaceInfoGetMethod ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> Int32
    -- ^ /@n@/: index of method to get
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIFunctionInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
interfaceInfoGetMethod :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
interfaceInfoGetMethod BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_interface_info_get_method Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"interfaceInfoGetMethod" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function interface_info_get_iface_struct
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_get_iface_struct" g_interface_info_get_iface_struct :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Returns the layout C structure associated with this @/GInterface/@.
interfaceInfoGetIfaceStruct ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIStructInfo/@ or 'P.Nothing'. Free it with
    -- @/g_base_info_unref()/@ when done.
interfaceInfoGetIfaceStruct :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
interfaceInfoGetIfaceStruct BaseInfo
info = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_interface_info_get_iface_struct Ptr BaseInfo
info'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"interfaceInfoGetIfaceStruct" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function interface_info_get_constant
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of constant to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_get_constant" g_interface_info_get_constant :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain an interface type constant at index /@n@/.
interfaceInfoGetConstant ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> Int32
    -- ^ /@n@/: index of constant to get
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIConstantInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
interfaceInfoGetConstant :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
interfaceInfoGetConstant BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_interface_info_get_constant Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"interfaceInfoGetConstant" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function interface_info_find_vfunc
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , 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 a virtual function to find."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_find_vfunc" g_interface_info_find_vfunc :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Locate a virtual function slot with name /@name@/. See the documentation
-- for 'GI.GIRepository.Functions.objectInfoFindVfunc' for more information on virtuals.
interfaceInfoFindVfunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> T.Text
    -- ^ /@name@/: The name of a virtual function to find.
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIVFuncInfo/@, or 'P.Nothing'. Free it with
    -- @/g_base_info_unref()/@ when done.
interfaceInfoFindVfunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Text -> m BaseInfo
interfaceInfoFindVfunc BaseInfo
info Text
name = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr BaseInfo
result <- Ptr BaseInfo -> CString -> IO (Ptr BaseInfo)
g_interface_info_find_vfunc Ptr BaseInfo
info' CString
name'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"interfaceInfoFindVfunc" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function interface_info_find_signal
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , 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 "Name of signal" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_find_signal" g_interface_info_find_signal :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | TODO
-- 
-- /Since: 1.34/
interfaceInfoFindSignal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> T.Text
    -- ^ /@name@/: Name of signal
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ Info for the signal with name /@name@/ in /@info@/, or
    -- 'P.Nothing' on failure.
interfaceInfoFindSignal :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Text -> m BaseInfo
interfaceInfoFindSignal BaseInfo
info Text
name = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr BaseInfo
result <- Ptr BaseInfo -> CString -> IO (Ptr BaseInfo)
g_interface_info_find_signal Ptr BaseInfo
info' CString
name'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"interfaceInfoFindSignal" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function interface_info_find_method
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIInterfaceInfo" , 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 "name of method to obtain"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_interface_info_find_method" g_interface_info_find_method :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain a method of the interface type given a /@name@/. 'P.Nothing' will be
-- returned if there\'s no method available with that name.
interfaceInfoFindMethod ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIInterfaceInfo/@
    -> T.Text
    -- ^ /@name@/: name of method to obtain
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIFunctionInfo/@ or 'P.Nothing' if none found.
    -- Free the struct by calling @/g_base_info_unref()/@ when done.
interfaceInfoFindMethod :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Text -> m BaseInfo
interfaceInfoFindMethod BaseInfo
info Text
name = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr BaseInfo
result <- Ptr BaseInfo -> CString -> IO (Ptr BaseInfo)
g_interface_info_find_method Ptr BaseInfo
info' CString
name'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"interfaceInfoFindMethod" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function info_type_to_string
-- Args: [ Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "InfoType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the info type" , 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_info_type_to_string" g_info_type_to_string :: 
    CUInt ->                                -- type : TInterface (Name {namespace = "GIRepository", name = "InfoType"})
    IO CString

-- | Obtain a string representation of /@type@/
infoTypeToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.Enums.InfoType
    -- ^ /@type@/: the info type
    -> m T.Text
    -- ^ __Returns:__ the string
infoTypeToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
InfoType -> m Text
infoTypeToString InfoType
type_ = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (InfoType -> Int) -> InfoType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InfoType -> Int
forall a. Enum a => a -> Int
fromEnum) InfoType
type_
    CString
result <- CUInt -> IO CString
g_info_type_to_string CUInt
type_'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"infoTypeToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'


-- function info_new
-- Args: [ Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "InfoType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "typelib"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "Typelib" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_info_new" g_info_new :: 
    CUInt ->                                -- type : TInterface (Name {namespace = "GIRepository", name = "InfoType"})
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- container : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Ptr GIRepository.Typelib.Typelib ->     -- typelib : TInterface (Name {namespace = "GIRepository", name = "Typelib"})
    Word32 ->                               -- offset : TBasicType TUInt32
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | TODO
infoNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.Enums.InfoType
    -- ^ /@type@/: TODO
    -> GIRepository.BaseInfo.BaseInfo
    -- ^ /@container@/: TODO
    -> GIRepository.Typelib.Typelib
    -- ^ /@typelib@/: TODO
    -> Word32
    -- ^ /@offset@/: TODO
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ TODO
infoNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
InfoType -> BaseInfo -> Typelib -> Word32 -> m BaseInfo
infoNew InfoType
type_ BaseInfo
container Typelib
typelib Word32
offset = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (InfoType -> Int) -> InfoType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InfoType -> Int
forall a. Enum a => a -> Int
fromEnum) InfoType
type_
    Ptr BaseInfo
container' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
container
    Ptr Typelib
typelib' <- Typelib -> IO (Ptr Typelib)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Typelib
typelib
    Ptr BaseInfo
result <- CUInt -> Ptr BaseInfo -> Ptr Typelib -> Word32 -> IO (Ptr BaseInfo)
g_info_new CUInt
type_' Ptr BaseInfo
container' Ptr Typelib
typelib' Word32
offset
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"infoNew" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
container
    Typelib -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Typelib
typelib
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function get_minor_version
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gi_get_minor_version" gi_get_minor_version :: 
    IO Word32

-- | Returns the minor version number of the girepository library.
-- (e.g. in version 1.58.2 this is 58.)
-- 
-- /Since: 1.60/
getMinorVersion ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Word32
    -- ^ __Returns:__ the minor version number of the girepository library
getMinorVersion :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Word32
getMinorVersion  = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Word32
result <- IO Word32
gi_get_minor_version
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function get_micro_version
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gi_get_micro_version" gi_get_micro_version :: 
    IO Word32

-- | Returns the micro version number of the girepository library.
-- (e.g. in version 1.58.2 this is 2.)
-- 
-- /Since: 1.60/
getMicroVersion ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Word32
    -- ^ __Returns:__ the micro version number of the girepository library
getMicroVersion :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Word32
getMicroVersion  = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Word32
result <- IO Word32
gi_get_micro_version
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function get_major_version
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gi_get_major_version" gi_get_major_version :: 
    IO Word32

-- | Returns the major version number of the girepository library.
-- (e.g. in version 1.58.2 this is 1.)
-- 
-- /Since: 1.60/
getMajorVersion ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Word32
    -- ^ __Returns:__ the major version number of the girepository library
getMajorVersion :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Word32
getMajorVersion  = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Word32
result <- IO Word32
gi_get_major_version
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result


-- function function_info_get_vfunc
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIFunctionInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_function_info_get_vfunc" g_function_info_get_vfunc :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the virtual function associated with this @/GIFunctionInfo/@.
-- Only @/GIFunctionInfo/@ with the flag 'GI.GIRepository.Flags.FunctionInfoFlagsWrapsVfunc' has
-- a virtual function set. For other cases, 'P.Nothing' will be returned.
functionInfoGetVfunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIFunctionInfo/@
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the virtual function or 'P.Nothing' if not set.
    -- Free it by calling @/g_base_info_unref()/@ when done.
functionInfoGetVfunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
functionInfoGetVfunc BaseInfo
info = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_function_info_get_vfunc Ptr BaseInfo
info'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"functionInfoGetVfunc" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function function_info_get_symbol
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIFunctionInfo" , 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_function_info_get_symbol" g_function_info_get_symbol :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CString

-- | Obtain the symbol of the function. The symbol is the name of the
-- exported function, suitable to be used as an argument to
-- @/g_module_symbol()/@.
functionInfoGetSymbol ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIFunctionInfo/@
    -> m T.Text
    -- ^ __Returns:__ the symbol
functionInfoGetSymbol :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Text
functionInfoGetSymbol BaseInfo
info = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
result <- Ptr BaseInfo -> IO CString
g_function_info_get_symbol Ptr BaseInfo
info'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"functionInfoGetSymbol" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'


-- function function_info_get_property
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIFunctionInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_function_info_get_property" g_function_info_get_property :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the property associated with this @/GIFunctionInfo/@.
-- Only @/GIFunctionInfo/@ with the flag 'GI.GIRepository.Flags.FunctionInfoFlagsIsGetter' or
-- 'GI.GIRepository.Flags.FunctionInfoFlagsIsSetter' have a property set. For other cases,
-- 'P.Nothing' will be returned.
functionInfoGetProperty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIFunctionInfo/@
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the property or 'P.Nothing' if not set. Free it with
    -- @/g_base_info_unref()/@ when done.
functionInfoGetProperty :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
functionInfoGetProperty BaseInfo
info = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_function_info_get_property Ptr BaseInfo
info'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"functionInfoGetProperty" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function function_info_get_flags
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIFunctionInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "FunctionInfoFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "g_function_info_get_flags" g_function_info_get_flags :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CUInt

-- | Obtain the t'GI.GIRepository.Flags.FunctionInfoFlags' for the /@info@/.
functionInfoGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIFunctionInfo/@
    -> m [GIRepository.Flags.FunctionInfoFlags]
    -- ^ __Returns:__ the flags
functionInfoGetFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m [FunctionInfoFlags]
functionInfoGetFlags BaseInfo
info = IO [FunctionInfoFlags] -> m [FunctionInfoFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FunctionInfoFlags] -> m [FunctionInfoFlags])
-> IO [FunctionInfoFlags] -> m [FunctionInfoFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CUInt
result <- Ptr BaseInfo -> IO CUInt
g_function_info_get_flags Ptr BaseInfo
info'
    let result' :: [FunctionInfoFlags]
result' = CUInt -> [FunctionInfoFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    [FunctionInfoFlags] -> IO [FunctionInfoFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FunctionInfoFlags]
result'


-- function field_info_get_type
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIFieldInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_field_info_get_type" g_field_info_get_type :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the type of a field as a @/GITypeInfo/@.
fieldInfoGetType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIFieldInfo/@
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GITypeInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
fieldInfoGetType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
fieldInfoGetType BaseInfo
info = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_field_info_get_type Ptr BaseInfo
info'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fieldInfoGetType" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function field_info_get_size
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIFieldInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_field_info_get_size" g_field_info_get_size :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the size in bits of the field member, this is how
-- much space you need to allocate to store the field.
fieldInfoGetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIFieldInfo/@
    -> m Int32
    -- ^ __Returns:__ the field size
fieldInfoGetSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
fieldInfoGetSize BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_field_info_get_size Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function field_info_get_offset
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIFieldInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_field_info_get_offset" g_field_info_get_offset :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the offset in bytes of the field member, this is relative
-- to the beginning of the struct or union.
fieldInfoGetOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIFieldInfo/@
    -> m Int32
    -- ^ __Returns:__ the field offset
fieldInfoGetOffset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
fieldInfoGetOffset BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_field_info_get_offset Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function field_info_get_flags
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIFieldInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "FieldInfoFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "g_field_info_get_flags" g_field_info_get_flags :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CUInt

-- | Obtain the flags for this @/GIFieldInfo/@. See t'GI.GIRepository.Flags.FieldInfoFlags' for possible
-- flag values.
fieldInfoGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIFieldInfo/@
    -> m [GIRepository.Flags.FieldInfoFlags]
    -- ^ __Returns:__ the flags
fieldInfoGetFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m [FieldInfoFlags]
fieldInfoGetFlags BaseInfo
info = IO [FieldInfoFlags] -> m [FieldInfoFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FieldInfoFlags] -> m [FieldInfoFlags])
-> IO [FieldInfoFlags] -> m [FieldInfoFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CUInt
result <- Ptr BaseInfo -> IO CUInt
g_field_info_get_flags Ptr BaseInfo
info'
    let result' :: [FieldInfoFlags]
result' = CUInt -> [FieldInfoFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    [FieldInfoFlags] -> IO [FieldInfoFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FieldInfoFlags]
result'


-- function enum_info_get_value
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIEnumInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of value to fetch"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_enum_info_get_value" g_enum_info_get_value :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain a value for this enumeration.
enumInfoGetValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIEnumInfo/@
    -> Int32
    -- ^ /@n@/: index of value to fetch
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the enumeration value or 'P.Nothing' if type tag is wrong,
    -- free the struct with @/g_base_info_unref()/@ when done.
enumInfoGetValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
enumInfoGetValue BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_enum_info_get_value Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"enumInfoGetValue" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function enum_info_get_storage_type
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIEnumInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GIRepository" , name = "TypeTag" })
-- throws : False
-- Skip return : False

foreign import ccall "g_enum_info_get_storage_type" g_enum_info_get_storage_type :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CUInt

-- | Obtain the tag of the type used for the enum in the C ABI. This will
-- will be a signed or unsigned integral type.
-- 
-- Note that in the current implementation the width of the type is
-- computed correctly, but the signed or unsigned nature of the type
-- may not match the sign of the type used by the C compiler.
enumInfoGetStorageType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIEnumInfo/@
    -> m GIRepository.Enums.TypeTag
    -- ^ __Returns:__ the storage type for the enumeration
enumInfoGetStorageType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m TypeTag
enumInfoGetStorageType BaseInfo
info = IO TypeTag -> m TypeTag
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TypeTag -> m TypeTag) -> IO TypeTag -> m TypeTag
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CUInt
result <- Ptr BaseInfo -> IO CUInt
g_enum_info_get_storage_type Ptr BaseInfo
info'
    let result' :: TypeTag
result' = (Int -> TypeTag
forall a. Enum a => Int -> a
toEnum (Int -> TypeTag) -> (CUInt -> Int) -> CUInt -> TypeTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    TypeTag -> IO TypeTag
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeTag
result'


-- function enum_info_get_n_values
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIEnumInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_enum_info_get_n_values" g_enum_info_get_n_values :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of values this enumeration contains.
enumInfoGetNValues ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIEnumInfo/@
    -> m Int32
    -- ^ __Returns:__ the number of enumeration values
enumInfoGetNValues :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
enumInfoGetNValues BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_enum_info_get_n_values Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function enum_info_get_n_methods
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIEnumInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_enum_info_get_n_methods" g_enum_info_get_n_methods :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of methods that this enum type has.
-- 
-- /Since: 1.30/
enumInfoGetNMethods ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIEnumInfo/@
    -> m Int32
    -- ^ __Returns:__ number of methods
enumInfoGetNMethods :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
enumInfoGetNMethods BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_enum_info_get_n_methods Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function enum_info_get_method
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIEnumInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of method to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_enum_info_get_method" g_enum_info_get_method :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain an enum type method at index /@n@/.
-- 
-- /Since: 1.30/
enumInfoGetMethod ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIEnumInfo/@
    -> Int32
    -- ^ /@n@/: index of method to get
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIFunctionInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
enumInfoGetMethod :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
enumInfoGetMethod BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_enum_info_get_method Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"enumInfoGetMethod" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function enum_info_get_error_domain
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIEnumInfo" , 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_enum_info_get_error_domain" g_enum_info_get_error_domain :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CString

-- | Obtain the string form of the quark for the error domain associated with
-- this enum, if any.
-- 
-- /Since: 1.30/
enumInfoGetErrorDomain ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIEnumInfo/@
    -> m T.Text
    -- ^ __Returns:__ the string form of the error domain associated
    -- with this enum, or 'P.Nothing'.
enumInfoGetErrorDomain :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Text
enumInfoGetErrorDomain BaseInfo
info = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
result <- Ptr BaseInfo -> IO CString
g_enum_info_get_error_domain Ptr BaseInfo
info'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"enumInfoGetErrorDomain" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'


-- function constant_info_get_type
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIConstantInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_constant_info_get_type" g_constant_info_get_type :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the type of the constant as a @/GITypeInfo/@.
constantInfoGetType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIConstantInfo/@
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GITypeInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
constantInfoGetType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
constantInfoGetType BaseInfo
info = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_constant_info_get_type Ptr BaseInfo
info'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"constantInfoGetType" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function cclosure_marshal_generic
-- Args: [ Arg
--           { argCName = "closure"
--           , argType = TGClosure Nothing
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "return_gvalue"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_param_values"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "param_values"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "invocation_hint"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "marshal_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gi_cclosure_marshal_generic" gi_cclosure_marshal_generic :: 
    Ptr (GClosure ()) ->                    -- closure : TGClosure Nothing
    Ptr GValue ->                           -- return_gvalue : TGValue
    Word32 ->                               -- n_param_values : TBasicType TUInt
    Ptr GValue ->                           -- param_values : TGValue
    Ptr () ->                               -- invocation_hint : TBasicType TPtr
    Ptr () ->                               -- marshal_data : TBasicType TPtr
    IO ()

-- | /No description available in the introspection data./
cclosureMarshalGeneric ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GClosure a
    -> GValue
    -> Word32
    -> GValue
    -> Ptr ()
    -> Ptr ()
    -> m ()
cclosureMarshalGeneric :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m) =>
GClosure a
-> GValue -> Word32 -> GValue -> Ptr () -> Ptr () -> m ()
cclosureMarshalGeneric GClosure a
closure GValue
returnGvalue Word32
nParamValues GValue
paramValues Ptr ()
invocationHint Ptr ()
marshalData = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr (GClosure ())
closure' <- GClosure a -> IO (Ptr (GClosure ()))
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr GClosure a
closure
    Ptr GValue
returnGvalue' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
returnGvalue
    Ptr GValue
paramValues' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
paramValues
    Ptr (GClosure ())
-> Ptr GValue -> Word32 -> Ptr GValue -> Ptr () -> Ptr () -> IO ()
gi_cclosure_marshal_generic Ptr (GClosure ())
closure' Ptr GValue
returnGvalue' Word32
nParamValues Ptr GValue
paramValues' Ptr ()
invocationHint Ptr ()
marshalData
    GClosure a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GClosure a
closure
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
returnGvalue
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
paramValues
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- function callable_info_skip_return
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GICallableInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_callable_info_skip_return" g_callable_info_skip_return :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | See if a callable\'s return value is only useful in C.
callableInfoSkipReturn ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GICallableInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if return value is only useful in C.
callableInfoSkipReturn :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
callableInfoSkipReturn BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_callable_info_skip_return Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function callable_info_may_return_null
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GICallableInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_callable_info_may_return_null" g_callable_info_may_return_null :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | See if a callable could return 'P.Nothing'.
callableInfoMayReturnNull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GICallableInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if callable could return 'P.Nothing'
callableInfoMayReturnNull :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
callableInfoMayReturnNull BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_callable_info_may_return_null Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function callable_info_load_return_type
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GICallableInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Initialized with return type of @info"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_callable_info_load_return_type" g_callable_info_load_return_type :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- type : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO ()

-- | Obtain information about a return value of callable; this
-- function is a variant of 'GI.GIRepository.Functions.callableInfoGetReturnType' designed for stack
-- allocation.
-- 
-- The initialized /@type@/ must not be referenced after /@info@/ is deallocated.
callableInfoLoadReturnType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GICallableInfo/@
    -> m (GIRepository.BaseInfo.BaseInfo)
callableInfoLoadReturnType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
callableInfoLoadReturnType BaseInfo
info = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
type_ <- Int -> IO (Ptr BaseInfo)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
72 :: IO (Ptr GIRepository.BaseInfo.BaseInfo)
    Ptr BaseInfo -> Ptr BaseInfo -> IO ()
g_callable_info_load_return_type Ptr BaseInfo
info' Ptr BaseInfo
type_
    BaseInfo
type_' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
type_
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
type_'


-- function callable_info_load_arg
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GICallableInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the argument index to fetch"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "arg"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Initialize with argument number @n"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_callable_info_load_arg" g_callable_info_load_arg :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- arg : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO ()

-- | Obtain information about a particular argument of this callable; this
-- function is a variant of 'GI.GIRepository.Functions.callableInfoGetArg' designed for stack
-- allocation.
-- 
-- The initialized /@arg@/ must not be referenced after /@info@/ is deallocated.
callableInfoLoadArg ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GICallableInfo/@
    -> Int32
    -- ^ /@n@/: the argument index to fetch
    -> m (GIRepository.BaseInfo.BaseInfo)
callableInfoLoadArg :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
callableInfoLoadArg BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
arg <- Int -> IO (Ptr BaseInfo)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
72 :: IO (Ptr GIRepository.BaseInfo.BaseInfo)
    Ptr BaseInfo -> Int32 -> Ptr BaseInfo -> IO ()
g_callable_info_load_arg Ptr BaseInfo
info' Int32
n Ptr BaseInfo
arg
    BaseInfo
arg' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
arg
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
arg'


-- function callable_info_iterate_return_attributes
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GICallableInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iterator"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "AttributeIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GIAttributeIter structure, must be initialized; see below"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Returned name, must not be freed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Returned name, must not be freed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_callable_info_iterate_return_attributes" g_callable_info_iterate_return_attributes :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Ptr GIRepository.AttributeIter.AttributeIter -> -- iterator : TInterface (Name {namespace = "GIRepository", name = "AttributeIter"})
    Ptr CString ->                          -- name : TBasicType TUTF8
    Ptr CString ->                          -- value : TBasicType TUTF8
    IO CInt

-- | Iterate over all attributes associated with the return value.  The
-- iterator structure is typically stack allocated, and must have its
-- first member initialized to 'P.Nothing'.
-- 
-- Both the /@name@/ and /@value@/ should be treated as constants
-- and must not be freed.
-- 
-- See 'GI.GIRepository.Structs.BaseInfo.baseInfoIterateAttributes' for an example of how to use a
-- similar API.
callableInfoIterateReturnAttributes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GICallableInfo/@
    -> GIRepository.AttributeIter.AttributeIter
    -- ^ /@iterator@/: a t'GI.GIRepository.Structs.AttributeIter.AttributeIter' structure, must be initialized; see below
    -> m ((Bool, T.Text, T.Text))
    -- ^ __Returns:__ 'P.True' if there are more attributes
callableInfoIterateReturnAttributes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> AttributeIter -> m (Bool, Text, Text)
callableInfoIterateReturnAttributes BaseInfo
info AttributeIter
iterator = IO (Bool, Text, Text) -> m (Bool, Text, Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Text, Text) -> m (Bool, Text, Text))
-> IO (Bool, Text, Text) -> m (Bool, Text, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr AttributeIter
iterator' <- AttributeIter -> IO (Ptr AttributeIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AttributeIter
iterator
    Ptr CString
name <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr CString
value <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    CInt
result <- Ptr BaseInfo
-> Ptr AttributeIter -> Ptr CString -> Ptr CString -> IO CInt
g_callable_info_iterate_return_attributes Ptr BaseInfo
info' Ptr AttributeIter
iterator' Ptr CString
name Ptr CString
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString
name' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
name
    Text
name'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
name'
    CString
value' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
value
    Text
value'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
value'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    AttributeIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AttributeIter
iterator
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
name
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
value
    (Bool, Text, Text) -> IO (Bool, Text, Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Text
name'', Text
value'')


-- function callable_info_is_method
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GICallableInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_callable_info_is_method" g_callable_info_is_method :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Determines if the callable info is a method. For @/GIVFuncInfo/@s,
-- @/GICallbackInfo/@s, and @/GISignalInfo/@s,
-- this is always true. Otherwise, this looks at the 'GI.GIRepository.Flags.FunctionInfoFlagsIsMethod'
-- flag on the @/GIFunctionInfo/@.
-- 
-- Concretely, this function returns whether 'GI.GIRepository.Functions.callableInfoGetNArgs'
-- matches the number of arguments in the raw C method. For methods, there
-- is one more C argument than is exposed by introspection: the \"self\"
-- or \"this\" object.
-- 
-- /Since: 1.34/
callableInfoIsMethod ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GICallableInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@info@/ is a method, 'P.False' otherwise
callableInfoIsMethod :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
callableInfoIsMethod BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_callable_info_is_method Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function callable_info_invoke
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "function"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "in_args"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 3
--                 (TInterface
--                    Name { namespace = "GIRepository" , name = "Argument" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_in_args"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_args"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 5
--                 (TInterface
--                    Name { namespace = "GIRepository" , name = "Argument" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_out_args"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "return_value"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "Argument" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "is_method"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "throws"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_out_args"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          , Arg
--              { argCName = "n_in_args"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation { rawDocText = Just "TODO" , sinceVersion = Nothing }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_callable_info_invoke" g_callable_info_invoke :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Ptr () ->                               -- function : TBasicType TPtr
    Ptr GIRepository.Argument.Argument ->   -- in_args : TCArray False (-1) 3 (TInterface (Name {namespace = "GIRepository", name = "Argument"}))
    Int32 ->                                -- n_in_args : TBasicType TInt
    Ptr GIRepository.Argument.Argument ->   -- out_args : TCArray False (-1) 5 (TInterface (Name {namespace = "GIRepository", name = "Argument"}))
    Int32 ->                                -- n_out_args : TBasicType TInt
    Ptr GIRepository.Argument.Argument ->   -- return_value : TInterface (Name {namespace = "GIRepository", name = "Argument"})
    CInt ->                                 -- is_method : TBasicType TBoolean
    CInt ->                                 -- throws : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | TODO
callableInfoInvoke ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: TODO
    -> Ptr ()
    -- ^ /@function@/: TODO
    -> [GIRepository.Argument.Argument]
    -- ^ /@inArgs@/: TODO
    -> [GIRepository.Argument.Argument]
    -- ^ /@outArgs@/: TODO
    -> GIRepository.Argument.Argument
    -- ^ /@returnValue@/: TODO
    -> Bool
    -- ^ /@isMethod@/: TODO
    -> Bool
    -- ^ /@throws@/: TODO
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
callableInfoInvoke :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo
-> Ptr ()
-> [Argument]
-> [Argument]
-> Argument
-> Bool
-> Bool
-> m ()
callableInfoInvoke BaseInfo
info Ptr ()
function [Argument]
inArgs [Argument]
outArgs Argument
returnValue Bool
isMethod Bool
throws = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let nOutArgs :: Int32
nOutArgs = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Argument] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Argument]
outArgs
    let nInArgs :: Int32
nInArgs = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Argument] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Argument]
inArgs
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    [Ptr Argument]
inArgs' <- (Argument -> IO (Ptr Argument)) -> [Argument] -> IO [Ptr Argument]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Argument -> IO (Ptr Argument)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [Argument]
inArgs
    Ptr Argument
inArgs'' <- Int -> [Ptr Argument] -> IO (Ptr Argument)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
8 [Ptr Argument]
inArgs'
    [Ptr Argument]
outArgs' <- (Argument -> IO (Ptr Argument)) -> [Argument] -> IO [Ptr Argument]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Argument -> IO (Ptr Argument)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [Argument]
outArgs
    Ptr Argument
outArgs'' <- Int -> [Ptr Argument] -> IO (Ptr Argument)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
8 [Ptr Argument]
outArgs'
    Ptr Argument
returnValue' <- Argument -> IO (Ptr Argument)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Argument
returnValue
    let isMethod' :: CInt
isMethod' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
isMethod
    let throws' :: CInt
throws' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
throws
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr BaseInfo
-> Ptr ()
-> Ptr Argument
-> Int32
-> Ptr Argument
-> Int32
-> Ptr Argument
-> CInt
-> CInt
-> Ptr (Ptr GError)
-> IO CInt
g_callable_info_invoke Ptr BaseInfo
info' Ptr ()
function Ptr Argument
inArgs'' Int32
nInArgs Ptr Argument
outArgs'' Int32
nOutArgs Ptr Argument
returnValue' CInt
isMethod' CInt
throws'
        BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
        (Argument -> IO ()) -> [Argument] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Argument -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Argument]
inArgs
        (Argument -> IO ()) -> [Argument] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Argument -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Argument]
outArgs
        Argument -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Argument
returnValue
        Ptr Argument -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Argument
inArgs''
        Ptr Argument -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Argument
outArgs''
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr Argument -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Argument
inArgs''
        Ptr Argument -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Argument
outArgs''
     )


-- function callable_info_get_return_type
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GICallableInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_callable_info_get_return_type" g_callable_info_get_return_type :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the return type of a callable item as a @/GITypeInfo/@.
callableInfoGetReturnType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GICallableInfo/@
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GITypeInfo/@. Free the struct by calling
    -- @/g_base_info_unref()/@ when done.
callableInfoGetReturnType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
callableInfoGetReturnType BaseInfo
info = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_callable_info_get_return_type Ptr BaseInfo
info'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"callableInfoGetReturnType" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function callable_info_get_return_attribute
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GICallableInfo" , 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 freeform string naming an attribute"
--                 , 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_callable_info_get_return_attribute" g_callable_info_get_return_attribute :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    CString ->                              -- name : TBasicType TUTF8
    IO CString

-- | Retrieve an arbitrary attribute associated with the return value.
callableInfoGetReturnAttribute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GICallableInfo/@
    -> T.Text
    -- ^ /@name@/: a freeform string naming an attribute
    -> m T.Text
    -- ^ __Returns:__ The value of the attribute, or 'P.Nothing' if no such attribute exists
callableInfoGetReturnAttribute :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Text -> m Text
callableInfoGetReturnAttribute BaseInfo
info Text
name = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
result <- Ptr BaseInfo -> CString -> IO CString
g_callable_info_get_return_attribute Ptr BaseInfo
info' CString
name'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"callableInfoGetReturnAttribute" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'


-- function callable_info_get_n_args
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GICallableInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_callable_info_get_n_args" g_callable_info_get_n_args :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the number of arguments (both IN and OUT) for this callable.
callableInfoGetNArgs ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GICallableInfo/@
    -> m Int32
    -- ^ __Returns:__ The number of arguments this callable expects.
callableInfoGetNArgs :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
callableInfoGetNArgs BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_callable_info_get_n_args Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function callable_info_get_instance_ownership_transfer
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GICallableInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "Transfer" })
-- throws : False
-- Skip return : False

foreign import ccall "g_callable_info_get_instance_ownership_transfer" g_callable_info_get_instance_ownership_transfer :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CUInt

-- | Obtains the ownership transfer for the instance argument.
-- t'GI.GIRepository.Enums.Transfer' contains a list of possible transfer values.
-- 
-- /Since: 1.42/
callableInfoGetInstanceOwnershipTransfer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GICallableInfo/@
    -> m GIRepository.Enums.Transfer
    -- ^ __Returns:__ the transfer mode of the instance argument
callableInfoGetInstanceOwnershipTransfer :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Transfer
callableInfoGetInstanceOwnershipTransfer BaseInfo
info = IO Transfer -> m Transfer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Transfer -> m Transfer) -> IO Transfer -> m Transfer
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CUInt
result <- Ptr BaseInfo -> IO CUInt
g_callable_info_get_instance_ownership_transfer Ptr BaseInfo
info'
    let result' :: Transfer
result' = (Int -> Transfer
forall a. Enum a => Int -> a
toEnum (Int -> Transfer) -> (CUInt -> Int) -> CUInt -> Transfer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Transfer -> IO Transfer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Transfer
result'


-- function callable_info_get_caller_owns
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GICallableInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "Transfer" })
-- throws : False
-- Skip return : False

foreign import ccall "g_callable_info_get_caller_owns" g_callable_info_get_caller_owns :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CUInt

-- | See whether the caller owns the return value of this callable.
-- t'GI.GIRepository.Enums.Transfer' contains a list of possible transfer values.
callableInfoGetCallerOwns ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GICallableInfo/@
    -> m GIRepository.Enums.Transfer
    -- ^ __Returns:__ the transfer mode for the return value of the callable
callableInfoGetCallerOwns :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Transfer
callableInfoGetCallerOwns BaseInfo
info = IO Transfer -> m Transfer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Transfer -> m Transfer) -> IO Transfer -> m Transfer
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CUInt
result <- Ptr BaseInfo -> IO CUInt
g_callable_info_get_caller_owns Ptr BaseInfo
info'
    let result' :: Transfer
result' = (Int -> Transfer
forall a. Enum a => Int -> a
toEnum (Int -> Transfer) -> (CUInt -> Int) -> CUInt -> Transfer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Transfer -> IO Transfer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Transfer
result'


-- function callable_info_get_arg
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GICallableInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the argument index to fetch"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_callable_info_get_arg" g_callable_info_get_arg :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Int32 ->                                -- n : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain information about a particular argument of this callable.
callableInfoGetArg ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GICallableInfo/@
    -> Int32
    -- ^ /@n@/: the argument index to fetch
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GIArgInfo/@. Free it with
    -- @/g_base_info_unref()/@ when done.
callableInfoGetArg :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Int32 -> m BaseInfo
callableInfoGetArg BaseInfo
info Int32
n = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> Int32 -> IO (Ptr BaseInfo)
g_callable_info_get_arg Ptr BaseInfo
info' Int32
n
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"callableInfoGetArg" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function callable_info_can_throw_gerror
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GICallableInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_callable_info_can_throw_gerror" g_callable_info_can_throw_gerror :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | TODO
-- 
-- /Since: 1.34/
callableInfoCanThrowGerror ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GICallableInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this @/GICallableInfo/@ can throw a t'GError'
callableInfoCanThrowGerror :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
callableInfoCanThrowGerror BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_callable_info_can_throw_gerror Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function arg_info_may_be_null
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIArgInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_arg_info_may_be_null" g_arg_info_may_be_null :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Obtain if the type of the argument includes the possibility of 'P.Nothing'.
-- For \'in\' values this means that 'P.Nothing' is a valid value.  For \'out\'
-- values, this means that 'P.Nothing' may be returned.
-- 
-- See also 'GI.GIRepository.Functions.argInfoIsOptional'.
argInfoMayBeNull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIArgInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the value may be 'P.Nothing'
argInfoMayBeNull :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
argInfoMayBeNull BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_arg_info_may_be_null Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function arg_info_load_type
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIArgInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Initialized with information about type of @info"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_arg_info_load_type" g_arg_info_load_type :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- type : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO ()

-- | Obtain information about a the type of given argument /@info@/; this
-- function is a variant of 'GI.GIRepository.Functions.argInfoGetType' designed for stack
-- allocation.
-- 
-- The initialized /@type@/ must not be referenced after /@info@/ is deallocated.
argInfoLoadType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIArgInfo/@
    -> m (GIRepository.BaseInfo.BaseInfo)
argInfoLoadType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
argInfoLoadType BaseInfo
info = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
type_ <- Int -> IO (Ptr BaseInfo)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
72 :: IO (Ptr GIRepository.BaseInfo.BaseInfo)
    Ptr BaseInfo -> Ptr BaseInfo -> IO ()
g_arg_info_load_type Ptr BaseInfo
info' Ptr BaseInfo
type_
    BaseInfo
type_' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
type_
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
type_'


-- function arg_info_is_skip
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIArgInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_arg_info_is_skip" g_arg_info_is_skip :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Obtain if an argument is only useful in C.
-- 
-- /Since: 1.30/
argInfoIsSkip ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIArgInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if argument is only useful in C.
argInfoIsSkip :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
argInfoIsSkip BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_arg_info_is_skip Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function arg_info_is_return_value
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIArgInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_arg_info_is_return_value" g_arg_info_is_return_value :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Obtain if the argument is a return value. It can either be a
-- parameter or a return value.
argInfoIsReturnValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIArgInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if it is a return value
argInfoIsReturnValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
argInfoIsReturnValue BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_arg_info_is_return_value Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function arg_info_is_optional
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIArgInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_arg_info_is_optional" g_arg_info_is_optional :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Obtain if the argument is optional.  For \'out\' arguments this means
-- that you can pass 'P.Nothing' in order to ignore the result.
argInfoIsOptional ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIArgInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if it is an optional argument
argInfoIsOptional :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
argInfoIsOptional BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_arg_info_is_optional Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function arg_info_is_caller_allocates
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIArgInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_arg_info_is_caller_allocates" g_arg_info_is_caller_allocates :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Obtain if the argument is a pointer to a struct or object that will
-- receive an output of a function.  The default assumption for
-- 'GI.GIRepository.Enums.DirectionOut' arguments which have allocation is that the
-- callee allocates; if this is 'P.True', then the caller must allocate.
argInfoIsCallerAllocates ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIArgInfo/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if caller is required to have allocated the argument
argInfoIsCallerAllocates :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
argInfoIsCallerAllocates BaseInfo
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CInt
result <- Ptr BaseInfo -> IO CInt
g_arg_info_is_caller_allocates Ptr BaseInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'


-- function arg_info_get_type
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIArgInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "BaseInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_arg_info_get_type" g_arg_info_get_type :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Obtain the type information for /@info@/.
argInfoGetType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIArgInfo/@
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ the @/GITypeInfo/@ holding the type
    --   information for /@info@/, free it with @/g_base_info_unref()/@
    --   when done.
argInfoGetType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
argInfoGetType BaseInfo
info = IO BaseInfo -> m BaseInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BaseInfo -> m BaseInfo) -> IO BaseInfo -> m BaseInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Ptr BaseInfo
result <- Ptr BaseInfo -> IO (Ptr BaseInfo)
g_arg_info_get_type Ptr BaseInfo
info'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"argInfoGetType" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'


-- function arg_info_get_scope
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIArgInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "ScopeType" })
-- throws : False
-- Skip return : False

foreign import ccall "g_arg_info_get_scope" g_arg_info_get_scope :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CUInt

-- | Obtain the scope type for this argument. The scope type explains
-- how a callback is going to be invoked, most importantly when
-- the resources required to invoke it can be freed.
-- t'GI.GIRepository.Enums.ScopeType' contains a list of possible values.
argInfoGetScope ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIArgInfo/@
    -> m GIRepository.Enums.ScopeType
    -- ^ __Returns:__ the scope type
argInfoGetScope :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m ScopeType
argInfoGetScope BaseInfo
info = IO ScopeType -> m ScopeType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ScopeType -> m ScopeType) -> IO ScopeType -> m ScopeType
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CUInt
result <- Ptr BaseInfo -> IO CUInt
g_arg_info_get_scope Ptr BaseInfo
info'
    let result' :: ScopeType
result' = (Int -> ScopeType
forall a. Enum a => Int -> a
toEnum (Int -> ScopeType) -> (CUInt -> Int) -> CUInt -> ScopeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    ScopeType -> IO ScopeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ScopeType
result'


-- function arg_info_get_ownership_transfer
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIArgInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "Transfer" })
-- throws : False
-- Skip return : False

foreign import ccall "g_arg_info_get_ownership_transfer" g_arg_info_get_ownership_transfer :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CUInt

-- | Obtain the ownership transfer for this argument.
-- t'GI.GIRepository.Enums.Transfer' contains a list of possible values.
argInfoGetOwnershipTransfer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIArgInfo/@
    -> m GIRepository.Enums.Transfer
    -- ^ __Returns:__ the transfer
argInfoGetOwnershipTransfer :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Transfer
argInfoGetOwnershipTransfer BaseInfo
info = IO Transfer -> m Transfer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Transfer -> m Transfer) -> IO Transfer -> m Transfer
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CUInt
result <- Ptr BaseInfo -> IO CUInt
g_arg_info_get_ownership_transfer Ptr BaseInfo
info'
    let result' :: Transfer
result' = (Int -> Transfer
forall a. Enum a => Int -> a
toEnum (Int -> Transfer) -> (CUInt -> Int) -> CUInt -> Transfer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Transfer -> IO Transfer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Transfer
result'


-- function arg_info_get_direction
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIArgInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "Direction" })
-- throws : False
-- Skip return : False

foreign import ccall "g_arg_info_get_direction" g_arg_info_get_direction :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CUInt

-- | Obtain the direction of the argument. Check t'GI.GIRepository.Enums.Direction' for possible
-- direction values.
argInfoGetDirection ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIArgInfo/@
    -> m GIRepository.Enums.Direction
    -- ^ __Returns:__ the direction
argInfoGetDirection :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Direction
argInfoGetDirection BaseInfo
info = IO Direction -> m Direction
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Direction -> m Direction) -> IO Direction -> m Direction
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    CUInt
result <- Ptr BaseInfo -> IO CUInt
g_arg_info_get_direction Ptr BaseInfo
info'
    let result' :: Direction
result' = (Int -> Direction
forall a. Enum a => Int -> a
toEnum (Int -> Direction) -> (CUInt -> Int) -> CUInt -> Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Direction -> IO Direction
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Direction
result'


-- function arg_info_get_destroy
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIArgInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_arg_info_get_destroy" g_arg_info_get_destroy :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtains the index of the t'GI.GLib.Callbacks.DestroyNotify' argument. This is only valid
-- for arguments which are callbacks.
argInfoGetDestroy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIArgInfo/@
    -> m Int32
    -- ^ __Returns:__ index of the t'GI.GLib.Callbacks.DestroyNotify' argument or -1 if there is none
argInfoGetDestroy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
argInfoGetDestroy BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_arg_info_get_destroy Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- function arg_info_get_closure
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIArgInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_arg_info_get_closure" g_arg_info_get_closure :: 
    Ptr GIRepository.BaseInfo.BaseInfo ->   -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO Int32

-- | Obtain the index of the user data argument. This is only valid
-- for arguments which are callbacks.
argInfoGetClosure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GIRepository.BaseInfo.BaseInfo
    -- ^ /@info@/: a @/GIArgInfo/@
    -> m Int32
    -- ^ __Returns:__ index of the user data argument or -1 if there is none
argInfoGetClosure :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Int32
argInfoGetClosure BaseInfo
info = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ do
    Ptr BaseInfo
info' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info
    Int32
result <- Ptr BaseInfo -> IO Int32
g_arg_info_get_closure Ptr BaseInfo
info'
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result