{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : HsLua.Packaging.Module
Copyright   : © 2019-2023 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>
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 (Pusher, pushAsTable, pushList, pushName, pushText)
import HsLua.ObjectOrientation.Operation (Operation (..), metamethodName)
import HsLua.Packaging.Documentation
import HsLua.Packaging.Types
import qualified HsLua.Packaging.Function as Fun

-- | Create a new module (i.e., a Lua table).
create :: LuaE e ()
create :: forall e. LuaE e ()
create = 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 :: forall e. LuaError e => Module e -> LuaE e ()
registerModule Module e
mdl =
  forall e. LuaError e => Name -> (Name -> LuaE e ()) -> LuaE e ()
requirehs (forall e. Module e -> Name
moduleName Module e
mdl) (forall a b. a -> b -> a
const (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 :: forall e. LuaError e => Module e -> Name -> LuaE e ()
preloadModuleWithName Module e
documentedModule Name
name = forall e. LuaError e => Module e -> LuaE e ()
preloadModule 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 :: forall e. LuaError e => Module e -> LuaE e ()
preloadModule Module e
mdl =
  forall e. LuaError e => Name -> LuaE e NumResults -> LuaE e ()
preloadhs (forall e. Module e -> Name
moduleName Module e
mdl) forall a b. (a -> b) -> a -> b
$ do
    forall e. LuaError e => Module e -> LuaE e ()
pushModule Module e
mdl
    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 :: forall e. LuaError e => Module e -> LuaE e ()
pushModule Module e
mdl = do
  forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
10 String
"pushModule"
  forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
    [ (Name
"name", forall e. Name -> LuaE e ()
pushName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Module e -> Name
moduleName)
    , (Name
"description", forall e. Pusher e Text
pushText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Module e -> Text
moduleDescription)
    , (Name
"fields", forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList forall e. LuaError e => Pusher e (Field e)
pushFieldDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Module e -> [Field e]
moduleFields)
    , (Name
"types", forall e. LuaError e => Pusher e [LuaE e Name]
pushTypesFunction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Module e -> [LuaE e Name]
moduleTypeInitializers)
    ] Module e
mdl
  forall e. LuaE e ()
create        -- module table
  forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2)              -- push documentation object
  forall e. LuaError e => StackIndex -> LuaE e ()
registerDocumentation (CInt -> StackIndex
nth CInt
2)  -- set and pop doc

  -- # Functions
  --
  -- module table now on top
  -- documentation table in pos 2
  forall e. LuaE e ()
newtable -- function documention
  forall e. Name -> LuaE e ()
pushName Name
"functions"
  forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2)
  forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
5)
  -- function documentation table now on top
  -- module table in position 2
  -- module documentation table in pos 3
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] (forall e. Module e -> [DocumentedFunction e]
moduleFunctions Module e
mdl)) forall a b. (a -> b) -> a -> b
$ \(Integer
i, DocumentedFunction e
fn) -> do
    -- push documented function, thereby registering the function docs
    forall e. LuaError e => DocumentedFunction e -> LuaE e ()
Fun.pushDocumentedFunction DocumentedFunction e
fn
    -- add function to module
    forall e. Name -> LuaE e ()
pushName (forall e. DocumentedFunction e -> Name
functionName DocumentedFunction e
fn)
    forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2) -- C function
    forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
5)    -- module table
    -- set documentation
    Type
_ <- forall e. LuaError e => StackIndex -> LuaE e Type
getdocumentation StackIndex
top
    forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawseti (CInt -> StackIndex
nth CInt
3) Integer
i
    forall e. Int -> LuaE e ()
pop Int
1 -- C Function
  forall e. Int -> LuaE e ()
pop Int
1 -- function documentation table
  forall e. StackIndex -> LuaE e ()
remove (CInt -> StackIndex
nth CInt
2) -- module documentation table

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

pushTypesFunction :: LuaError e => Pusher e [LuaE e Name]
pushTypesFunction :: forall e. LuaError e => Pusher e [LuaE e Name]
pushTypesFunction [LuaE e Name]
initializers = forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction forall a b. (a -> b) -> a -> b
$ do
  forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [LuaE e Name]
initializers forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList forall e. Name -> LuaE e ()
pushName
  forall (f :: * -> *) a. Applicative f => a -> f a
pure NumResults
1