{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : HsLua.Packaging.Module
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.Packaging.Module
  ( -- * Documented module
    Module (..)
  , Field (..)
  , registerModule
  , preloadModule
  , preloadModuleWithName
  , pushModule
  , Operation (..)
  )
where

import Control.Monad (forM_)
import HsLua.Core
import HsLua.Marshalling (pushName, pushText)
import HsLua.ObjectOrientation.Operation (Operation (..), metamethodName)
import HsLua.Packaging.Types
import qualified HsLua.Packaging.Function as Call

-- | Create a new module (i.e., a Lua table).
create :: LuaE e ()
create :: LuaE e ()
create = LuaE e ()
forall e. LuaE e ()
newtable

-- | Registers a 'Module'; leaves a copy of the module table on
-- the stack.
registerModule :: LuaError e => Module e -> LuaE e ()
registerModule :: Module e -> LuaE e ()
registerModule Module e
mdl =
  Name -> LuaE e () -> LuaE e ()
forall e. LuaError e => Name -> LuaE e () -> LuaE e ()
requirehs (Module e -> Name
forall e. Module e -> Name
moduleName Module e
mdl) (Module e -> LuaE e ()
forall e. LuaError e => Module e -> LuaE e ()
pushModule Module e
mdl)

-- | Add the module under a different name to the table of preloaded
-- packages.
preloadModuleWithName :: LuaError e => Module e -> Name -> LuaE e ()
preloadModuleWithName :: Module e -> Name -> LuaE e ()
preloadModuleWithName Module e
documentedModule Name
name = Module e -> LuaE e ()
forall e. LuaError e => Module e -> LuaE e ()
preloadModule (Module e -> LuaE e ()) -> Module e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$
  Module e
documentedModule { moduleName :: Name
moduleName = Name
name }

-- | Preload self-documenting module using the module's default name.
preloadModule :: LuaError e => Module e -> LuaE e ()
preloadModule :: Module e -> LuaE e ()
preloadModule Module e
mdl =
  Name -> LuaE e NumResults -> LuaE e ()
forall e. LuaError e => Name -> LuaE e NumResults -> LuaE e ()
preloadhs (Module e -> Name
forall e. Module e -> Name
moduleName Module e
mdl) (LuaE e NumResults -> LuaE e ()) -> LuaE e NumResults -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ do
    Module e -> LuaE e ()
forall e. LuaError e => Module e -> LuaE e ()
pushModule Module e
mdl
    NumResults -> LuaE e NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
NumResults CInt
1)

-- | Pushes a documented module to the Lua stack.
pushModule :: LuaError e => Module e -> LuaE e ()
pushModule :: Module e -> LuaE e ()
pushModule Module e
mdl = do
  LuaE e ()
forall e. LuaE e ()
create
  [DocumentedFunction e]
-> (DocumentedFunction e -> LuaE e ()) -> LuaE e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Module e -> [DocumentedFunction e]
forall e. Module e -> [DocumentedFunction e]
moduleFunctions Module e
mdl) ((DocumentedFunction e -> LuaE e ()) -> LuaE e ())
-> (DocumentedFunction e -> LuaE e ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ \DocumentedFunction e
fn -> do
    Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName (DocumentedFunction e -> Name
forall e. DocumentedFunction e -> Name
functionName DocumentedFunction e
fn)
    DocumentedFunction e -> LuaE e ()
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
Call.pushDocumentedFunction DocumentedFunction e
fn
    StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  [Field e] -> (Field e -> LuaE e ()) -> LuaE e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Module e -> [Field e]
forall e. Module e -> [Field e]
moduleFields Module e
mdl) ((Field e -> LuaE e ()) -> LuaE e ())
-> (Field e -> LuaE e ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ \Field e
field -> do
    Pusher e Text
forall e. Pusher e Text
pushText (Field e -> Text
forall e. Field e -> Text
fieldName Field e
field)
    Field e -> LuaE e ()
forall e. Field e -> LuaE e ()
fieldPushValue Field e
field
    StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
  case Module e -> [(Operation, DocumentedFunction e)]
forall e. Module e -> [(Operation, DocumentedFunction e)]
moduleOperations Module e
mdl of
    [] -> () -> LuaE e ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    [(Operation, DocumentedFunction e)]
ops -> do
      -- create a metatable for this module and add operations
      LuaE e ()
forall e. LuaE e ()
newtable
      [(Operation, DocumentedFunction e)]
-> ((Operation, DocumentedFunction e) -> LuaE e ()) -> LuaE e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Operation, DocumentedFunction e)]
ops (((Operation, DocumentedFunction e) -> LuaE e ()) -> LuaE e ())
-> ((Operation, DocumentedFunction e) -> LuaE e ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ \(Operation
op, DocumentedFunction e
fn) -> do
        Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName (Name -> LuaE e ()) -> Name -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ Operation -> Name
metamethodName Operation
op
        DocumentedFunction e -> LuaE e ()
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
Call.pushDocumentedFunction (DocumentedFunction e -> LuaE e ())
-> DocumentedFunction e -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ Name -> DocumentedFunction e -> DocumentedFunction e
forall e. Name -> DocumentedFunction e -> DocumentedFunction e
Call.setName Name
"" DocumentedFunction e
fn
        StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)
      StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)