{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.GIRepository.Objects.Repository.Repository' is used to manage repositories of namespaces. Namespaces
-- are represented on disk by type libraries (.typelib files).
-- 
-- === Discovery of type libraries
-- 
-- t'GI.GIRepository.Objects.Repository.Repository' will typically look for a @girepository-1.0@ directory
-- under the library directory used when compiling gobject-introspection.
-- 
-- It is possible to control the search paths programmatically, using
-- 'GI.GIRepository.Objects.Repository.repositoryPrependSearchPath'. It is also possible to modify
-- the search paths by using the @GI_TYPELIB_PATH@ environment variable.
-- The environment variable takes precedence over the default search path
-- and the 'GI.GIRepository.Objects.Repository.repositoryPrependSearchPath' calls.

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

module GI.GIRepository.Objects.Repository
    ( 

-- * Exported types
    Repository(..)                          ,
    IsRepository                            ,
    toRepository                            ,
    noRepository                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveRepositoryMethod                 ,
#endif


-- ** dump #method:dump#

    repositoryDump                          ,


-- ** enumerateVersions #method:enumerateVersions#

#if defined(ENABLE_OVERLOADING)
    RepositoryEnumerateVersionsMethodInfo   ,
#endif
    repositoryEnumerateVersions             ,


-- ** errorQuark #method:errorQuark#

    repositoryErrorQuark                    ,


-- ** findByErrorDomain #method:findByErrorDomain#

#if defined(ENABLE_OVERLOADING)
    RepositoryFindByErrorDomainMethodInfo   ,
#endif
    repositoryFindByErrorDomain             ,


-- ** findByGtype #method:findByGtype#

#if defined(ENABLE_OVERLOADING)
    RepositoryFindByGtypeMethodInfo         ,
#endif
    repositoryFindByGtype                   ,


-- ** findByName #method:findByName#

#if defined(ENABLE_OVERLOADING)
    RepositoryFindByNameMethodInfo          ,
#endif
    repositoryFindByName                    ,


-- ** getCPrefix #method:getCPrefix#

#if defined(ENABLE_OVERLOADING)
    RepositoryGetCPrefixMethodInfo          ,
#endif
    repositoryGetCPrefix                    ,


-- ** getDefault #method:getDefault#

    repositoryGetDefault                    ,


-- ** getDependencies #method:getDependencies#

#if defined(ENABLE_OVERLOADING)
    RepositoryGetDependenciesMethodInfo     ,
#endif
    repositoryGetDependencies               ,


-- ** getImmediateDependencies #method:getImmediateDependencies#

#if defined(ENABLE_OVERLOADING)
    RepositoryGetImmediateDependenciesMethodInfo,
#endif
    repositoryGetImmediateDependencies      ,


-- ** getInfo #method:getInfo#

#if defined(ENABLE_OVERLOADING)
    RepositoryGetInfoMethodInfo             ,
#endif
    repositoryGetInfo                       ,


-- ** getLoadedNamespaces #method:getLoadedNamespaces#

#if defined(ENABLE_OVERLOADING)
    RepositoryGetLoadedNamespacesMethodInfo ,
#endif
    repositoryGetLoadedNamespaces           ,


-- ** getNInfos #method:getNInfos#

#if defined(ENABLE_OVERLOADING)
    RepositoryGetNInfosMethodInfo           ,
#endif
    repositoryGetNInfos                     ,


-- ** getObjectGtypeInterfaces #method:getObjectGtypeInterfaces#

#if defined(ENABLE_OVERLOADING)
    RepositoryGetObjectGtypeInterfacesMethodInfo,
#endif
    repositoryGetObjectGtypeInterfaces      ,


-- ** getOptionGroup #method:getOptionGroup#

    repositoryGetOptionGroup                ,


-- ** getSearchPath #method:getSearchPath#

    repositoryGetSearchPath                 ,


-- ** getSharedLibrary #method:getSharedLibrary#

#if defined(ENABLE_OVERLOADING)
    RepositoryGetSharedLibraryMethodInfo    ,
#endif
    repositoryGetSharedLibrary              ,


-- ** getTypelibPath #method:getTypelibPath#

#if defined(ENABLE_OVERLOADING)
    RepositoryGetTypelibPathMethodInfo      ,
#endif
    repositoryGetTypelibPath                ,


-- ** getVersion #method:getVersion#

#if defined(ENABLE_OVERLOADING)
    RepositoryGetVersionMethodInfo          ,
#endif
    repositoryGetVersion                    ,


-- ** isRegistered #method:isRegistered#

#if defined(ENABLE_OVERLOADING)
    RepositoryIsRegisteredMethodInfo        ,
#endif
    repositoryIsRegistered                  ,


-- ** loadTypelib #method:loadTypelib#

#if defined(ENABLE_OVERLOADING)
    RepositoryLoadTypelibMethodInfo         ,
#endif
    repositoryLoadTypelib                   ,


-- ** prependLibraryPath #method:prependLibraryPath#

    repositoryPrependLibraryPath            ,


-- ** prependSearchPath #method:prependSearchPath#

    repositoryPrependSearchPath             ,


-- ** require #method:require#

#if defined(ENABLE_OVERLOADING)
    RepositoryRequireMethodInfo             ,
#endif
    repositoryRequire                       ,


-- ** requirePrivate #method:requirePrivate#

#if defined(ENABLE_OVERLOADING)
    RepositoryRequirePrivateMethodInfo      ,
#endif
    repositoryRequirePrivate                ,




    ) 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import {-# SOURCE #-} qualified GI.GIRepository.Flags as GIRepository.Flags
import {-# SOURCE #-} qualified GI.GIRepository.Structs.BaseInfo as GIRepository.BaseInfo
import {-# SOURCE #-} qualified GI.GIRepository.Structs.Typelib as GIRepository.Typelib
import qualified GI.GLib.Structs.OptionGroup as GLib.OptionGroup
import qualified GI.GObject.Objects.Object as GObject.Object

-- | Memory-managed wrapper type.
newtype Repository = Repository (ManagedPtr Repository)
    deriving (Repository -> Repository -> Bool
(Repository -> Repository -> Bool)
-> (Repository -> Repository -> Bool) -> Eq Repository
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Repository -> Repository -> Bool
$c/= :: Repository -> Repository -> Bool
== :: Repository -> Repository -> Bool
$c== :: Repository -> Repository -> Bool
Eq)
foreign import ccall "g_irepository_get_type"
    c_g_irepository_get_type :: IO GType

instance GObject Repository where
    gobjectType :: IO GType
gobjectType = IO GType
c_g_irepository_get_type
    

-- | Convert 'Repository' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Repository where
    toGValue :: Repository -> IO GValue
toGValue o :: Repository
o = do
        GType
gtype <- IO GType
c_g_irepository_get_type
        Repository -> (Ptr Repository -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Repository
o (GType
-> (GValue -> Ptr Repository -> IO ())
-> Ptr Repository
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Repository -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Repository
fromGValue gv :: GValue
gv = do
        Ptr Repository
ptr <- GValue -> IO (Ptr Repository)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Repository)
        (ManagedPtr Repository -> Repository)
-> Ptr Repository -> IO Repository
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Repository -> Repository
Repository Ptr Repository
ptr
        
    

-- | Type class for types which can be safely cast to `Repository`, for instance with `toRepository`.
class (GObject o, O.IsDescendantOf Repository o) => IsRepository o
instance (GObject o, O.IsDescendantOf Repository o) => IsRepository o

instance O.HasParentTypes Repository
type instance O.ParentTypes Repository = '[GObject.Object.Object]

-- | Cast to `Repository`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toRepository :: (MonadIO m, IsRepository o) => o -> m Repository
toRepository :: o -> m Repository
toRepository = IO Repository -> m Repository
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Repository -> m Repository)
-> (o -> IO Repository) -> o -> m Repository
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Repository -> Repository) -> o -> IO Repository
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Repository -> Repository
Repository

-- | A convenience alias for `Nothing` :: `Maybe` `Repository`.
noRepository :: Maybe Repository
noRepository :: Maybe Repository
noRepository = Maybe Repository
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveRepositoryMethod (t :: Symbol) (o :: *) :: * where
    ResolveRepositoryMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveRepositoryMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveRepositoryMethod "enumerateVersions" o = RepositoryEnumerateVersionsMethodInfo
    ResolveRepositoryMethod "findByErrorDomain" o = RepositoryFindByErrorDomainMethodInfo
    ResolveRepositoryMethod "findByGtype" o = RepositoryFindByGtypeMethodInfo
    ResolveRepositoryMethod "findByName" o = RepositoryFindByNameMethodInfo
    ResolveRepositoryMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveRepositoryMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveRepositoryMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveRepositoryMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveRepositoryMethod "isRegistered" o = RepositoryIsRegisteredMethodInfo
    ResolveRepositoryMethod "loadTypelib" o = RepositoryLoadTypelibMethodInfo
    ResolveRepositoryMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveRepositoryMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveRepositoryMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveRepositoryMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveRepositoryMethod "require" o = RepositoryRequireMethodInfo
    ResolveRepositoryMethod "requirePrivate" o = RepositoryRequirePrivateMethodInfo
    ResolveRepositoryMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveRepositoryMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveRepositoryMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveRepositoryMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveRepositoryMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveRepositoryMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveRepositoryMethod "getCPrefix" o = RepositoryGetCPrefixMethodInfo
    ResolveRepositoryMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveRepositoryMethod "getDependencies" o = RepositoryGetDependenciesMethodInfo
    ResolveRepositoryMethod "getImmediateDependencies" o = RepositoryGetImmediateDependenciesMethodInfo
    ResolveRepositoryMethod "getInfo" o = RepositoryGetInfoMethodInfo
    ResolveRepositoryMethod "getLoadedNamespaces" o = RepositoryGetLoadedNamespacesMethodInfo
    ResolveRepositoryMethod "getNInfos" o = RepositoryGetNInfosMethodInfo
    ResolveRepositoryMethod "getObjectGtypeInterfaces" o = RepositoryGetObjectGtypeInterfacesMethodInfo
    ResolveRepositoryMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveRepositoryMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveRepositoryMethod "getSharedLibrary" o = RepositoryGetSharedLibraryMethodInfo
    ResolveRepositoryMethod "getTypelibPath" o = RepositoryGetTypelibPathMethodInfo
    ResolveRepositoryMethod "getVersion" o = RepositoryGetVersionMethodInfo
    ResolveRepositoryMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveRepositoryMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveRepositoryMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveRepositoryMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Repository = RepositorySignalList
type RepositorySignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Repository::enumerate_versions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "namespace_"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GI namespace, e.g. \"Gtk\""
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TGList (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "g_irepository_enumerate_versions" g_irepository_enumerate_versions :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    CString ->                              -- namespace_ : TBasicType TUTF8
    IO (Ptr (GList CString))

-- | Obtain an unordered list of versions (either currently loaded or
-- available) for /@namespace_@/ in this /@repository@/.
repositoryEnumerateVersions ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> T.Text
    -- ^ /@namespace_@/: GI namespace, e.g. \"Gtk\"
    -> m [T.Text]
    -- ^ __Returns:__ the array of versions.
repositoryEnumerateVersions :: a -> Text -> m [Text]
repositoryEnumerateVersions repository :: a
repository namespace_ :: Text
namespace_ = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    CString
namespace_' <- Text -> IO CString
textToCString Text
namespace_
    Ptr (GList CString)
result <- Ptr Repository -> CString -> IO (Ptr (GList CString))
g_irepository_enumerate_versions Ptr Repository
repository' CString
namespace_'
    [CString]
result' <- Ptr (GList CString) -> IO [CString]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList CString)
result
    [Text]
result'' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
result'
    (CString -> IO ()) -> Ptr (GList CString) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
mapGList CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (GList CString)
result
    Ptr (GList CString) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList CString)
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namespace_'
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''

#if defined(ENABLE_OVERLOADING)
data RepositoryEnumerateVersionsMethodInfo
instance (signature ~ (T.Text -> m [T.Text]), MonadIO m, IsRepository a) => O.MethodInfo RepositoryEnumerateVersionsMethodInfo a signature where
    overloadedMethod = repositoryEnumerateVersions

#endif

-- method Repository::find_by_error_domain
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "domain"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GError domain" , 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_irepository_find_by_error_domain" g_irepository_find_by_error_domain :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    Word32 ->                               -- domain : TBasicType TUInt32
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Searches for the enum type corresponding to the given t'GError'
-- domain. Before calling this function for a particular namespace,
-- you must call 'GI.GIRepository.Objects.Repository.repositoryRequire' once to load the namespace, or
-- otherwise ensure the namespace has already been loaded.
-- 
-- /Since: 1.30/
repositoryFindByErrorDomain ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> Word32
    -- ^ /@domain@/: a t'GError' domain
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ @/GIEnumInfo/@ representing metadata about /@domain@/\'s
    -- enum type, or 'P.Nothing'
repositoryFindByErrorDomain :: a -> Word32 -> m BaseInfo
repositoryFindByErrorDomain repository :: a
repository domain :: Word32
domain = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    Ptr BaseInfo
result <- Ptr Repository -> Word32 -> IO (Ptr BaseInfo)
g_irepository_find_by_error_domain Ptr Repository
repository' Word32
domain
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryFindByErrorDomain" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
    BaseInfo -> IO BaseInfo
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'

#if defined(ENABLE_OVERLOADING)
data RepositoryFindByErrorDomainMethodInfo
instance (signature ~ (Word32 -> m GIRepository.BaseInfo.BaseInfo), MonadIO m, IsRepository a) => O.MethodInfo RepositoryFindByErrorDomainMethodInfo a signature where
    overloadedMethod = repositoryFindByErrorDomain

#endif

-- method Repository::find_by_gtype
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "gtype"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GType to search for"
--                 , 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_irepository_find_by_gtype" g_irepository_find_by_gtype :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    CGType ->                               -- gtype : TBasicType TGType
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Searches all loaded namespaces for a particular t'GType'.  Note that
-- in order to locate the metadata, the namespace corresponding to
-- the type must first have been loaded.  There is currently no
-- mechanism for determining the namespace which corresponds to an
-- arbitrary GType - thus, this function will operate most reliably
-- when you know the GType to originate from be from a loaded namespace.
repositoryFindByGtype ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> GType
    -- ^ /@gtype@/: GType to search for
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ t'GI.GIRepository.Structs.BaseInfo.BaseInfo' representing metadata about /@type@/, or 'P.Nothing'
repositoryFindByGtype :: a -> GType -> m BaseInfo
repositoryFindByGtype repository :: a
repository gtype :: GType
gtype = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    let gtype' :: CGType
gtype' = GType -> CGType
gtypeToCGType GType
gtype
    Ptr BaseInfo
result <- Ptr Repository -> CGType -> IO (Ptr BaseInfo)
g_irepository_find_by_gtype Ptr Repository
repository' CGType
gtype'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryFindByGtype" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
    BaseInfo -> IO BaseInfo
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'

#if defined(ENABLE_OVERLOADING)
data RepositoryFindByGtypeMethodInfo
instance (signature ~ (GType -> m GIRepository.BaseInfo.BaseInfo), MonadIO m, IsRepository a) => O.MethodInfo RepositoryFindByGtypeMethodInfo a signature where
    overloadedMethod = repositoryFindByGtype

#endif

-- method Repository::find_by_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "namespace_"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Namespace which will be searched"
--                 , 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 "Entry name 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_irepository_find_by_name" g_irepository_find_by_name :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    CString ->                              -- namespace_ : TBasicType TUTF8
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | Searches for a particular entry in a namespace.  Before calling
-- this function for a particular namespace, you must call
-- 'GI.GIRepository.Objects.Repository.repositoryRequire' once to load the namespace, or otherwise
-- ensure the namespace has already been loaded.
repositoryFindByName ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> T.Text
    -- ^ /@namespace_@/: Namespace which will be searched
    -> T.Text
    -- ^ /@name@/: Entry name to find
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ t'GI.GIRepository.Structs.BaseInfo.BaseInfo' representing metadata about /@name@/, or 'P.Nothing'
repositoryFindByName :: a -> Text -> Text -> m BaseInfo
repositoryFindByName repository :: a
repository namespace_ :: Text
namespace_ name :: Text
name = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    CString
namespace_' <- Text -> IO CString
textToCString Text
namespace_
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr BaseInfo
result <- Ptr Repository -> CString -> CString -> IO (Ptr BaseInfo)
g_irepository_find_by_name Ptr Repository
repository' CString
namespace_' CString
name'
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryFindByName" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namespace_'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    BaseInfo -> IO BaseInfo
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'

#if defined(ENABLE_OVERLOADING)
data RepositoryFindByNameMethodInfo
instance (signature ~ (T.Text -> T.Text -> m GIRepository.BaseInfo.BaseInfo), MonadIO m, IsRepository a) => O.MethodInfo RepositoryFindByNameMethodInfo a signature where
    overloadedMethod = repositoryFindByName

#endif

-- method Repository::get_c_prefix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "namespace_"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Namespace to inspect"
--                 , 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_irepository_get_c_prefix" g_irepository_get_c_prefix :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    CString ->                              -- namespace_ : TBasicType TUTF8
    IO CString

-- | This function returns the \"C prefix\", or the C level namespace
-- associated with the given introspection namespace.  Each C symbol
-- starts with this prefix, as well each t'GType' in the library.
-- 
-- Note: The namespace must have already been loaded using a function
-- such as 'GI.GIRepository.Objects.Repository.repositoryRequire' before calling this function.
repositoryGetCPrefix ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> T.Text
    -- ^ /@namespace_@/: Namespace to inspect
    -> m T.Text
    -- ^ __Returns:__ C namespace prefix, or 'P.Nothing' if none associated
repositoryGetCPrefix :: a -> Text -> m Text
repositoryGetCPrefix repository :: a
repository namespace_ :: Text
namespace_ = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    CString
namespace_' <- Text -> IO CString
textToCString Text
namespace_
    CString
result <- Ptr Repository -> CString -> IO CString
g_irepository_get_c_prefix Ptr Repository
repository' CString
namespace_'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryGetCPrefix" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namespace_'
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data RepositoryGetCPrefixMethodInfo
instance (signature ~ (T.Text -> m T.Text), MonadIO m, IsRepository a) => O.MethodInfo RepositoryGetCPrefixMethodInfo a signature where
    overloadedMethod = repositoryGetCPrefix

#endif

-- method Repository::get_dependencies
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "namespace_"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Namespace of interest"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "g_irepository_get_dependencies" g_irepository_get_dependencies :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    CString ->                              -- namespace_ : TBasicType TUTF8
    IO (Ptr CString)

-- | Return an array of all (transitive) versioned dependencies for
-- /@namespace_@/. Returned strings are of the form
-- \<code>namespace-version\<\/code>.
-- 
-- Note: /@namespace_@/ must have already been loaded using a function
-- such as 'GI.GIRepository.Objects.Repository.repositoryRequire' before calling this function.
-- 
-- To get only the immediate dependencies for /@namespace_@/, use
-- 'GI.GIRepository.Objects.Repository.repositoryGetImmediateDependencies'.
repositoryGetDependencies ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> T.Text
    -- ^ /@namespace_@/: Namespace of interest
    -> m [T.Text]
    -- ^ __Returns:__ Zero-terminated string array of all versioned
    --   dependencies
repositoryGetDependencies :: a -> Text -> m [Text]
repositoryGetDependencies repository :: a
repository namespace_ :: Text
namespace_ = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    CString
namespace_' <- Text -> IO CString
textToCString Text
namespace_
    Ptr CString
result <- Ptr Repository -> CString -> IO (Ptr CString)
g_irepository_get_dependencies Ptr Repository
repository' CString
namespace_'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryGetDependencies" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namespace_'
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data RepositoryGetDependenciesMethodInfo
instance (signature ~ (T.Text -> m [T.Text]), MonadIO m, IsRepository a) => O.MethodInfo RepositoryGetDependenciesMethodInfo a signature where
    overloadedMethod = repositoryGetDependencies

#endif

-- method Repository::get_immediate_dependencies
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "namespace_"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Namespace of interest"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "g_irepository_get_immediate_dependencies" g_irepository_get_immediate_dependencies :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    CString ->                              -- namespace_ : TBasicType TUTF8
    IO (Ptr CString)

-- | Return an array of the immediate versioned dependencies for /@namespace_@/.
-- Returned strings are of the form \<code>namespace-version\<\/code>.
-- 
-- Note: /@namespace_@/ must have already been loaded using a function
-- such as 'GI.GIRepository.Objects.Repository.repositoryRequire' before calling this function.
-- 
-- To get the transitive closure of dependencies for /@namespace_@/, use
-- 'GI.GIRepository.Objects.Repository.repositoryGetDependencies'.
-- 
-- /Since: 1.44/
repositoryGetImmediateDependencies ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> T.Text
    -- ^ /@namespace_@/: Namespace of interest
    -> m [T.Text]
    -- ^ __Returns:__ Zero-terminated string array of immediate versioned
    --   dependencies
repositoryGetImmediateDependencies :: a -> Text -> m [Text]
repositoryGetImmediateDependencies repository :: a
repository namespace_ :: Text
namespace_ = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    CString
namespace_' <- Text -> IO CString
textToCString Text
namespace_
    Ptr CString
result <- Ptr Repository -> CString -> IO (Ptr CString)
g_irepository_get_immediate_dependencies Ptr Repository
repository' CString
namespace_'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryGetImmediateDependencies" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namespace_'
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data RepositoryGetImmediateDependenciesMethodInfo
instance (signature ~ (T.Text -> m [T.Text]), MonadIO m, IsRepository a) => O.MethodInfo RepositoryGetImmediateDependenciesMethodInfo a signature where
    overloadedMethod = repositoryGetImmediateDependencies

#endif

-- method Repository::get_info
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "namespace_"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Namespace to inspect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "0-based offset into namespace metadata for entry"
--                 , 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_irepository_get_info" g_irepository_get_info :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    CString ->                              -- namespace_ : TBasicType TUTF8
    Int32 ->                                -- index : TBasicType TInt
    IO (Ptr GIRepository.BaseInfo.BaseInfo)

-- | This function returns a particular metadata entry in the
-- given namespace /@namespace_@/.  The namespace must have
-- already been loaded before calling this function.
-- See 'GI.GIRepository.Objects.Repository.repositoryGetNInfos' to find the maximum number of
-- entries.
repositoryGetInfo ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> T.Text
    -- ^ /@namespace_@/: Namespace to inspect
    -> Int32
    -- ^ /@index@/: 0-based offset into namespace metadata for entry
    -> m GIRepository.BaseInfo.BaseInfo
    -- ^ __Returns:__ t'GI.GIRepository.Structs.BaseInfo.BaseInfo' containing metadata
repositoryGetInfo :: a -> Text -> Int32 -> m BaseInfo
repositoryGetInfo repository :: a
repository namespace_ :: Text
namespace_ index :: Int32
index = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    CString
namespace_' <- Text -> IO CString
textToCString Text
namespace_
    Ptr BaseInfo
result <- Ptr Repository -> CString -> Int32 -> IO (Ptr BaseInfo)
g_irepository_get_info Ptr Repository
repository' CString
namespace_' Int32
index
    Text -> Ptr BaseInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryGetInfo" Ptr BaseInfo
result
    BaseInfo
result' <- ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) Ptr BaseInfo
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namespace_'
    BaseInfo -> IO BaseInfo
forall (m :: * -> *) a. Monad m => a -> m a
return BaseInfo
result'

#if defined(ENABLE_OVERLOADING)
data RepositoryGetInfoMethodInfo
instance (signature ~ (T.Text -> Int32 -> m GIRepository.BaseInfo.BaseInfo), MonadIO m, IsRepository a) => O.MethodInfo RepositoryGetInfoMethodInfo a signature where
    overloadedMethod = repositoryGetInfo

#endif

-- method Repository::get_loaded_namespaces
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "g_irepository_get_loaded_namespaces" g_irepository_get_loaded_namespaces :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    IO (Ptr CString)

-- | Return the list of currently loaded namespaces.
repositoryGetLoadedNamespaces ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> m [T.Text]
    -- ^ __Returns:__ List of namespaces
repositoryGetLoadedNamespaces :: a -> m [Text]
repositoryGetLoadedNamespaces repository :: a
repository = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    Ptr CString
result <- Ptr Repository -> IO (Ptr CString)
g_irepository_get_loaded_namespaces Ptr Repository
repository'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryGetLoadedNamespaces" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data RepositoryGetLoadedNamespacesMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsRepository a) => O.MethodInfo RepositoryGetLoadedNamespacesMethodInfo a signature where
    overloadedMethod = repositoryGetLoadedNamespaces

#endif

-- method Repository::get_n_infos
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "namespace_"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Namespace to inspect"
--                 , 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_irepository_get_n_infos" g_irepository_get_n_infos :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    CString ->                              -- namespace_ : TBasicType TUTF8
    IO Int32

-- | This function returns the number of metadata entries in
-- given namespace /@namespace_@/.  The namespace must have
-- already been loaded before calling this function.
repositoryGetNInfos ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> T.Text
    -- ^ /@namespace_@/: Namespace to inspect
    -> m Int32
    -- ^ __Returns:__ number of metadata entries
repositoryGetNInfos :: a -> Text -> m Int32
repositoryGetNInfos repository :: a
repository namespace_ :: Text
namespace_ = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    CString
namespace_' <- Text -> IO CString
textToCString Text
namespace_
    Int32
result <- Ptr Repository -> CString -> IO Int32
g_irepository_get_n_infos Ptr Repository
repository' CString
namespace_'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namespace_'
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data RepositoryGetNInfosMethodInfo
instance (signature ~ (T.Text -> m Int32), MonadIO m, IsRepository a) => O.MethodInfo RepositoryGetNInfosMethodInfo a signature where
    overloadedMethod = repositoryGetNInfos

#endif

-- method Repository::get_object_gtype_interfaces
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GIRepository, or %NULL for the default repository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "gtype"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GType whose fundamental type is G_TYPE_OBJECT"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_interfaces_out"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Number of interfaces"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "interfaces_out"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface
--                    Name { namespace = "GIRepository" , name = "BaseInfo" })
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Interfaces for @gtype"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_interfaces_out"
--              , argType = TBasicType TUInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "Number of interfaces"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_irepository_get_object_gtype_interfaces" g_irepository_get_object_gtype_interfaces :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    CGType ->                               -- gtype : TBasicType TGType
    Ptr Word32 ->                           -- n_interfaces_out : TBasicType TUInt
    Ptr (Ptr GIRepository.BaseInfo.BaseInfo) -> -- interfaces_out : TCArray False (-1) 2 (TInterface (Name {namespace = "GIRepository", name = "BaseInfo"}))
    IO ()

-- | Look up the implemented interfaces for /@gtype@/.  This function
-- cannot fail per se; but for a totally \"unknown\" t'GType', it may
-- return 0 implemented interfaces.
-- 
-- The semantics of this function are designed for a dynamic binding,
-- where in certain cases (such as a function which returns an
-- interface which may have \"hidden\" implementation classes), not all
-- data may be statically known, and will have to be determined from
-- the t'GType' of the object.  An example is @/g_file_new_for_path()/@
-- returning a concrete class of @/GLocalFile/@, which is a t'GType' we
-- see at runtime, but not statically.
-- 
-- /Since: 1.60/
repositoryGetObjectGtypeInterfaces ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: a t'GI.GIRepository.Objects.Repository.Repository', or 'P.Nothing' for the default repository
    -> GType
    -- ^ /@gtype@/: a t'GType' whose fundamental type is G_TYPE_OBJECT
    -> m ([GIRepository.BaseInfo.BaseInfo])
repositoryGetObjectGtypeInterfaces :: a -> GType -> m [BaseInfo]
repositoryGetObjectGtypeInterfaces repository :: a
repository gtype :: GType
gtype = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    let gtype' :: CGType
gtype' = GType -> CGType
gtypeToCGType GType
gtype
    Ptr Word32
nInterfacesOut <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr (Ptr BaseInfo)
interfacesOut <- IO (Ptr (Ptr BaseInfo))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr GIRepository.BaseInfo.BaseInfo))
    Ptr Repository
-> CGType -> Ptr Word32 -> Ptr (Ptr BaseInfo) -> IO ()
g_irepository_get_object_gtype_interfaces Ptr Repository
repository' CGType
gtype' Ptr Word32
nInterfacesOut Ptr (Ptr BaseInfo)
interfacesOut
    Word32
nInterfacesOut' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
nInterfacesOut
    Ptr BaseInfo
interfacesOut' <- Ptr (Ptr BaseInfo) -> IO (Ptr BaseInfo)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr BaseInfo)
interfacesOut
    [Ptr BaseInfo]
interfacesOut'' <- (Int -> Word32 -> Ptr BaseInfo -> IO [Ptr BaseInfo]
forall a b.
(Integral a, BoxedObject b) =>
Int -> a -> Ptr b -> IO [Ptr b]
unpackBoxedArrayWithLength 72 Word32
nInterfacesOut') Ptr BaseInfo
interfacesOut'
    [BaseInfo]
interfacesOut''' <- (Ptr BaseInfo -> IO BaseInfo) -> [Ptr BaseInfo] -> IO [BaseInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr BaseInfo -> BaseInfo) -> Ptr BaseInfo -> IO BaseInfo
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr BaseInfo -> BaseInfo
GIRepository.BaseInfo.BaseInfo) [Ptr BaseInfo]
interfacesOut''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
nInterfacesOut
    Ptr (Ptr BaseInfo) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr BaseInfo)
interfacesOut
    [BaseInfo] -> IO [BaseInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [BaseInfo]
interfacesOut'''

#if defined(ENABLE_OVERLOADING)
data RepositoryGetObjectGtypeInterfacesMethodInfo
instance (signature ~ (GType -> m ([GIRepository.BaseInfo.BaseInfo])), MonadIO m, IsRepository a) => O.MethodInfo RepositoryGetObjectGtypeInterfacesMethodInfo a signature where
    overloadedMethod = repositoryGetObjectGtypeInterfaces

#endif

-- method Repository::get_shared_library
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "namespace_"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Namespace to inspect"
--                 , 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_irepository_get_shared_library" g_irepository_get_shared_library :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    CString ->                              -- namespace_ : TBasicType TUTF8
    IO CString

-- | This function returns a comma-separated list of paths to the
-- shared C libraries associated with the given namespace /@namespace_@/.
-- There may be no shared library path associated, in which case this
-- function will return 'P.Nothing'.
-- 
-- Note: The namespace must have already been loaded using a function
-- such as 'GI.GIRepository.Objects.Repository.repositoryRequire' before calling this function.
repositoryGetSharedLibrary ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> T.Text
    -- ^ /@namespace_@/: Namespace to inspect
    -> m T.Text
    -- ^ __Returns:__ Comma-separated list of paths to shared libraries,
    --   or 'P.Nothing' if none are associated
repositoryGetSharedLibrary :: a -> Text -> m Text
repositoryGetSharedLibrary repository :: a
repository namespace_ :: Text
namespace_ = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    CString
namespace_' <- Text -> IO CString
textToCString Text
namespace_
    CString
result <- Ptr Repository -> CString -> IO CString
g_irepository_get_shared_library Ptr Repository
repository' CString
namespace_'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryGetSharedLibrary" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namespace_'
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data RepositoryGetSharedLibraryMethodInfo
instance (signature ~ (T.Text -> m T.Text), MonadIO m, IsRepository a) => O.MethodInfo RepositoryGetSharedLibraryMethodInfo a signature where
    overloadedMethod = repositoryGetSharedLibrary

#endif

-- method Repository::get_typelib_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "namespace_"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GI namespace to use, e.g. \"Gtk\""
--                 , 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_irepository_get_typelib_path" g_irepository_get_typelib_path :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    CString ->                              -- namespace_ : TBasicType TUTF8
    IO CString

-- | If namespace /@namespace_@/ is loaded, return the full path to the
-- .typelib file it was loaded from.  If the typelib for
-- namespace /@namespace_@/ was included in a shared library, return
-- the special string \"&lt;builtin&gt;\".
repositoryGetTypelibPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> T.Text
    -- ^ /@namespace_@/: GI namespace to use, e.g. \"Gtk\"
    -> m T.Text
    -- ^ __Returns:__ Filesystem path (or $lt;builtin$gt;) if successful, 'P.Nothing' if namespace is not loaded
repositoryGetTypelibPath :: a -> Text -> m Text
repositoryGetTypelibPath repository :: a
repository namespace_ :: Text
namespace_ = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    CString
namespace_' <- Text -> IO CString
textToCString Text
namespace_
    CString
result <- Ptr Repository -> CString -> IO CString
g_irepository_get_typelib_path Ptr Repository
repository' CString
namespace_'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryGetTypelibPath" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namespace_'
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data RepositoryGetTypelibPathMethodInfo
instance (signature ~ (T.Text -> m T.Text), MonadIO m, IsRepository a) => O.MethodInfo RepositoryGetTypelibPathMethodInfo a signature where
    overloadedMethod = repositoryGetTypelibPath

#endif

-- method Repository::get_version
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "namespace_"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Namespace to inspect"
--                 , 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_irepository_get_version" g_irepository_get_version :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    CString ->                              -- namespace_ : TBasicType TUTF8
    IO CString

-- | This function returns the loaded version associated with the given
-- namespace /@namespace_@/.
-- 
-- Note: The namespace must have already been loaded using a function
-- such as 'GI.GIRepository.Objects.Repository.repositoryRequire' before calling this function.
repositoryGetVersion ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> T.Text
    -- ^ /@namespace_@/: Namespace to inspect
    -> m T.Text
    -- ^ __Returns:__ Loaded version
repositoryGetVersion :: a -> Text -> m Text
repositoryGetVersion repository :: a
repository namespace_ :: Text
namespace_ = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    CString
namespace_' <- Text -> IO CString
textToCString Text
namespace_
    CString
result <- Ptr Repository -> CString -> IO CString
g_irepository_get_version Ptr Repository
repository' CString
namespace_'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryGetVersion" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namespace_'
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data RepositoryGetVersionMethodInfo
instance (signature ~ (T.Text -> m T.Text), MonadIO m, IsRepository a) => O.MethodInfo RepositoryGetVersionMethodInfo a signature where
    overloadedMethod = repositoryGetVersion

#endif

-- method Repository::is_registered
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "namespace_"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Namespace of interest"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "version"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Required version, may be %NULL for latest"
--                 , 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_irepository_is_registered" g_irepository_is_registered :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    CString ->                              -- namespace_ : TBasicType TUTF8
    CString ->                              -- version : TBasicType TUTF8
    IO CInt

-- | Check whether a particular namespace (and optionally, a specific
-- version thereof) is currently loaded.  This function is likely to
-- only be useful in unusual circumstances; in order to act upon
-- metadata in the namespace, you should call 'GI.GIRepository.Objects.Repository.repositoryRequire'
-- instead which will ensure the namespace is loaded, and return as
-- quickly as this function will if it has already been loaded.
repositoryIsRegistered ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> T.Text
    -- ^ /@namespace_@/: Namespace of interest
    -> Maybe (T.Text)
    -- ^ /@version@/: Required version, may be 'P.Nothing' for latest
    -> m Bool
    -- ^ __Returns:__ 'P.True' if namespace-version is loaded, 'P.False' otherwise
repositoryIsRegistered :: a -> Text -> Maybe Text -> m Bool
repositoryIsRegistered repository :: a
repository namespace_ :: Text
namespace_ version :: Maybe Text
version = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    CString
namespace_' <- Text -> IO CString
textToCString Text
namespace_
    CString
maybeVersion <- case Maybe Text
version of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jVersion :: Text
jVersion -> do
            CString
jVersion' <- Text -> IO CString
textToCString Text
jVersion
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jVersion'
    CInt
result <- Ptr Repository -> CString -> CString -> IO CInt
g_irepository_is_registered Ptr Repository
repository' CString
namespace_' CString
maybeVersion
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namespace_'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeVersion
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RepositoryIsRegisteredMethodInfo
instance (signature ~ (T.Text -> Maybe (T.Text) -> m Bool), MonadIO m, IsRepository a) => O.MethodInfo RepositoryIsRegisteredMethodInfo a signature where
    overloadedMethod = repositoryIsRegistered

#endif

-- method Repository::load_typelib
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , 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 = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "RepositoryLoadFlags" }
--           , 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 TUTF8)
-- throws : True
-- Skip return : False

foreign import ccall "g_irepository_load_typelib" g_irepository_load_typelib :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    Ptr GIRepository.Typelib.Typelib ->     -- typelib : TInterface (Name {namespace = "GIRepository", name = "Typelib"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GIRepository", name = "RepositoryLoadFlags"})
    Ptr (Ptr GError) ->                     -- error
    IO CString

-- | TODO
repositoryLoadTypelib ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> GIRepository.Typelib.Typelib
    -- ^ /@typelib@/: TODO
    -> [GIRepository.Flags.RepositoryLoadFlags]
    -- ^ /@flags@/: TODO
    -> m T.Text
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repositoryLoadTypelib :: a -> Typelib -> [RepositoryLoadFlags] -> m Text
repositoryLoadTypelib repository :: a
repository typelib :: Typelib
typelib flags :: [RepositoryLoadFlags]
flags = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    Ptr Typelib
typelib' <- Typelib -> IO (Ptr Typelib)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Typelib
typelib
    let flags' :: CUInt
flags' = [RepositoryLoadFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [RepositoryLoadFlags]
flags
    IO Text -> IO () -> IO Text
forall a b. IO a -> IO b -> IO a
onException (do
        CString
result <- (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CString) -> IO CString)
-> (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ Ptr Repository
-> Ptr Typelib -> CUInt -> Ptr (Ptr GError) -> IO CString
g_irepository_load_typelib Ptr Repository
repository' Ptr Typelib
typelib' CUInt
flags'
        Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryLoadTypelib" CString
result
        Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
        Typelib -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Typelib
typelib
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data RepositoryLoadTypelibMethodInfo
instance (signature ~ (GIRepository.Typelib.Typelib -> [GIRepository.Flags.RepositoryLoadFlags] -> m T.Text), MonadIO m, IsRepository a) => O.MethodInfo RepositoryLoadTypelibMethodInfo a signature where
    overloadedMethod = repositoryLoadTypelib

#endif

-- method Repository::require
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "namespace_"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GI namespace to use, e.g. \"Gtk\""
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "version"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Version of namespace, may be %NULL for latest"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "RepositoryLoadFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Set of %GIRepositoryLoadFlags, may be 0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GIRepository" , name = "Typelib" })
-- throws : True
-- Skip return : False

foreign import ccall "g_irepository_require" g_irepository_require :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    CString ->                              -- namespace_ : TBasicType TUTF8
    CString ->                              -- version : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "GIRepository", name = "RepositoryLoadFlags"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GIRepository.Typelib.Typelib)

-- | Force the namespace /@namespace_@/ to be loaded if it isn\'t already.
-- If /@namespace_@/ is not loaded, this function will search for a
-- \".typelib\" file using the repository search path.  In addition, a
-- version /@version@/ of namespace may be specified.  If /@version@/ is
-- not specified, the latest will be used.
repositoryRequire ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> T.Text
    -- ^ /@namespace_@/: GI namespace to use, e.g. \"Gtk\"
    -> Maybe (T.Text)
    -- ^ /@version@/: Version of namespace, may be 'P.Nothing' for latest
    -> [GIRepository.Flags.RepositoryLoadFlags]
    -- ^ /@flags@/: Set of @/GIRepositoryLoadFlags/@, may be 0
    -> m GIRepository.Typelib.Typelib
    -- ^ __Returns:__ a pointer to the t'GI.GIRepository.Structs.Typelib.Typelib' if successful, 'P.Nothing' otherwise /(Can throw 'Data.GI.Base.GError.GError')/
repositoryRequire :: a -> Text -> Maybe Text -> [RepositoryLoadFlags] -> m Typelib
repositoryRequire repository :: a
repository namespace_ :: Text
namespace_ version :: Maybe Text
version flags :: [RepositoryLoadFlags]
flags = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    CString
namespace_' <- Text -> IO CString
textToCString Text
namespace_
    CString
maybeVersion <- case Maybe Text
version of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jVersion :: Text
jVersion -> do
            CString
jVersion' <- Text -> IO CString
textToCString Text
jVersion
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jVersion'
    let flags' :: CUInt
flags' = [RepositoryLoadFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [RepositoryLoadFlags]
flags
    IO Typelib -> IO () -> IO Typelib
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Typelib
result <- (Ptr (Ptr GError) -> IO (Ptr Typelib)) -> IO (Ptr Typelib)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Typelib)) -> IO (Ptr Typelib))
-> (Ptr (Ptr GError) -> IO (Ptr Typelib)) -> IO (Ptr Typelib)
forall a b. (a -> b) -> a -> b
$ Ptr Repository
-> CString
-> CString
-> CUInt
-> Ptr (Ptr GError)
-> IO (Ptr Typelib)
g_irepository_require Ptr Repository
repository' CString
namespace_' CString
maybeVersion CUInt
flags'
        Text -> Ptr Typelib -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryRequire" Ptr Typelib
result
        Typelib
result' <- ((ManagedPtr Typelib -> Typelib) -> Ptr Typelib -> IO Typelib
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Typelib -> Typelib
GIRepository.Typelib.Typelib) Ptr Typelib
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namespace_'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeVersion
        Typelib -> IO Typelib
forall (m :: * -> *) a. Monad m => a -> m a
return Typelib
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namespace_'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeVersion
     )

#if defined(ENABLE_OVERLOADING)
data RepositoryRequireMethodInfo
instance (signature ~ (T.Text -> Maybe (T.Text) -> [GIRepository.Flags.RepositoryLoadFlags] -> m GIRepository.Typelib.Typelib), MonadIO m, IsRepository a) => O.MethodInfo RepositoryRequireMethodInfo a signature where
    overloadedMethod = repositoryRequire

#endif

-- method Repository::require_private
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repository"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "Repository" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #GIRepository or %NULL for the singleton\n  process-global default #GIRepository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "typelib_dir"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Private directory where to find the requested typelib"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "namespace_"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GI namespace to use, e.g. \"Gtk\""
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "version"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Version of namespace, may be %NULL for latest"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GIRepository" , name = "RepositoryLoadFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Set of %GIRepositoryLoadFlags, may be 0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GIRepository" , name = "Typelib" })
-- throws : True
-- Skip return : False

foreign import ccall "g_irepository_require_private" g_irepository_require_private :: 
    Ptr Repository ->                       -- repository : TInterface (Name {namespace = "GIRepository", name = "Repository"})
    CString ->                              -- typelib_dir : TBasicType TUTF8
    CString ->                              -- namespace_ : TBasicType TUTF8
    CString ->                              -- version : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "GIRepository", name = "RepositoryLoadFlags"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GIRepository.Typelib.Typelib)

-- | Force the namespace /@namespace_@/ to be loaded if it isn\'t already.
-- If /@namespace_@/ is not loaded, this function will search for a
-- \".typelib\" file within the private directory only. In addition, a
-- version /@version@/ of namespace should be specified.  If /@version@/ is
-- not specified, the latest will be used.
repositoryRequirePrivate ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepository a) =>
    a
    -- ^ /@repository@/: A t'GI.GIRepository.Objects.Repository.Repository' or 'P.Nothing' for the singleton
    --   process-global default t'GI.GIRepository.Objects.Repository.Repository'
    -> T.Text
    -- ^ /@typelibDir@/: Private directory where to find the requested typelib
    -> T.Text
    -- ^ /@namespace_@/: GI namespace to use, e.g. \"Gtk\"
    -> Maybe (T.Text)
    -- ^ /@version@/: Version of namespace, may be 'P.Nothing' for latest
    -> [GIRepository.Flags.RepositoryLoadFlags]
    -- ^ /@flags@/: Set of @/GIRepositoryLoadFlags/@, may be 0
    -> m GIRepository.Typelib.Typelib
    -- ^ __Returns:__ a pointer to the t'GI.GIRepository.Structs.Typelib.Typelib' if successful, 'P.Nothing' otherwise /(Can throw 'Data.GI.Base.GError.GError')/
repositoryRequirePrivate :: a
-> Text -> Text -> Maybe Text -> [RepositoryLoadFlags] -> m Typelib
repositoryRequirePrivate repository :: a
repository typelibDir :: Text
typelibDir namespace_ :: Text
namespace_ version :: Maybe Text
version flags :: [RepositoryLoadFlags]
flags = 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 Repository
repository' <- a -> IO (Ptr Repository)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repository
    CString
typelibDir' <- Text -> IO CString
textToCString Text
typelibDir
    CString
namespace_' <- Text -> IO CString
textToCString Text
namespace_
    CString
maybeVersion <- case Maybe Text
version of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jVersion :: Text
jVersion -> do
            CString
jVersion' <- Text -> IO CString
textToCString Text
jVersion
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jVersion'
    let flags' :: CUInt
flags' = [RepositoryLoadFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [RepositoryLoadFlags]
flags
    IO Typelib -> IO () -> IO Typelib
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Typelib
result <- (Ptr (Ptr GError) -> IO (Ptr Typelib)) -> IO (Ptr Typelib)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Typelib)) -> IO (Ptr Typelib))
-> (Ptr (Ptr GError) -> IO (Ptr Typelib)) -> IO (Ptr Typelib)
forall a b. (a -> b) -> a -> b
$ Ptr Repository
-> CString
-> CString
-> CString
-> CUInt
-> Ptr (Ptr GError)
-> IO (Ptr Typelib)
g_irepository_require_private Ptr Repository
repository' CString
typelibDir' CString
namespace_' CString
maybeVersion CUInt
flags'
        Text -> Ptr Typelib -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryRequirePrivate" Ptr Typelib
result
        Typelib
result' <- ((ManagedPtr Typelib -> Typelib) -> Ptr Typelib -> IO Typelib
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Typelib -> Typelib
GIRepository.Typelib.Typelib) Ptr Typelib
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repository
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
typelibDir'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namespace_'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeVersion
        Typelib -> IO Typelib
forall (m :: * -> *) a. Monad m => a -> m a
return Typelib
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
typelibDir'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
namespace_'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeVersion
     )

#if defined(ENABLE_OVERLOADING)
data RepositoryRequirePrivateMethodInfo
instance (signature ~ (T.Text -> T.Text -> Maybe (T.Text) -> [GIRepository.Flags.RepositoryLoadFlags] -> m GIRepository.Typelib.Typelib), MonadIO m, IsRepository a) => O.MethodInfo RepositoryRequirePrivateMethodInfo a signature where
    overloadedMethod = repositoryRequirePrivate

#endif

-- method Repository::dump
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "arg"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_irepository_dump" g_irepository_dump :: 
    CString ->                              -- arg : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
repositoryDump ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repositoryDump :: Text -> m ()
repositoryDump arg :: Text
arg = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CString
arg' <- Text -> IO CString
textToCString Text
arg
    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
$ CString -> Ptr (Ptr GError) -> IO CInt
g_irepository_dump CString
arg'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
arg'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
arg'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Repository::error_quark
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "g_irepository_error_quark" g_irepository_error_quark :: 
    IO Word32

-- | /No description available in the introspection data./
repositoryErrorQuark ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Word32
repositoryErrorQuark :: m Word32
repositoryErrorQuark  = IO Word32 -> m Word32
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_irepository_error_quark
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
#endif

-- method Repository::get_default
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GIRepository" , name = "Repository" })
-- throws : False
-- Skip return : False

foreign import ccall "g_irepository_get_default" g_irepository_get_default :: 
    IO (Ptr Repository)

-- | Returns the singleton process-global default t'GI.GIRepository.Objects.Repository.Repository'. It is
-- not currently supported to have multiple repositories in a
-- particular process, but this function is provided in the unlikely
-- eventuality that it would become possible, and as a convenience for
-- higher level language bindings to conform to the GObject method
-- call conventions.
-- 
-- All methods on t'GI.GIRepository.Objects.Repository.Repository' also accept 'P.Nothing' as an instance
-- parameter to mean this default repository, which is usually more
-- convenient for C.
repositoryGetDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Repository
    -- ^ __Returns:__ The global singleton t'GI.GIRepository.Objects.Repository.Repository'
repositoryGetDefault :: m Repository
repositoryGetDefault  = IO Repository -> m Repository
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Repository -> m Repository) -> IO Repository -> m Repository
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repository
result <- IO (Ptr Repository)
g_irepository_get_default
    Text -> Ptr Repository -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryGetDefault" Ptr Repository
result
    Repository
result' <- ((ManagedPtr Repository -> Repository)
-> Ptr Repository -> IO Repository
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Repository -> Repository
Repository) Ptr Repository
result
    Repository -> IO Repository
forall (m :: * -> *) a. Monad m => a -> m a
return Repository
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Repository::get_option_group
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GLib" , name = "OptionGroup" })
-- throws : False
-- Skip return : False

foreign import ccall "g_irepository_get_option_group" g_irepository_get_option_group :: 
    IO (Ptr GLib.OptionGroup.OptionGroup)

-- | Obtain the option group for girepository, it\'s used
-- by the dumper and for programs that wants to provide
-- introspection information
repositoryGetOptionGroup ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m GLib.OptionGroup.OptionGroup
    -- ^ __Returns:__ the option group
repositoryGetOptionGroup :: m OptionGroup
repositoryGetOptionGroup  = IO OptionGroup -> m OptionGroup
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO OptionGroup -> m OptionGroup)
-> IO OptionGroup -> m OptionGroup
forall a b. (a -> b) -> a -> b
$ do
    Ptr OptionGroup
result <- IO (Ptr OptionGroup)
g_irepository_get_option_group
    Text -> Ptr OptionGroup -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repositoryGetOptionGroup" Ptr OptionGroup
result
    OptionGroup
result' <- ((ManagedPtr OptionGroup -> OptionGroup)
-> Ptr OptionGroup -> IO OptionGroup
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr OptionGroup -> OptionGroup
GLib.OptionGroup.OptionGroup) Ptr OptionGroup
result
    OptionGroup -> IO OptionGroup
forall (m :: * -> *) a. Monad m => a -> m a
return OptionGroup
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Repository::get_search_path
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TGSList (TBasicType TFileName))
-- throws : False
-- Skip return : False

foreign import ccall "g_irepository_get_search_path" g_irepository_get_search_path :: 
    IO (Ptr (GSList CString))

-- | Returns the current search path t'GI.GIRepository.Objects.Repository.Repository' will use when loading
-- typelib files. The list is internal to t'GI.GIRepository.Objects.Repository.Repository' and should not
-- be freed, nor should its string elements.
repositoryGetSearchPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m [[Char]]
    -- ^ __Returns:__ t'GI.GLib.Structs.SList.SList' of strings
repositoryGetSearchPath :: m [[Char]]
repositoryGetSearchPath  = IO [[Char]] -> m [[Char]]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[Char]] -> m [[Char]]) -> IO [[Char]] -> m [[Char]]
forall a b. (a -> b) -> a -> b
$ do
    Ptr (GSList CString)
result <- IO (Ptr (GSList CString))
g_irepository_get_search_path
    [CString]
result' <- Ptr (GSList CString) -> IO [CString]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList CString)
result
    [[Char]]
result'' <- (CString -> IO [Char]) -> [CString] -> IO [[Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => CString -> IO [Char]
CString -> IO [Char]
cstringToString [CString]
result'
    [[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]]
result''

#if defined(ENABLE_OVERLOADING)
#endif

-- method Repository::prepend_library_path
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "directory"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , 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 "g_irepository_prepend_library_path" g_irepository_prepend_library_path :: 
    CString ->                              -- directory : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
repositoryPrependLibraryPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -> m ()
repositoryPrependLibraryPath :: Text -> m ()
repositoryPrependLibraryPath directory :: Text
directory = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CString
directory' <- Text -> IO CString
textToCString Text
directory
    CString -> IO ()
g_irepository_prepend_library_path CString
directory'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
directory'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Repository::prepend_search_path
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "directory"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "directory name to prepend to the typelib\n  search path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_irepository_prepend_search_path" g_irepository_prepend_search_path :: 
    CString ->                              -- directory : TBasicType TFileName
    IO ()

-- | Prepends /@directory@/ to the typelib search path.
-- 
-- See also: 'GI.GIRepository.Objects.Repository.repositoryGetSearchPath'.
repositoryPrependSearchPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@directory@/: directory name to prepend to the typelib
    --   search path
    -> m ()
repositoryPrependSearchPath :: [Char] -> m ()
repositoryPrependSearchPath directory :: [Char]
directory = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CString
directory' <- [Char] -> IO CString
stringToCString [Char]
directory
    CString -> IO ()
g_irepository_prepend_search_path CString
directory'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
directory'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif