{-|
Module      : HsLua.Core.Package
Copyright   : © 2019-2021 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>
Stability   : alpha
Portability : Requires GHC 8 or later.

Utility functions for HsLua modules.
-}
module HsLua.Core.Package
  ( requirehs
  , preloadhs
  )
where

import Control.Monad (void)
import HsLua.Core.Auxiliary
import HsLua.Core.Closures (pushHaskellFunction)
import HsLua.Core.Error (LuaError)
import HsLua.Core.Primary
import HsLua.Core.Types
-- import HsLua.Core.Utf8 (fromString)

-- | Load a module, defined by a Haskell action, under the given
-- name.
--
-- Similar to @luaL_required@: After checking "loaded" table,
-- calls @pushMod@ to push a module to the stack, and registers
-- the result in @package.loaded@ table.
--
-- The @pushMod@ function must push exactly one element to the top
-- of the stack. This is not checked, but failure to do so will
-- lead to problems. Lua's @package@ module must have been loaded
-- by the time this function is invoked.
--
-- Leaves a copy of the module on the stack.
requirehs :: LuaError e => Name -> LuaE e () -> LuaE e ()
requirehs :: Name -> LuaE e () -> LuaE e ()
requirehs Name
modname LuaE e ()
pushMod = do
  -- get table of loaded modules
  LuaE e Type -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e Type -> LuaE e ()) -> LuaE e Type -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
registryindex Name
loaded

  -- Check whether module has already been loaded.
  StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
top Name
modname LuaE e Type -> (Type -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case -- LOADED[modname]
    Type
TypeNil -> do    -- not loaded yet, load now
      Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1          -- remove LOADED[modname], i.e., nil
      LuaE e ()
pushMod        -- push module
      StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
top  -- make copy of module
      -- add module under the given name (LOADED[modname] = module)
      StackIndex -> Name -> LuaE e ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield (CInt -> StackIndex
nth CInt
3) Name
modname
    Type
_ -> () -> LuaE e ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
remove (CInt -> StackIndex
nth CInt
2)  -- remove table of loaded modules

-- | Registers a preloading function. Takes an module name and the
-- Lua operation which produces the package.
preloadhs :: LuaError e => Name -> LuaE e NumResults -> LuaE e ()
preloadhs :: Name -> LuaE e NumResults -> LuaE e ()
preloadhs Name
name LuaE e NumResults
pushMod = do
  LuaE e Type -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e Type -> LuaE e ()) -> LuaE e Type -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
getfield StackIndex
registryindex Name
preload
  LuaE e NumResults -> LuaE e ()
forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction LuaE e NumResults
pushMod
  StackIndex -> Name -> LuaE e ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield (CInt -> StackIndex
nth CInt
2) Name
name
  Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1