{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : HsLua.Packaging.Module
Copyright   : © 2019-2026 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 (..)
  , ModuleDoc (..)
  , Field (..)
    -- * Constructors
    -- ** Module
  , defmodule
  , withFields
  , withFunctions
  , withOperations
  , associateType
  , renameTo
    -- ** Field
  , deffield
  , withType
  , withDescription
  , withValue
    -- ** Type Classes
  , HasName (..)
  , HasDescription (..)
    -- * Module Loading
  , registerModule
  , preloadModule
  , preloadModuleWithName
  , pushModule
  , Operation (..)
  )
where

import Control.Monad (forM_)
import Data.Text (Text)
import HsLua.Core
import HsLua.Marshalling (pushName)
import HsLua.ObjectOrientation.Operation (Operation (..), metamethodName)
import HsLua.Packaging.Documentation
import HsLua.Packaging.Types
import HsLua.Packaging.UDType (initType)
import HsLua.Typing (TypeSpec, anyType)
import qualified HsLua.Core.Utf8 as Utf8
import qualified HsLua.Packaging.Function as Fun

-- | Define a Lua module.
defmodule :: Name -> Module e
defmodule :: forall e. Name -> Module e
defmodule Name
name = Module
  { moduleName :: Name
moduleName = Name
name
  , moduleDescription :: Text
moduleDescription = Text
forall a. Monoid a => a
mempty
  , moduleFields :: [Field e]
moduleFields = [Field e]
forall a. Monoid a => a
mempty
  , moduleFunctions :: [DocumentedFunction e]
moduleFunctions = [DocumentedFunction e]
forall a. Monoid a => a
mempty
  , moduleOperations :: [(Operation, DocumentedFunction e)]
moduleOperations = [(Operation, DocumentedFunction e)]
forall a. Monoid a => a
mempty
  , moduleTypeDocs :: [TypeDoc]
moduleTypeDocs = [TypeDoc]
forall a. Monoid a => a
mempty
  , moduleTypeInitializers :: [LuaE e Name]
moduleTypeInitializers = [LuaE e Name]
forall a. Monoid a => a
mempty
  }

-- | Set the list of module fields.
withFields :: Module e -> [Field e] -> Module e
withFields :: forall e. Module e -> [Field e] -> Module e
withFields Module e
mdl [Field e]
fields = Module e
mdl { moduleFields = fields }

-- | Set the list of functions in the module.
withFunctions :: Module e -> [DocumentedFunction e] -> Module e
withFunctions :: forall e. Module e -> [DocumentedFunction e] -> Module e
withFunctions Module e
mdl [DocumentedFunction e]
fns =
  let addPrefix :: DocumentedFunction e -> DocumentedFunction e
addPrefix DocumentedFunction e
fn =
        let doc :: FunctionDoc
doc = DocumentedFunction e -> FunctionDoc
forall e. DocumentedFunction e -> FunctionDoc
functionDoc DocumentedFunction e
fn
            prefixed :: Text
prefixed = ByteString -> Text
Utf8.toText (Name -> ByteString
fromName (Name -> ByteString) -> Name -> ByteString
forall a b. (a -> b) -> a -> b
$ Module e -> Name
forall a. HasName a => a -> Name
getName Module e
mdl) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                       FunctionDoc -> Text
funDocName FunctionDoc
doc
        in DocumentedFunction e
fn { functionDoc = doc { funDocName = prefixed } }
  in Module e
mdl { moduleFunctions = map addPrefix fns }

-- | Set operations that can be performed on the module object.
withOperations :: Module e -> [(Operation, DocumentedFunction e)] -> Module e
withOperations :: forall e.
Module e -> [(Operation, DocumentedFunction e)] -> Module e
withOperations Module e
mdl [(Operation, DocumentedFunction e)]
ops = Module e
mdl { moduleOperations = ops }

-- | Sets a textual description
withDescription :: HasDescription a => a -> Text -> a
withDescription :: forall a. HasDescription a => a -> Text -> a
withDescription = a -> Text -> a
forall a. HasDescription a => a -> Text -> a
setDescription

-- | Associate a type with this module. An associated type is listed in the
-- module documentation.
associateType :: LuaError e => Module e -> DocumentedType e a -> Module e
associateType :: forall e a.
LuaError e =>
Module e -> DocumentedType e a -> Module e
associateType Module e
mdl DocumentedType e a
tp = Module e
mdl
  { moduleTypeInitializers = initType tp : moduleTypeInitializers mdl
  , moduleTypeDocs = generateTypeDocumentation tp : moduleTypeDocs mdl
  }

-- | Gives a different name
renameTo :: HasName a => a -> Name -> a
renameTo :: forall a. HasName a => a -> Name -> a
renameTo = a -> Name -> a
forall a. HasName a => a -> Name -> a
setName

infixl 0 `withFields`, `withFunctions`, `withDescription`, `withOperations`
infixl 0 `associateType`

--
-- Field constructor and setters
--

-- | Create a new module field.
deffield :: Name -> Field e
deffield :: forall e. Name -> Field e
deffield Name
name = Field
  { fieldName :: Name
fieldName = Name
name
  , fieldPushValue :: LuaE e ()
fieldPushValue = () -> LuaE e ()
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  , fieldDoc :: FieldDoc
fieldDoc = FieldDoc
      { fieldDocName :: Text
fieldDocName = ByteString -> Text
Utf8.toText (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Name -> ByteString
fromName Name
name
      , fieldDocType :: TypeSpec
fieldDocType = TypeSpec
anyType
      , fieldDocDescription :: Text
fieldDocDescription = Text
forall a. Monoid a => a
mempty
      }
  }

-- | Set a specific type for a field.
withType :: Field e -> TypeSpec -> Field e
withType :: forall e. Field e -> TypeSpec -> Field e
withType Field e
fld TypeSpec
typespec =
  let doc :: FieldDoc
doc = Field e -> FieldDoc
forall e. Field e -> FieldDoc
fieldDoc Field e
fld
  in Field e
fld { fieldDoc = doc { fieldDocType = typespec }}

-- | Add a value pusher to a field.
withValue :: Field e -> LuaE e () -> Field e
withValue :: forall e. Field e -> LuaE e () -> Field e
withValue Field e
fld LuaE e ()
pusher = Field e
fld { fieldPushValue = pusher }

infixl 0 `withType`, `withValue`

-- | Create a new module (i.e., a Lua table).
create :: LuaE e ()
create :: forall e. 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 :: forall e. LuaError e => 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 :: forall e. LuaError e => 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 }

-- | 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 =
  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 a. a -> LuaE e a
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
  Int -> String -> LuaE e ()
forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
10 String
"pushModule"
  LuaE e ()
forall e. LuaE e ()
create        -- module table
  Pusher e ModuleDoc
forall e. LuaError e => Pusher e ModuleDoc
pushModuleDoc (Module e -> ModuleDoc
forall e. Module e -> ModuleDoc
generateModuleDocumentation Module e
mdl)
  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
  [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
    -- 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)
    -- 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
    StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)    -- module table

  -- # Fields
  --
  [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
fld -> do
    Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName (Field e -> Name
forall e. Field e -> Name
fieldName Field e
fld)
    Field e -> LuaE e ()
forall e. Field e -> LuaE e ()
fieldPushValue Field e
fld
    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 a. a -> LuaE e a
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
$ DocumentedFunction e
fn DocumentedFunction e -> Name -> DocumentedFunction e
forall a. HasName a => a -> Name -> a
`setName` Name
""
        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)