{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.GModule.Structs.Module.Module' struct is an opaque data structure to represent a
-- [dynamically-loaded module][glib-Dynamic-Loading-of-Modules].
-- It should only be accessed via the following functions.

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

module GI.GModule.Structs.Module
    ( 

-- * Exported types
    Module(..)                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [close]("GI.GModule.Structs.Module#g:method:close"), [makeResident]("GI.GModule.Structs.Module#g:method:makeResident"), [name]("GI.GModule.Structs.Module#g:method:name"), [symbol]("GI.GModule.Structs.Module#g:method:symbol").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveModuleMethod                     ,
#endif

-- ** buildPath #method:buildPath#

    moduleBuildPath                         ,


-- ** close #method:close#

#if defined(ENABLE_OVERLOADING)
    ModuleCloseMethodInfo                   ,
#endif
    moduleClose                             ,


-- ** error #method:error#

    moduleError                             ,


-- ** errorQuark #method:errorQuark#

    moduleErrorQuark                        ,


-- ** makeResident #method:makeResident#

#if defined(ENABLE_OVERLOADING)
    ModuleMakeResidentMethodInfo            ,
#endif
    moduleMakeResident                      ,


-- ** name #method:name#

#if defined(ENABLE_OVERLOADING)
    ModuleNameMethodInfo                    ,
#endif
    moduleName                              ,


-- ** supported #method:supported#

    moduleSupported                         ,


-- ** symbol #method:symbol#

#if defined(ENABLE_OVERLOADING)
    ModuleSymbolMethodInfo                  ,
#endif
    moduleSymbol                            ,




    ) where

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

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


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

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

-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr Module where
    boxedPtrCopy :: Module -> IO Module
boxedPtrCopy = Module -> IO Module
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: Module -> IO ()
boxedPtrFree = \Module
_x -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


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

-- method Module::close
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "module"
--           , argType =
--               TInterface Name { namespace = "GModule" , name = "Module" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GModule to close"
--                 , 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_module_close" g_module_close :: 
    Ptr Module ->                           -- module : TInterface (Name {namespace = "GModule", name = "Module"})
    IO CInt

-- | Closes a module.
moduleClose ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Module
    -- ^ /@module@/: a t'GI.GModule.Structs.Module.Module' to close
    -> m Bool
    -- ^ __Returns:__ 'P.True' on success
moduleClose :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Module -> m Bool
moduleClose Module
module_ = 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 Module
module_' <- Module -> IO (Ptr Module)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Module
module_
    CInt
result <- Ptr Module -> IO CInt
g_module_close Ptr Module
module_'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Module -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Module
module_
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ModuleCloseMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod ModuleCloseMethodInfo Module signature where
    overloadedMethod = moduleClose

instance O.OverloadedMethodInfo ModuleCloseMethodInfo Module where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GModule.Structs.Module.moduleClose",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gmodule-2.0.2/docs/GI-GModule-Structs-Module.html#v:moduleClose"
        })


#endif

-- method Module::make_resident
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "module"
--           , argType =
--               TInterface Name { namespace = "GModule" , name = "Module" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GModule to make permanently resident"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_module_make_resident" g_module_make_resident :: 
    Ptr Module ->                           -- module : TInterface (Name {namespace = "GModule", name = "Module"})
    IO ()

-- | Ensures that a module will never be unloaded.
-- Any future 'GI.GModule.Structs.Module.moduleClose' calls on the module will be ignored.
moduleMakeResident ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Module
    -- ^ /@module@/: a t'GI.GModule.Structs.Module.Module' to make permanently resident
    -> m ()
moduleMakeResident :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Module -> m ()
moduleMakeResident Module
module_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Module
module_' <- Module -> IO (Ptr Module)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Module
module_
    Ptr Module -> IO ()
g_module_make_resident Ptr Module
module_'
    Module -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Module
module_
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ModuleMakeResidentMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ModuleMakeResidentMethodInfo Module signature where
    overloadedMethod = moduleMakeResident

instance O.OverloadedMethodInfo ModuleMakeResidentMethodInfo Module where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GModule.Structs.Module.moduleMakeResident",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gmodule-2.0.2/docs/GI-GModule-Structs-Module.html#v:moduleMakeResident"
        })


#endif

-- method Module::name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "module"
--           , argType =
--               TInterface Name { namespace = "GModule" , name = "Module" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GModule" , 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_module_name" g_module_name :: 
    Ptr Module ->                           -- module : TInterface (Name {namespace = "GModule", name = "Module"})
    IO CString

-- | Returns the filename that the module was opened with.
-- 
-- If /@module@/ refers to the application itself, \"main\" is returned.
moduleName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Module
    -- ^ /@module@/: a t'GI.GModule.Structs.Module.Module'
    -> m T.Text
    -- ^ __Returns:__ the filename of the module
moduleName :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Module -> m Text
moduleName Module
module_ = 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 Module
module_' <- Module -> IO (Ptr Module)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Module
module_
    CString
result <- Ptr Module -> IO CString
g_module_name Ptr Module
module_'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"moduleName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Module -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Module
module_
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ModuleNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod ModuleNameMethodInfo Module signature where
    overloadedMethod = moduleName

instance O.OverloadedMethodInfo ModuleNameMethodInfo Module where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GModule.Structs.Module.moduleName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gmodule-2.0.2/docs/GI-GModule-Structs-Module.html#v:moduleName"
        })


#endif

-- method Module::symbol
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "module"
--           , argType =
--               TInterface Name { namespace = "GModule" , name = "Module" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GModule" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "symbol_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the symbol to find"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "symbol"
--           , argType = TBasicType TPtr
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "returns the pointer to the symbol value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_module_symbol" g_module_symbol :: 
    Ptr Module ->                           -- module : TInterface (Name {namespace = "GModule", name = "Module"})
    CString ->                              -- symbol_name : TBasicType TUTF8
    Ptr (Ptr ()) ->                         -- symbol : TBasicType TPtr
    IO CInt

-- | Gets a symbol pointer from a module, such as one exported
-- by @/G_MODULE_EXPORT/@. Note that a valid symbol can be 'P.Nothing'.
moduleSymbol ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Module
    -- ^ /@module@/: a t'GI.GModule.Structs.Module.Module'
    -> T.Text
    -- ^ /@symbolName@/: the name of the symbol to find
    -> m ((Bool, Ptr ()))
    -- ^ __Returns:__ 'P.True' on success
moduleSymbol :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Module -> Text -> m (Bool, Ptr ())
moduleSymbol Module
module_ Text
symbolName = IO (Bool, Ptr ()) -> m (Bool, Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Ptr ()) -> m (Bool, Ptr ()))
-> IO (Bool, Ptr ()) -> m (Bool, Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr Module
module_' <- Module -> IO (Ptr Module)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Module
module_
    CString
symbolName' <- Text -> IO CString
textToCString Text
symbolName
    Ptr (Ptr ())
symbol <- IO (Ptr (Ptr ()))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr ()))
    CInt
result <- Ptr Module -> CString -> Ptr (Ptr ()) -> IO CInt
g_module_symbol Ptr Module
module_' CString
symbolName' Ptr (Ptr ())
symbol
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr ()
symbol' <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
symbol
    Module -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Module
module_
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
symbolName'
    Ptr (Ptr ()) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr ())
symbol
    (Bool, Ptr ()) -> IO (Bool, Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Ptr ()
symbol')

#if defined(ENABLE_OVERLOADING)
data ModuleSymbolMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Ptr ()))), MonadIO m) => O.OverloadedMethod ModuleSymbolMethodInfo Module signature where
    overloadedMethod = moduleSymbol

instance O.OverloadedMethodInfo ModuleSymbolMethodInfo Module where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GModule.Structs.Module.moduleSymbol",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gmodule-2.0.2/docs/GI-GModule-Structs-Module.html#v:moduleSymbol"
        })


#endif

-- method Module::build_path
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "directory"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the directory where the module is. This can be\n    %NULL or the empty string to indicate that the standard platform-specific\n    directories will be used, though that is not recommended"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "module_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the module"
--                 , 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_module_build_path" g_module_build_path :: 
    CString ->                              -- directory : TBasicType TUTF8
    CString ->                              -- module_name : TBasicType TUTF8
    IO CString

-- | A portable way to build the filename of a module. The platform-specific
-- prefix and suffix are added to the filename, if needed, and the result
-- is added to the directory, using the correct separator character.
-- 
-- The directory should specify the directory where the module can be found.
-- It can be 'P.Nothing' or an empty string to indicate that the module is in a
-- standard platform-specific directory, though this is not recommended
-- since the wrong module may be found.
-- 
-- For example, calling 'GI.GModule.Functions.moduleBuildPath' on a Linux system with a
-- /@directory@/ of @\/lib@ and a /@moduleName@/ of \"mylibrary\" will return
-- @\/lib\/libmylibrary.so@. On a Windows system, using @\\Windows@ as the
-- directory it will return @\\Windows\\mylibrary.dll@.
moduleBuildPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@directory@/: the directory where the module is. This can be
    --     'P.Nothing' or the empty string to indicate that the standard platform-specific
    --     directories will be used, though that is not recommended
    -> T.Text
    -- ^ /@moduleName@/: the name of the module
    -> m T.Text
    -- ^ __Returns:__ the complete path of the module, including the standard library
    --     prefix and suffix. This should be freed when no longer needed
moduleBuildPath :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> Text -> m Text
moduleBuildPath Maybe Text
directory Text
moduleName = 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
    CString
maybeDirectory <- case Maybe Text
directory of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jDirectory -> do
            CString
jDirectory' <- Text -> IO CString
textToCString Text
jDirectory
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jDirectory'
    CString
moduleName' <- Text -> IO CString
textToCString Text
moduleName
    CString
result <- CString -> CString -> IO CString
g_module_build_path CString
maybeDirectory CString
moduleName'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"moduleBuildPath" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeDirectory
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
moduleName'
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Module::error
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "g_module_error" g_module_error :: 
    IO CString

-- | Gets a string describing the last module error.
moduleError ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m T.Text
    -- ^ __Returns:__ a string describing the last module error
moduleError :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Text
moduleError  = 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
    CString
result <- IO CString
g_module_error
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"moduleError" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "g_module_error_quark" g_module_error_quark :: 
    IO Word32

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

#if defined(ENABLE_OVERLOADING)
#endif

-- method Module::supported
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_module_supported" g_module_supported :: 
    IO CInt

-- | Checks if modules are supported on the current platform.
moduleSupported ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Bool
    -- ^ __Returns:__ 'P.True' if modules are supported
moduleSupported :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Bool
moduleSupported  = 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
    CInt
result <- IO CInt
g_module_supported
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveModuleMethod (t :: Symbol) (o :: *) :: * where
    ResolveModuleMethod "close" o = ModuleCloseMethodInfo
    ResolveModuleMethod "makeResident" o = ModuleMakeResidentMethodInfo
    ResolveModuleMethod "name" o = ModuleNameMethodInfo
    ResolveModuleMethod "symbol" o = ModuleSymbolMethodInfo
    ResolveModuleMethod l o = O.MethodResolutionFailed l o

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

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

#endif

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

#endif