{-|
Module      : HsLua.Core.Package
Copyright   : © 2019-2022 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_requiref@: If @modname@ is not already present in
-- @package.loaded@, calls function @openf@ with string @modname@ as an
-- argument and sets the call result in @package.loaded[modname]@, as if
-- that function has been called through
-- <https://www.lua.org/manual/5.3/manual.html#pdf-require require>.
--
-- Leaves a copy of the module on the stack.
requirehs :: LuaError e
          => Name                 -- ^ modname
          -> (Name -> LuaE e ())  -- ^ openf
          -> LuaE e ()
requirehs :: Name -> (Name -> LuaE e ()) -> LuaE e ()
requirehs Name
modname Name -> LuaE e ()
openf = do
  LuaE e Bool -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e Bool -> LuaE e ()) -> LuaE e Bool -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ StackIndex -> Name -> LuaE e Bool
forall e. LuaError e => StackIndex -> Name -> LuaE e Bool
getsubtable StackIndex
registryindex Name
loaded
  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
top Name
modname
  StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
toboolean StackIndex
top LuaE e Bool -> (Bool -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> () -> LuaE e ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()       -- package already loaded
    Bool
False -> do
      -- package not loaded, load it now
      Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1  -- remove field
      StackIndex
oldtop <- LuaE e StackIndex
forall e. LuaE e StackIndex
gettop
      Name -> LuaE e ()
openf Name
modname
      StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
settop (StackIndex
oldtop StackIndex -> StackIndex -> StackIndex
forall a. Num a => a -> a -> a
+ StackIndex
1)
      StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
top  -- make copy of module (call result)
      StackIndex -> Name -> LuaE e ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield (CInt -> StackIndex
nth CInt
3) Name
modname

  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
remove (CInt -> StackIndex
nth CInt
2)  -- remove LOADED table

-- | 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