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

import Control.Monad (forM_)
import HsLua.Core
import HsLua.Marshalling (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 :: 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 -> (Name -> LuaE e ()) -> LuaE e ()
forall e. LuaError e => Name -> (Name -> LuaE e ()) -> LuaE e ()
requirehs (Module e -> Name
forall e. Module e -> Name
moduleName Module e
mdl) (LuaE e () -> Name -> LuaE e ()
forall a b. a -> b -> a
const (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
  Int -> String -> LuaE e ()
forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
10 String
"pushModule"
  [(Name, Module e -> LuaE e ())] -> Module e -> LuaE e ()
forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
    [ (Name
"name", Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName (Name -> LuaE e ()) -> (Module e -> Name) -> Module e -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module e -> Name
forall e. Module e -> Name
moduleName)
    , (Name
"description", Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text -> (Module e -> Text) -> Module e -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module e -> Text
forall e. Module e -> Text
moduleDescription)
    , (Name
"fields", Pusher e (Field e) -> [Field e] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e (Field e)
forall e. LuaError e => Pusher e (Field e)
pushFieldDoc ([Field e] -> LuaE e ())
-> (Module e -> [Field e]) -> Module e -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module e -> [Field e]
forall e. Module e -> [Field e]
moduleFields)
    ] Module e
mdl
  LuaE e ()
forall e. LuaE e ()
create        -- module table
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2)              -- push documentation object
  StackIndex -> LuaE e ()
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
  LuaE e ()
forall e. LuaE e ()
newtable -- function documention
  Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName Name
"functions"
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2)
  StackIndex -> LuaE e ()
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
  [(Integer, DocumentedFunction e)]
-> ((Integer, DocumentedFunction e) -> LuaE e ()) -> LuaE e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Integer]
-> [DocumentedFunction e] -> [(Integer, DocumentedFunction e)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] (Module e -> [DocumentedFunction e]
forall e. Module e -> [DocumentedFunction e]
moduleFunctions Module e
mdl)) (((Integer, DocumentedFunction e) -> LuaE e ()) -> LuaE e ())
-> ((Integer, DocumentedFunction e) -> LuaE e ()) -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ \(Integer
i, DocumentedFunction e
fn) -> do
    -- push documented function, thereby registering the function docs
    DocumentedFunction e -> LuaE e ()
forall e. LuaError e => DocumentedFunction e -> LuaE e ()
Fun.pushDocumentedFunction DocumentedFunction e
fn
    -- add function to module
    Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName (DocumentedFunction e -> Name
forall e. DocumentedFunction e -> Name
functionName DocumentedFunction e
fn)
    StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2) -- C function
    StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
5)    -- module table
    -- set documentation
    Type
_ <- StackIndex -> LuaE e Type
forall e. LuaError e => StackIndex -> LuaE e Type
getdocumentation StackIndex
top
    StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawseti (CInt -> StackIndex
nth CInt
3) Integer
i
    Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1 -- C Function
  Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1 -- function documentation table
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
remove (CInt -> StackIndex
nth CInt
2) -- module documentation table

  -- # Fields
  --
  [Field e] -> Pusher e (Field 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) (Pusher e (Field e) -> LuaE e ())
-> Pusher e (Field 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)
    Pusher e (Field 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 ()
Fun.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
Fun.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)