{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- GIBaseInfo is the common base struct of all other *Info structs
-- accessible through the t'GI.GIRepository.Objects.Repository.Repository' API.
-- All other structs can be casted to a t'GI.GIRepository.Structs.BaseInfo.BaseInfo', for instance:
-- \<example>
-- \<title>Casting a @/GIFunctionInfo/@ to t'GI.GIRepository.Structs.BaseInfo.BaseInfo'\<\/title>
-- \<programlisting>
--    GIFunctionInfo *function_info = ...;
--    GIBaseInfo *info = (GIBaseInfo*)function_info;
-- \<\/programlisting>
-- \<\/example>
-- Most t'GI.GIRepository.Objects.Repository.Repository' APIs returning a t'GI.GIRepository.Structs.BaseInfo.BaseInfo' is actually creating a new struct, in other
-- words, @/g_base_info_unref()/@ has to be called when done accessing the data.
-- GIBaseInfos are normally accessed by calling either
-- 'GI.GIRepository.Objects.Repository.repositoryFindByName', 'GI.GIRepository.Objects.Repository.repositoryFindByGtype' or 'GI.GIRepository.Objects.Repository.repositoryGetInfo'.
-- 
-- \<example>
-- \<title>Getting the Button of the Gtk typelib\<\/title>
-- \<programlisting>
--    GIBaseInfo *button_info = g_irepository_find_by_name(NULL, \"Gtk\", \"Button\");
--    ... use button_info ...
--    g_base_info_unref(button_info);
-- \<\/programlisting>
-- \<\/example>
-- 
-- \<refsect1 id=\"gi-gibaseinfo.struct-hierarchy\" role=\"struct_hierarchy\">
-- \<title role=\"struct_hierarchy.title\">Struct hierarchy\<\/title>
-- \<synopsis>
--   GIBaseInfo
--    +----\<link linkend=\"gi-GIArgInfo\">GIArgInfo\<\/link>
--    +----\<link linkend=\"gi-GICallableInfo\">GICallableInfo\<\/link>
--    +----\<link linkend=\"gi-GIConstantInfo\">GIConstantInfo\<\/link>
--    +----\<link linkend=\"gi-GIFieldInfo\">GIFieldInfo\<\/link>
--    +----\<link linkend=\"gi-GIPropertyInfo\">GIPropertyInfo\<\/link>
--    +----\<link linkend=\"gi-GIRegisteredTypeInfo\">GIRegisteredTypeInfo\<\/link>
--    +----\<link linkend=\"gi-GITypeInfo\">GITypeInfo\<\/link>
-- \<\/synopsis>
-- \<\/refsect1>

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

module GI.GIRepository.Structs.BaseInfo
    ( 

-- * Exported types
    BaseInfo(..)                            ,
    newZeroBaseInfo                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [equal]("GI.GIRepository.Structs.BaseInfo#g:method:equal"), [isDeprecated]("GI.GIRepository.Structs.BaseInfo#g:method:isDeprecated"), [iterateAttributes]("GI.GIRepository.Structs.BaseInfo#g:method:iterateAttributes").
-- 
-- ==== Getters
-- [getAttribute]("GI.GIRepository.Structs.BaseInfo#g:method:getAttribute"), [getContainer]("GI.GIRepository.Structs.BaseInfo#g:method:getContainer"), [getName]("GI.GIRepository.Structs.BaseInfo#g:method:getName"), [getNamespace]("GI.GIRepository.Structs.BaseInfo#g:method:getNamespace"), [getType]("GI.GIRepository.Structs.BaseInfo#g:method:getType"), [getTypelib]("GI.GIRepository.Structs.BaseInfo#g:method:getTypelib").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveBaseInfoMethod                   ,
#endif

-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    BaseInfoEqualMethodInfo                 ,
#endif
    baseInfoEqual                           ,


-- ** getAttribute #method:getAttribute#

#if defined(ENABLE_OVERLOADING)
    BaseInfoGetAttributeMethodInfo          ,
#endif
    baseInfoGetAttribute                    ,


-- ** getContainer #method:getContainer#

#if defined(ENABLE_OVERLOADING)
    BaseInfoGetContainerMethodInfo          ,
#endif
    baseInfoGetContainer                    ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    BaseInfoGetNameMethodInfo               ,
#endif
    baseInfoGetName                         ,


-- ** getNamespace #method:getNamespace#

#if defined(ENABLE_OVERLOADING)
    BaseInfoGetNamespaceMethodInfo          ,
#endif
    baseInfoGetNamespace                    ,


-- ** getType #method:getType#

#if defined(ENABLE_OVERLOADING)
    BaseInfoGetTypeMethodInfo               ,
#endif
    baseInfoGetType                         ,


-- ** getTypelib #method:getTypelib#

#if defined(ENABLE_OVERLOADING)
    BaseInfoGetTypelibMethodInfo            ,
#endif
    baseInfoGetTypelib                      ,


-- ** isDeprecated #method:isDeprecated#

#if defined(ENABLE_OVERLOADING)
    BaseInfoIsDeprecatedMethodInfo          ,
#endif
    baseInfoIsDeprecated                    ,


-- ** iterateAttributes #method:iterateAttributes#

#if defined(ENABLE_OVERLOADING)
    BaseInfoIterateAttributesMethodInfo     ,
#endif
    baseInfoIterateAttributes               ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.GIRepository.Enums as GIRepository.Enums
import {-# SOURCE #-} qualified GI.GIRepository.Structs.AttributeIter as GIRepository.AttributeIter
import {-# SOURCE #-} qualified GI.GIRepository.Structs.Typelib as GIRepository.Typelib

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

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

foreign import ccall "g_base_info_gtype_get_type" c_g_base_info_gtype_get_type :: 
    IO GType

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

instance B.Types.TypedObject BaseInfo where
    glibType :: IO GType
glibType = IO GType
c_g_base_info_gtype_get_type

instance B.Types.GBoxed BaseInfo

-- | Convert 'BaseInfo' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe BaseInfo) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_g_base_info_gtype_get_type
    gvalueSet_ :: Ptr GValue -> Maybe BaseInfo -> IO ()
gvalueSet_ Ptr GValue
gv Maybe BaseInfo
P.Nothing = Ptr GValue -> Ptr BaseInfo -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr BaseInfo
forall a. Ptr a
FP.nullPtr :: FP.Ptr BaseInfo)
    gvalueSet_ Ptr GValue
gv (P.Just BaseInfo
obj) = BaseInfo -> (Ptr BaseInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr BaseInfo
obj (Ptr GValue -> Ptr BaseInfo -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe BaseInfo)
gvalueGet_ Ptr GValue
gv = do
        Ptr BaseInfo
ptr <- Ptr GValue -> IO (Ptr BaseInfo)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr BaseInfo)
        if Ptr BaseInfo
ptr Ptr BaseInfo -> Ptr BaseInfo -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr BaseInfo
forall a. Ptr a
FP.nullPtr
        then BaseInfo -> Maybe BaseInfo
forall a. a -> Maybe a
P.Just (BaseInfo -> Maybe BaseInfo) -> IO BaseInfo -> IO (Maybe BaseInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr BaseInfo -> BaseInfo
BaseInfo Ptr BaseInfo
ptr
        else Maybe BaseInfo -> IO (Maybe BaseInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BaseInfo
forall a. Maybe a
P.Nothing
        
    

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

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



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BaseInfo
type instance O.AttributeList BaseInfo = BaseInfoAttributeList
type BaseInfoAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method BaseInfo::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info1"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIBaseInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info2"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIBaseInfo" , 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_base_info_equal" g_base_info_equal :: 
    Ptr BaseInfo ->                         -- info1 : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    Ptr BaseInfo ->                         -- info2 : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Compare two t'GI.GIRepository.Structs.BaseInfo.BaseInfo'.
-- 
-- Using pointer comparison is not practical since many functions return
-- different instances of t'GI.GIRepository.Structs.BaseInfo.BaseInfo' that refers to the same part of the
-- TypeLib; use this function instead to do t'GI.GIRepository.Structs.BaseInfo.BaseInfo' comparisons.
baseInfoEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BaseInfo
    -- ^ /@info1@/: a t'GI.GIRepository.Structs.BaseInfo.BaseInfo'
    -> BaseInfo
    -- ^ /@info2@/: a t'GI.GIRepository.Structs.BaseInfo.BaseInfo'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if and only if /@info1@/ equals /@info2@/.
baseInfoEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> BaseInfo -> m Bool
baseInfoEqual BaseInfo
info1 BaseInfo
info2 = IO Bool -> m Bool
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
info1' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info1
    Ptr BaseInfo
info2' <- BaseInfo -> IO (Ptr BaseInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseInfo
info2
    CInt
result <- Ptr BaseInfo -> Ptr BaseInfo -> IO CInt
g_base_info_equal Ptr BaseInfo
info1' Ptr BaseInfo
info2'
    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
info1
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BaseInfoEqualMethodInfo
instance (signature ~ (BaseInfo -> m Bool), MonadIO m) => O.OverloadedMethod BaseInfoEqualMethodInfo BaseInfo signature where
    overloadedMethod = baseInfoEqual

instance O.OverloadedMethodInfo BaseInfoEqualMethodInfo BaseInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GIRepository.Structs.BaseInfo.baseInfoEqual",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-girepository-1.0.25/docs/GI-GIRepository-Structs-BaseInfo.html#v:baseInfoEqual"
        })


#endif

-- method BaseInfo::get_attribute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIBaseInfo" , 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_base_info_get_attribute" g_base_info_get_attribute :: 
    Ptr BaseInfo ->                         -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    CString ->                              -- name : TBasicType TUTF8
    IO CString

-- | Retrieve an arbitrary attribute associated with this node.
baseInfoGetAttribute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BaseInfo
    -- ^ /@info@/: a t'GI.GIRepository.Structs.BaseInfo.BaseInfo'
    -> 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
baseInfoGetAttribute :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> Text -> m Text
baseInfoGetAttribute BaseInfo
info Text
name = IO Text -> m Text
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_base_info_get_attribute Ptr BaseInfo
info' CString
name'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"baseInfoGetAttribute" 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 (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data BaseInfoGetAttributeMethodInfo
instance (signature ~ (T.Text -> m T.Text), MonadIO m) => O.OverloadedMethod BaseInfoGetAttributeMethodInfo BaseInfo signature where
    overloadedMethod = baseInfoGetAttribute

instance O.OverloadedMethodInfo BaseInfoGetAttributeMethodInfo BaseInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GIRepository.Structs.BaseInfo.baseInfoGetAttribute",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-girepository-1.0.25/docs/GI-GIRepository-Structs-BaseInfo.html#v:baseInfoGetAttribute"
        })


#endif

-- method BaseInfo::get_container
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIBaseInfo" , 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_base_info_get_container" g_base_info_get_container :: 
    Ptr BaseInfo ->                         -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO (Ptr BaseInfo)

-- | Obtain the container of the /@info@/. The container is the parent
-- GIBaseInfo. For instance, the parent of a @/GIFunctionInfo/@ is an
-- @/GIObjectInfo/@ or @/GIInterfaceInfo/@.
baseInfoGetContainer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BaseInfo
    -- ^ /@info@/: a t'GI.GIRepository.Structs.BaseInfo.BaseInfo'
    -> m BaseInfo
    -- ^ __Returns:__ the container
baseInfoGetContainer :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m BaseInfo
baseInfoGetContainer BaseInfo
info = IO BaseInfo -> m BaseInfo
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_base_info_get_container Ptr BaseInfo
info'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"baseInfoGetContainer" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr BaseInfo -> BaseInfo
BaseInfo) Ptr BaseInfo
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    BaseInfo -> IO BaseInfo
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'

#if defined(ENABLE_OVERLOADING)
data BaseInfoGetContainerMethodInfo
instance (signature ~ (m BaseInfo), MonadIO m) => O.OverloadedMethod BaseInfoGetContainerMethodInfo BaseInfo signature where
    overloadedMethod = baseInfoGetContainer

instance O.OverloadedMethodInfo BaseInfoGetContainerMethodInfo BaseInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GIRepository.Structs.BaseInfo.baseInfoGetContainer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-girepository-1.0.25/docs/GI-GIRepository-Structs-BaseInfo.html#v:baseInfoGetContainer"
        })


#endif

-- method BaseInfo::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIBaseInfo" , 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_base_info_get_name" g_base_info_get_name :: 
    Ptr BaseInfo ->                         -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CString

-- | Obtain the name of the /@info@/. What the name represents depends on
-- the t'GI.GIRepository.Enums.InfoType' of the /@info@/. For instance for @/GIFunctionInfo/@ it is
-- the name of the function.
baseInfoGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BaseInfo
    -- ^ /@info@/: a t'GI.GIRepository.Structs.BaseInfo.BaseInfo'
    -> m T.Text
    -- ^ __Returns:__ the name of /@info@/ or 'P.Nothing' if it lacks a name.
baseInfoGetName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Text
baseInfoGetName BaseInfo
info = IO Text -> m Text
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_base_info_get_name Ptr BaseInfo
info'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"baseInfoGetName" 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 (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data BaseInfoGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod BaseInfoGetNameMethodInfo BaseInfo signature where
    overloadedMethod = baseInfoGetName

instance O.OverloadedMethodInfo BaseInfoGetNameMethodInfo BaseInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GIRepository.Structs.BaseInfo.baseInfoGetName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-girepository-1.0.25/docs/GI-GIRepository-Structs-BaseInfo.html#v:baseInfoGetName"
        })


#endif

-- method BaseInfo::get_namespace
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIBaseInfo" , 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_base_info_get_namespace" g_base_info_get_namespace :: 
    Ptr BaseInfo ->                         -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CString

-- | Obtain the namespace of /@info@/.
baseInfoGetNamespace ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BaseInfo
    -- ^ /@info@/: a t'GI.GIRepository.Structs.BaseInfo.BaseInfo'
    -> m T.Text
    -- ^ __Returns:__ the namespace
baseInfoGetNamespace :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Text
baseInfoGetNamespace BaseInfo
info = IO Text -> m Text
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_base_info_get_namespace Ptr BaseInfo
info'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"baseInfoGetNamespace" 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 (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data BaseInfoGetNamespaceMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod BaseInfoGetNamespaceMethodInfo BaseInfo signature where
    overloadedMethod = baseInfoGetNamespace

instance O.OverloadedMethodInfo BaseInfoGetNamespaceMethodInfo BaseInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GIRepository.Structs.BaseInfo.baseInfoGetNamespace",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-girepository-1.0.25/docs/GI-GIRepository-Structs-BaseInfo.html#v:baseInfoGetNamespace"
        })


#endif

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

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

-- | Obtain the info type of the GIBaseInfo.
baseInfoGetType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BaseInfo
    -- ^ /@info@/: a t'GI.GIRepository.Structs.BaseInfo.BaseInfo'
    -> m GIRepository.Enums.InfoType
    -- ^ __Returns:__ the info type of /@info@/
baseInfoGetType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m InfoType
baseInfoGetType BaseInfo
info = IO InfoType -> m InfoType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InfoType -> m InfoType) -> IO InfoType -> m InfoType
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_base_info_get_type Ptr BaseInfo
info'
    let result' :: InfoType
result' = (Int -> InfoType
forall a. Enum a => Int -> a
toEnum (Int -> InfoType) -> (CUInt -> Int) -> CUInt -> InfoType
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
    InfoType -> IO InfoType
forall (m :: * -> *) a. Monad m => a -> m a
return InfoType
result'

#if defined(ENABLE_OVERLOADING)
data BaseInfoGetTypeMethodInfo
instance (signature ~ (m GIRepository.Enums.InfoType), MonadIO m) => O.OverloadedMethod BaseInfoGetTypeMethodInfo BaseInfo signature where
    overloadedMethod = baseInfoGetType

instance O.OverloadedMethodInfo BaseInfoGetTypeMethodInfo BaseInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GIRepository.Structs.BaseInfo.baseInfoGetType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-girepository-1.0.25/docs/GI-GIRepository-Structs-BaseInfo.html#v:baseInfoGetType"
        })


#endif

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

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

-- | Obtain the typelib this /@info@/ belongs to
baseInfoGetTypelib ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BaseInfo
    -- ^ /@info@/: a t'GI.GIRepository.Structs.BaseInfo.BaseInfo'
    -> m GIRepository.Typelib.Typelib
    -- ^ __Returns:__ the typelib.
baseInfoGetTypelib :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Typelib
baseInfoGetTypelib BaseInfo
info = IO Typelib -> m Typelib
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Typelib -> m Typelib) -> IO Typelib -> m Typelib
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 Typelib
result <- Ptr BaseInfo -> IO (Ptr Typelib)
g_base_info_get_typelib Ptr BaseInfo
info'
    Text -> Ptr Typelib -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"baseInfoGetTypelib" Ptr Typelib
result
    Typelib
result' <- ((ManagedPtr Typelib -> Typelib) -> Ptr Typelib -> IO Typelib
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Typelib -> Typelib
GIRepository.Typelib.Typelib) Ptr Typelib
result
    BaseInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseInfo
info
    Typelib -> IO Typelib
forall (m :: * -> *) a. Monad m => a -> m a
return Typelib
result'

#if defined(ENABLE_OVERLOADING)
data BaseInfoGetTypelibMethodInfo
instance (signature ~ (m GIRepository.Typelib.Typelib), MonadIO m) => O.OverloadedMethod BaseInfoGetTypelibMethodInfo BaseInfo signature where
    overloadedMethod = baseInfoGetTypelib

instance O.OverloadedMethodInfo BaseInfoGetTypelibMethodInfo BaseInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GIRepository.Structs.BaseInfo.baseInfoGetTypelib",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-girepository-1.0.25/docs/GI-GIRepository-Structs-BaseInfo.html#v:baseInfoGetTypelib"
        })


#endif

-- method BaseInfo::is_deprecated
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIBaseInfo" , 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_base_info_is_deprecated" g_base_info_is_deprecated :: 
    Ptr BaseInfo ->                         -- info : TInterface (Name {namespace = "GIRepository", name = "BaseInfo"})
    IO CInt

-- | Obtain whether the /@info@/ is represents a metadata which is
-- deprecated or not.
baseInfoIsDeprecated ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BaseInfo
    -- ^ /@info@/: a t'GI.GIRepository.Structs.BaseInfo.BaseInfo'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if deprecated
baseInfoIsDeprecated :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> m Bool
baseInfoIsDeprecated BaseInfo
info = IO Bool -> m Bool
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_base_info_is_deprecated 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 (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BaseInfoIsDeprecatedMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod BaseInfoIsDeprecatedMethodInfo BaseInfo signature where
    overloadedMethod = baseInfoIsDeprecated

instance O.OverloadedMethodInfo BaseInfoIsDeprecatedMethodInfo BaseInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GIRepository.Structs.BaseInfo.baseInfoIsDeprecated",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-girepository-1.0.25/docs/GI-GIRepository-Structs-BaseInfo.html#v:baseInfoIsDeprecated"
        })


#endif

-- method BaseInfo::iterate_attributes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GIRepository" , name = "BaseInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GIBaseInfo" , 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_base_info_iterate_attributes" g_base_info_iterate_attributes :: 
    Ptr 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 this node.  The iterator
-- structure is typically stack allocated, and must have its first
-- member initialized to 'P.Nothing'.  Attributes are arbitrary namespaced key–value
-- pairs which can be attached to almost any item.  They are intended for use
-- by software higher in the toolchain than bindings, and are distinct from
-- normal GIR annotations.
-- 
-- Both the /@name@/ and /@value@/ should be treated as constants
-- and must not be freed.
-- 
-- \<example>
-- \<title>Iterating over attributes\<\/title>
-- \<programlisting>
-- void
-- print_attributes (GIBaseInfo *info)
-- {
--   GIAttributeIter iter = { 0, };
--   char *name;
--   char *value;
--   while (g_base_info_iterate_attributes (info, &iter, &name, &value))
--     {
--       g_print (\"attribute name: @/s/@ value: @/s/@\", name, value);
--     }
-- }
-- \<\/programlisting>
-- \<\/example>
baseInfoIterateAttributes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BaseInfo
    -- ^ /@info@/: a t'GI.GIRepository.Structs.BaseInfo.BaseInfo'
    -> 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
baseInfoIterateAttributes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BaseInfo -> AttributeIter -> m (Bool, Text, Text)
baseInfoIterateAttributes BaseInfo
info AttributeIter
iterator = IO (Bool, Text, Text) -> m (Bool, Text, Text)
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_base_info_iterate_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 (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Text
name'', Text
value'')

#if defined(ENABLE_OVERLOADING)
data BaseInfoIterateAttributesMethodInfo
instance (signature ~ (GIRepository.AttributeIter.AttributeIter -> m ((Bool, T.Text, T.Text))), MonadIO m) => O.OverloadedMethod BaseInfoIterateAttributesMethodInfo BaseInfo signature where
    overloadedMethod = baseInfoIterateAttributes

instance O.OverloadedMethodInfo BaseInfoIterateAttributesMethodInfo BaseInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GIRepository.Structs.BaseInfo.baseInfoIterateAttributes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-girepository-1.0.25/docs/GI-GIRepository-Structs-BaseInfo.html#v:baseInfoIterateAttributes"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveBaseInfoMethod (t :: Symbol) (o :: *) :: * where
    ResolveBaseInfoMethod "equal" o = BaseInfoEqualMethodInfo
    ResolveBaseInfoMethod "isDeprecated" o = BaseInfoIsDeprecatedMethodInfo
    ResolveBaseInfoMethod "iterateAttributes" o = BaseInfoIterateAttributesMethodInfo
    ResolveBaseInfoMethod "getAttribute" o = BaseInfoGetAttributeMethodInfo
    ResolveBaseInfoMethod "getContainer" o = BaseInfoGetContainerMethodInfo
    ResolveBaseInfoMethod "getName" o = BaseInfoGetNameMethodInfo
    ResolveBaseInfoMethod "getNamespace" o = BaseInfoGetNamespaceMethodInfo
    ResolveBaseInfoMethod "getType" o = BaseInfoGetTypeMethodInfo
    ResolveBaseInfoMethod "getTypelib" o = BaseInfoGetTypelibMethodInfo
    ResolveBaseInfoMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveBaseInfoMethod t BaseInfo, O.OverloadedMethod info BaseInfo p, R.HasField t BaseInfo p) => R.HasField t BaseInfo p where
    getField = O.overloadedMethod @info

#endif

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

#endif