hslua-packaging-2.4.1/0000755000000000000000000000000007346545000012745 5ustar0000000000000000hslua-packaging-2.4.1/CHANGELOG.md0000644000000000000000000001253507346545000014564 0ustar0000000000000000# Changelog `hslua-packaging` uses [PVP Versioning][]. ## hslua-packaging-2.4.1 Released 2026-01-13. - Modified Lua documentation objects: calling the userdata objects now returns a table with all the info from the documentation object. ## hslua-packaging-2.4.0 Released 2026-01-08. - Modified the *FunctionDoc* type: added the function name to the type and changed field names to be more consistent. - Added function `peekFunctionDoc` to retrieve function documentation from the Lua stack. - Added a new data type `FieldDoc` that contains all the documentation for a module field. The `Field` type was modified to use this type for docs. - Fields and modules should no longer use the data type constructor directly. Instead, values should be created through the newly introduced functions `deffield`, `withName`, `withValue`, and `withDescription` for fields, and `defmodule`, `withFields`, `withFunctions`, `withOperations`, `withDescription`, and `associateType` for modules. - The module *HsLua.Typing* is re-exported from *HsLua.Packaging*. - Modules have an additional field `moduleTypeDocs`. - Require *hslua-objectorientation* 2.5.0. - Allow *hslua-typing* 0.2.\*. ## hslua-packaging-2.3.2 Released 2025-06-23. - Require hslua-objectorientation-2.4. ## hslua-packaging-2.3.1 Released 2024-01-18. - Relaxed upper bound for text and containers, allowing text-2.1, and containers-0.7. ## hslua-packaging-2.3.0 Released 2023-03-13. - Type initializers as part of Module records. This allows to associate types with a module. For performance reasons, the types are not initialized when the module is pushed, but only on first use. However, the documentation Lua object for each module now has an additional field `types`. The new field contains a function that returns the names of all associated types. Calling the function will also initialize these types, thereby making the respective metatables available in the registry. - *Field* records now have an additional `fieldType` entry. \[API change\] - The `pushUD` function is now specialized to documented types. - Export `initType`. The function ensures that the metatable of a type has been fully initialized. This can be helpful when the default method of lazy initialization is not desired, e.g. when the type object is to be inspected or extended. - Re-export `udDocs`, `udTypeSpec`, allowing to generate typing info for userdata classes. ## hslua-packaging-2.2.1 Release 2022-06-19. - Require hslua-core-2.2.1. - Require hslua-marshalling-2.2.1. - Require hslua-objectorientation-2.2.1. ## hslua-packaging-2.2.0.1 Released 2022-05-20. - Relax upper bound for mtl, allow mtl-2.3. ## hslua-packaging-2.2.0 Released 2022-02-19. - Require versions 2.2 for hslua-core, hslua-marshalling, hslua-objectorientation. ## hslua-packaging-2.1.0 Released 2022-01-29. - Added function `documentation`: The documented function `documentation` is added and exported from module `HsLua.Packaging.Documentation`. It allows to retrieve the documentation of a given Lua object. This replaces `pushDocumentationFunction`, which was removed. - Cleanup of Function module: - `docsField` was moved to module Documentation. - `pushDocumentation` is renamed to `getdocumentation` and moved to the Documentation module. It now returns the Lua type of the retrieved documentation value. - Function `registerDocumentation` was changed: the documentation is no longer passed in but must be at the top of the stack. - New functions `pushModuleDoc`, and `pushFunctionDoc`, pushing structured documentation objects for models and functions, respectively. - Provide function `opt` to make a parameter optional. The function `optionalParameter` is deprecated, use `opt (parameter ...)` instead. - Added function `udresult`; it defines a function result and is analogous to the existing `udparam` function. - Added module `Convenience`, which defines many functions to make the definition of parameters and results easier for the most common types. - Pushing a documented module now also registers the module's documentation. - The module HsLua.Packaging.Rendering has been deprecated. It is no longer exported as part of HsLua.Packaging and must be imported explicitly if needed. It may be removed in the future. Use Lua objects retrievable with `getdocumentation` together with a custom renderer instead. - Update to hslua-objectorientation-2.1.0. Lists are now writable. This entails a change to `deftype'`. See the changelog of hslua-objectorientation for details. - Update to hslua-core 2.1.0 and hslua-marshalling 2.1.0. ## hslua-packaging-2.0.0 Released 2021-10-21. - Initially created. Contains modules previously found in the modules `Foreign.Lua.Call` and `Foreign.Lua.Module` from `hslua-1.3`. - Moved module hierarchy from Foreign.Lua to HsLua. - Added support for a “since” tag on documented functions; allows to mark the library version when a function was introduced in its present form. - Improved syntax for the creation of documented functions. - Documentation for functions is now stored in Lua; a method to access it is available as a HaskellFunction. [PVP Versioning]: https://pvp.haskell.org hslua-packaging-2.4.1/LICENSE0000644000000000000000000000205007346545000013747 0ustar0000000000000000Copyright © 2019-2026 Albert Krewinkel Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. hslua-packaging-2.4.1/README.md0000644000000000000000000000462607346545000014234 0ustar0000000000000000# hslua-packaging [![Build status][GitHub Actions badge]][GitHub Actions] [![AppVeyor Status]](https://ci.appveyor.com/project/tarleb/hslua-r2y18) [![Hackage]](https://hackage.haskell.org/package/hslua-packaging) Utilities to package up Haskell functions and values into a Lua module. [GitHub Actions badge]: https://img.shields.io/github/workflow/status/hslua/hslua/CI.svg?logo=github [GitHub Actions]: https://github.com/hslua/hslua/actions [AppVeyor Status]: https://ci.appveyor.com/api/projects/status/ldutrilgxhpcau94/branch/main?svg=true [Hackage]: https://img.shields.io/hackage/v/hslua-packaging.svg This package is part of [HsLua], a Haskell framework built around the embeddable scripting language [Lua]. [HsLua]: https://hslua.org/ [Lua]: https://lua.org/ ## Functions It is rarely enough to just expose Haskell functions to Lua, they must also be documented. This library allows to combine both into one step, as one would do in source files. Functions can be exposed to Lua if they follow the type a_0 -> a_1 -> ... -> a_n -> LuaE e b where each a~i~, 0 ≤ i ≤ n can be retrieved from the Lua stack. Let's look at an example: we want to expose the *factorial* function, making use of Haskell's arbitrary size integers. Below is how we would document and expose it to Lua. ``` haskell -- | Calculate the factorial of a number. factorial :: DocumentedFunction Lua.Exception factorial = defun "factorial" ### liftPure (\n -> product [1..n]) <#> n =#> productOfNumbers #? "Calculates the factorial of a positive integer." `since` makeVersion [1,0,0] where n :: Parameter Lua.Exception Integer n = parameter peekIntegral "integer" "n" "number for which the factorial is computed" productOfNumbers :: FunctionResults Lua.Exception Integer productOfNumbers = functionResult pushIntegral "integer" "produce of all numbers from 1 upto n" ``` This produces a value which can be pushed to Lua as a function ``` haskell pushDocumentedFunction factorial setglobal "factorial" ``` and can then be called from Lua ``` lua > factorial(4) 24 > factorial(23) "25852016738884976640000" ``` The documentation can be rendered as Markdown with `renderFunction`: ``` factorial (n) Calculates the factorial of a positive integer. *Since: 1.0.0* Parameters: n : number for which the factorial is computed (integer) Returns: - product of all integers from 1 upto n (integer) ``` hslua-packaging-2.4.1/hslua-packaging.cabal0000644000000000000000000000670507346545000016777 0ustar0000000000000000cabal-version: 2.2 name: hslua-packaging version: 2.4.1 synopsis: Utilities to build Lua modules. description: Utilities to package up Haskell functions and values into a Lua module. . This package is part of HsLua, a Haskell framework built around the embeddable scripting language . homepage: https://hslua.org/ bug-reports: https://github.com/hslua/hslua/issues license: MIT license-file: LICENSE author: Albert Krewinkel maintainer: tarleb@hslua.org copyright: © 2019-2026 Albert Krewinkel category: Foreign extra-source-files: README.md , CHANGELOG.md tested-with: GHC == 9.6 , GHC == 9.8 , GHC == 9.10 , GHC == 9.12 source-repository head type: git location: https://github.com/hslua/hslua.git subdir: hslua-packaging common common-options default-language: Haskell2010 build-depends: base >= 4.11 && < 5 , hslua-core >= 2.2.1 && < 2.4 , hslua-marshalling >= 2.2.1 && < 2.4 ghc-options: -Wall -Wcpp-undef -Werror=missing-home-modules -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances -Wpartial-fields -Wredundant-constraints -fhide-source-paths if impl(ghc >= 8.10) ghc-options: -Wunused-packages if impl(ghc >= 9.0) ghc-options: -Winvalid-haddock library import: common-options exposed-modules: HsLua.Packaging , HsLua.Packaging.Convenience , HsLua.Packaging.Documentation , HsLua.Packaging.Function , HsLua.Packaging.Module , HsLua.Packaging.Types , HsLua.Packaging.UDType hs-source-dirs: src default-extensions: LambdaCase , StrictData other-extensions: DeriveFunctor , OverloadedStrings build-depends: containers >= 0.5.9 && < 0.9 , hslua-objectorientation >= 2.5 && < 2.6 , hslua-typing >= 0.1 && < 0.3 , text >= 1.2 && < 2.2 test-suite test-hslua-packaging import: common-options type: exitcode-stdio-1.0 main-is: test-hslua-packaging.hs hs-source-dirs: test ghc-options: -threaded other-modules: HsLua.PackagingTests , HsLua.Packaging.DocumentationTests , HsLua.Packaging.FunctionTests , HsLua.Packaging.ModuleTests , HsLua.Packaging.UDTypeTests build-depends: hslua-packaging , bytestring , tasty-hslua , tasty >= 0.11 , tasty-hunit >= 0.9 other-extensions: OverloadedStrings , TypeApplications hslua-packaging-2.4.1/src/HsLua/0000755000000000000000000000000007346545000014550 5ustar0000000000000000hslua-packaging-2.4.1/src/HsLua/Packaging.hs0000644000000000000000000000144207346545000016771 0ustar0000000000000000{-| Module : HsLua.Packaging Copyright : © 2019-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Tools to create documented Lua functions and modules. -} module HsLua.Packaging ( -- * Modules module HsLua.Packaging.Module , module HsLua.Packaging.Function , module HsLua.Packaging.Convenience -- * Object oriented marshalling , module HsLua.Packaging.UDType -- * Register and access docs in Lua , module HsLua.Packaging.Documentation -- * Types , module HsLua.Packaging.Types , module HsLua.Typing ) where import HsLua.Packaging.Convenience import HsLua.Packaging.Documentation import HsLua.Packaging.Function import HsLua.Packaging.Module import HsLua.Packaging.UDType import HsLua.Packaging.Types import HsLua.Typing hslua-packaging-2.4.1/src/HsLua/Packaging/0000755000000000000000000000000007346545000016434 5ustar0000000000000000hslua-packaging-2.4.1/src/HsLua/Packaging/Convenience.hs0000644000000000000000000000436707346545000021236 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.Convenience Copyright : © 2021-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Convenience functions for common parameter and result types. -} module HsLua.Packaging.Convenience where import Data.Text (Text) import HsLua.Marshalling import HsLua.Packaging.Function -- * Parameters -- | Defines a function parameter of type 'Bool'. boolParam :: Text -- ^ parameter name -> Text -- ^ parameter description -> Parameter e Bool boolParam = parameter peekBool "boolean" {-# INLINE boolParam #-} -- | Defines a function parameter for an integral type. integralParam :: (Read a, Integral a) => Text -- ^ parameter name -> Text -- ^ parameter description -> Parameter e a integralParam = parameter peekIntegral "integer" {-# INLINE integralParam #-} -- | Defines a function parameter of type 'String'. stringParam :: Text -- ^ parameter name -> Text -- ^ parameter description -> Parameter e String stringParam = parameter peekString "string" {-# INLINE stringParam #-} -- | Defines a function parameter of type 'Text'. textParam :: Text -- ^ parameter name -> Text -- ^ parameter description -> Parameter e Text textParam = parameter peekText "string" {-# INLINE textParam #-} -- * Results -- | Defines a function result of type 'Bool'. boolResult :: Text -- ^ result description -> FunctionResults e Bool boolResult = functionResult pushBool "boolean" {-# INLINE boolResult #-} -- | Defines a function result for an integral type. integralResult :: (Integral a, Show a) => Text -- ^ result description -> FunctionResults e a integralResult = functionResult pushIntegral "integer|string" {-# INLINE integralResult #-} -- | Defines a function result of type 'Text'. stringResult :: Text -- ^ result description -> FunctionResults e String stringResult = functionResult pushString "string" {-# INLINE stringResult #-} -- | Defines a function result of type 'Text'. textResult :: Text -- ^ result description -> FunctionResults e Text textResult = functionResult pushText "string" {-# INLINE textResult #-} hslua-packaging-2.4.1/src/HsLua/Packaging/Documentation.hs0000644000000000000000000002450007346545000021602 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.Documentation Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Provides a function to print documentation if available. -} module HsLua.Packaging.Documentation ( -- * Setting and retrieving documentation getdocumentation , registerDocumentation , docsField -- * Documentation Types , ModuleDoc (..) , FunctionDoc (..) , DocumentationObject (..) , pushDocumentationObject , peekDocumentationObject , pushModuleDoc , peekModuleDoc , pushFunctionDoc , peekFunctionDoc , pushTypeDoc , peekTypeDoc -- * Creating documentation values , generateFunctionDocumentation , generateModuleDocumentation , generateTypeDocumentation ) where import Data.Version (showVersion) import HsLua.Core as Lua import HsLua.Marshalling import HsLua.ObjectOrientation (UDTypeGeneric (..)) import HsLua.Packaging.Types import HsLua.Typing (pushTypeSpec) import qualified Data.Map.Strict as Map import qualified Data.Text as T import qualified HsLua.Core.Utf8 as Utf8 -- | Pushes the documentation for the element at the given stack index. -- Returns the type of the documentation object. getdocumentation :: LuaError e => StackIndex -> LuaE e Lua.Type getdocumentation idx = do idx' <- absindex idx pushDocumentationTable pushvalue idx' rawget (nth 2) <* Lua.remove (nth 2) -- remove documentation table -- | Registers the object at the top of the stack as documentation for -- the object at index @idx@. Pops the documentation of the stack. registerDocumentation :: LuaError e => StackIndex -- ^ @idx@ -> LuaE e () registerDocumentation idx = do checkstack' 10 "registerDocumentation" -- keep some buffer idx' <- absindex idx pushDocumentationTable pushvalue idx' -- the documented object pushvalue (nth 3) -- documentation object rawset (nth 3) -- add to docs table pop 2 -- docs table and documentation object -- | Name of the registry field holding the documentation table. The -- documentation table is indexed by the documented objects, like module -- tables and functions, and contains documentation objects as values. -- -- The table is an ephemeron table, i.e., an entry gets garbage -- collected if the key is no longer reachable. docsField :: Name docsField = "HsLua docs" -- | Pushes the documentation table that's stored in the registry to the -- top of the stack, creating it if necessary. The documentation table -- is indexed by the documented objects, like module tables and -- functions, and contains documentation strings as values. -- -- The table is an ephemeron table, i.e., an entry gets garbage -- collected if the key is no longer reachable. pushDocumentationTable :: LuaError e => LuaE e () pushDocumentationTable = Lua.getfield registryindex docsField >>= \case Lua.TypeTable -> return () -- documentation table already initialized _ -> do pop 1 -- pop non-table value newtable -- create documentation table pushstring "k" -- Make it an "ephemeron table" and.. setfield (nth 2) "__mode" -- collect docs if documented object is GCed pushvalue top -- add copy of table to registry setfield registryindex docsField -- -- Generating -- -- | Generate documentation for a module. generateModuleDocumentation :: Module e -> ModuleDoc generateModuleDocumentation mdl = let name = moduleName mdl in ModuleDoc { moduleDocName = nameToText name , moduleDocDescription = moduleDescription mdl , moduleDocFields = map (generateFieldDocumentation name) $ moduleFields mdl , moduleDocFunctions = map (generateFunctionDocumentation Nothing) $ moduleFunctions mdl , moduleDocTypes = moduleTypeDocs mdl } -- | Generate 'FieldDoc' documentation for a module field. generateFieldDocumentation :: Name -- ^ module name -> Field e -- ^ field that's part of the module -> FieldDoc generateFieldDocumentation mdlName fld = let doc = fieldDoc fld in doc { fieldDocName = nameToText mdlName <> "." <> fieldDocName doc } -- | Generate 'FunctionDoc' documentation for module functions. generateFunctionDocumentation :: Maybe Name -> DocumentedFunction e -> FunctionDoc generateFunctionDocumentation name fn = let doc = functionDoc fn prefix = maybe mempty (\n -> nameToText n <> ".") name in doc { funDocName = prefix <> funDocName doc } -- | Generate documentation for a 'UDType'. generateTypeDocumentation :: DocumentedType e a -> TypeDoc generateTypeDocumentation ty = let name = udName ty in TypeDoc { typeDocName = nameToText name , typeDocDescription = "" , typeDocOperations = [] , typeDocMethods = map (generateFunctionDocumentation (Just name) . snd) $ Map.toList (udMethods ty) } -- | Convert a Lua name to UTF-8 text. nameToText :: Name -> T.Text nameToText = Utf8.toText . fromName -- -- Retrieving and pushing documentation -- -- | The metatable name of documentation objecs documentationObjectName :: Name documentationObjectName = "HsLua DocumentationObject" -- | Pushes the metatable for documentation objects. peekDocumentationObject :: Peeker e DocumentationObject peekDocumentationObject idx = do liftLua (fromuserdata idx documentationObjectName) >>= \case Nothing -> failPeek "Not a documentation object" Just doc -> pure doc -- | Pushes a 'DocumentationObject' to the Lua stack. pushDocumentationObject :: LuaError e => Pusher e DocumentationObject pushDocumentationObject obj = do newhsuserdatauv obj 0 pushDocumentationObjectMT setmetatable (nth 2) -- | Pushes the metatable for documentation objects. pushDocumentationObjectMT :: LuaError e => LuaE e () pushDocumentationObjectMT = newudmetatable documentationObjectName >>= \case False -> return () True -> do -- newly created metatable at the top of the stack -- Allow to "call" the documentation object, in which case it should -- return a Lua table that has all the relevant info. pushHaskellFunction $ do -- object is the first argument forcePeek (peekDocumentationObject (nthBottom 1)) >>= \case DocObjectFunction fn -> pushFunctionDocAsTable fn DocObjectModule mdl -> pushModuleDocAsTable mdl DocObjectType ty -> pushTypeDocAsTable ty return (NumResults 1) setfield (nth 2) "__call" -- | Pushes the documentation of a module as userdata. pushModuleDoc :: LuaError e => Pusher e ModuleDoc pushModuleDoc = pushDocumentationObject . DocObjectModule -- | Retrieves a module documentation object from the Lua stack. peekModuleDoc :: Peeker e ModuleDoc peekModuleDoc idx = peekDocumentationObject idx >>= \case DocObjectModule mdldoc -> pure mdldoc _ -> failPeek "Not a module documentation object" -- | Pushes function documentation as userdata. pushFunctionDoc :: LuaError e => Pusher e FunctionDoc pushFunctionDoc = pushDocumentationObject . DocObjectFunction -- | Retrieve function documentation from the Lua stack. peekFunctionDoc :: Peeker e FunctionDoc peekFunctionDoc idx = peekDocumentationObject idx >>= \case DocObjectFunction fndoc -> pure fndoc _ -> failPeek "Not a function documentation" -- | Pushes documentation type documentation as userdata. pushTypeDoc :: LuaError e => Pusher e FunctionDoc pushTypeDoc = pushDocumentationObject . DocObjectFunction -- | Retrieve function documentation from the Lua stack. peekTypeDoc :: Peeker e TypeDoc peekTypeDoc idx = peekDocumentationObject idx >>= \case DocObjectType tydoc -> pure tydoc _ -> failPeek "Not a type documentation" -- | Pushes the documentation of a module as a table with string fields -- @name@ and @description@. pushModuleDocAsTable :: LuaError e => Pusher e ModuleDoc pushModuleDocAsTable = pushAsTable [ ("name", pushText . moduleDocName) , ("description", pushText . moduleDocDescription) , ("fields", pushList pushFieldDocAsTable . moduleDocFields) , ("functions", pushList pushFunctionDocAsTable . moduleDocFunctions) , ("types", pushList pushTypeDocAsTable . moduleDocTypes) ] -- | Pushes the documentation of a field as a table with string fields -- @name@ and @description@. pushFieldDocAsTable :: LuaError e => Pusher e FieldDoc pushFieldDocAsTable = pushAsTable [ ("name", pushText . fieldDocName) , ("type", pushTypeSpec . fieldDocType) , ("description", pushText . fieldDocDescription) ] -- | Pushes the documentation of a function as a table with string -- fields, @name@, @description@, and @since@, sequence field -- @parameters@, and sequence or string field @results@. pushFunctionDocAsTable :: LuaError e => Pusher e FunctionDoc pushFunctionDocAsTable = pushAsTable [ ("name", pushText . funDocName) , ("description", pushText . funDocDescription) , ("parameters", pushList pushParameterDocAsTable . funDocParameters) , ("results", pushResultsDoc . funDocResults) , ("since", maybe pushnil (pushString . showVersion) . funDocSince) ] -- | Pushes the documentation of a parameter as a table with boolean -- field @optional@ and string fields @name@, @type@, and @description@. pushParameterDocAsTable :: LuaError e => Pusher e ParameterDoc pushParameterDocAsTable = pushAsTable [ ("name", pushText . parameterName) , ("type", pushTypeSpec . parameterType) , ("description", pushText . parameterDescription) , ("optional", pushBool . parameterIsOptional) ] -- | Pushes a the documentation for a function's return values as either -- a simple string, or as a sequence of tables with @type@ and -- @description@ fields. pushResultsDoc :: LuaError e => Pusher e ResultsDoc pushResultsDoc = \case ResultsDocMult desc -> pushText desc ResultsDocList resultDocs -> pushList pushResultValueDoc resultDocs -- | Pushes the documentation of a single result value as a table with -- fields @type@ and @description@. pushResultValueDoc :: LuaError e => Pusher e ResultValueDoc pushResultValueDoc = pushAsTable [ ("type", pushTypeSpec . resultValueType) , ("description", pushText . resultValueDescription) ] -- | Pushes the documentation of a UDType as a Lua table. pushTypeDocAsTable :: LuaError e => Pusher e TypeDoc pushTypeDocAsTable = pushAsTable [ ("name", pushText . typeDocName) , ("description", pushText . typeDocDescription) , ("methods", pushList pushFunctionDoc . typeDocMethods) ] hslua-packaging-2.4.1/src/HsLua/Packaging/Function.hs0000644000000000000000000002475607346545000020573 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.Function Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : Portable Marshaling and documenting Haskell functions. -} module HsLua.Packaging.Function ( DocumentedFunction (..) -- * Creating documented functions , defun , lambda , applyParameter , returnResult , returnResults , returnResultsOnStack , updateFunctionDescription , liftPure , liftPure2 , liftPure3 , liftPure4 , liftPure5 -- ** Types , Parameter (..) , FunctionResult (..) , FunctionResults -- ** Operators , (###) , (<#>) , (=#>) , (=?>) , (#?) -- * Modifying functions , since -- * Pushing to Lua , pushDocumentedFunction -- * Convenience functions , parameter , opt , optionalParameter , functionResult -- * Internal , HsFnPrecursor , toHsFnPrecursor ) where import Control.Applicative ((<|>)) import Control.Monad ((<$!>), forM_) import Data.Text (Text) import Data.Version (Version) import HsLua.Core import HsLua.Marshalling import HsLua.Packaging.Documentation import HsLua.Packaging.Types import HsLua.Typing (TypeSpec) import qualified HsLua.Core as Lua import qualified HsLua.Core.Utf8 as Utf8 -- -- Haskell function building -- -- | Helper type used to create 'HaskellFunction's. data HsFnPrecursor e a = HsFnPrecursor { hsFnPrecursorAction :: Peek e a , hsFnMaxParameterIdx :: StackIndex , hsFnParameterDocs :: [ParameterDoc] , hsFnName :: Name } deriving (Functor) -- | Result of a call to a Haskell function. data FunctionResult e a = FunctionResult { fnResultPusher :: Pusher e a , fnResultDoc :: ResultValueDoc } -- | List of function results in the order in which they are -- returned in Lua. type FunctionResults e a = [FunctionResult e a] -- | Function parameter. data Parameter e a = Parameter { parameterPeeker :: Peeker e a , parameterDoc :: ParameterDoc } -- | Begin wrapping a monadic Lua function such that it can be turned -- into a documented function exposable to Lua. defun :: Name -> a -> HsFnPrecursor e a defun = toHsFnPrecursor (StackIndex 0) -- | Just like @defun@, but uses an empty name for the documented -- function. Should be used when defining methods or operators. lambda :: a -> HsFnPrecursor e a lambda = defun (Name mempty) -- | Turns a pure function into a monadic Lua function. -- -- The resulting function is strict. liftPure :: (a -> b) -> (a -> LuaE e b) liftPure f !a = return $! f a -- | Turns a binary function into a Lua function. -- -- The resulting function is strict in both its arguments. liftPure2 :: (a -> b -> c) -> (a -> b -> LuaE e c) liftPure2 f !a !b = return $! f a b -- | Turns a ternary function into a Lua function. -- -- The resulting function is strict in all of its arguments. liftPure3 :: (a -> b -> c -> d) -> (a -> b -> c -> LuaE e d) liftPure3 f !a !b !c = return $! f a b c -- | Turns a quarternary function into a Lua function. -- -- The resulting function is strict in all of its arguments. liftPure4 :: (a -> b -> c -> d -> e) -> (a -> b -> c -> d -> LuaE err e) liftPure4 f !a !b !c !d = return $! f a b c d -- | Turns a quinary function into a Lua function. -- -- The resulting function is strict in all of its arguments. liftPure5 :: (a -> b -> c -> d -> e -> f) -> (a -> b -> c -> d -> e -> LuaE err f) liftPure5 f !a !b !c !d !e = return $! f a b c d e -- | Create a HaskellFunction precursor from a monadic function, -- selecting the stack index after which the first function parameter -- will be placed. toHsFnPrecursor :: StackIndex -> Name -> a -> HsFnPrecursor e a toHsFnPrecursor idx name f = HsFnPrecursor { hsFnPrecursorAction = return f , hsFnMaxParameterIdx = idx , hsFnParameterDocs = mempty , hsFnName = name } -- | Partially apply a parameter. applyParameter :: HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b applyParameter bldr param = do let action = hsFnPrecursorAction bldr let i = hsFnMaxParameterIdx bldr + 1 let context = Name . Utf8.fromText $ "function argument " <> (parameterName . parameterDoc) param let nextAction f = retrieving context $ do !x <- parameterPeeker param i return $ f x bldr { hsFnPrecursorAction = action >>= nextAction , hsFnMaxParameterIdx = i , hsFnParameterDocs = parameterDoc param : hsFnParameterDocs bldr } -- | Take a 'HaskellFunction' precursor and convert it into a full -- 'HaskellFunction', using the given 'FunctionResult's to return -- the result to Lua. returnResults :: HsFnPrecursor e (LuaE e a) -> FunctionResults e a -> DocumentedFunction e returnResults bldr fnResults = DocumentedFunction { callFunction = do hsResult <- runPeek . retrieving ("arguments for function " <> hsFnName bldr) $ hsFnPrecursorAction bldr case resultToEither hsResult of Left err -> do pushString err Lua.error Right x -> do result <- x forM_ fnResults $ \(FunctionResult push _) -> push result return $! NumResults (fromIntegral $ length fnResults) , functionName = hsFnName bldr , functionDoc = FunDoc { funDocName = Utf8.toText . fromName $ hsFnName bldr , funDocDescription = "" , funDocParameters = reverse $ hsFnParameterDocs bldr , funDocResults = ResultsDocList $ map fnResultDoc fnResults , funDocSince = Nothing } } -- | Take a 'HaskellFunction' precursor and convert it into a full -- 'HaskellFunction', using the given 'FunctionResult's to return -- the result to Lua. returnResultsOnStack :: HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e returnResultsOnStack bldr desc = DocumentedFunction { callFunction = do hsResult <- runPeek . retrieving ("arguments for function " <> hsFnName bldr) $ hsFnPrecursorAction bldr case resultToEither hsResult of Left err -> do pushString err Lua.error Right x -> x , functionName = hsFnName bldr , functionDoc = FunDoc { funDocName = Utf8.toText . fromName $ hsFnName bldr , funDocDescription = "" , funDocParameters = reverse $ hsFnParameterDocs bldr , funDocResults = ResultsDocMult desc , funDocSince = Nothing } } -- | Like @'returnResult'@, but returns only a single result. returnResult :: HsFnPrecursor e (LuaE e a) -> FunctionResult e a -> DocumentedFunction e returnResult bldr = returnResults bldr . (:[]) -- | Updates the description of a Haskell function. Leaves the function -- unchanged if it has no documentation. updateFunctionDescription :: DocumentedFunction e -> Text -> DocumentedFunction e updateFunctionDescription fn desc = let fnDoc = functionDoc fn in fn { functionDoc = fnDoc { funDocDescription = desc} } -- | Sets the library version at which the function was introduced in its -- current form. since :: DocumentedFunction e -> Version -> DocumentedFunction e since fn version = let fnDoc = functionDoc fn in fn { functionDoc = fnDoc { funDocSince = Just version }} -- -- Operators -- infixl 8 ###, <#>, =#>, =?>, #?, `since` -- | Like '($)', but left associative. (###) :: (a -> HsFnPrecursor e a) -> a -> HsFnPrecursor e a (###) = ($) -- | Inline version of @'applyParameter'@. (<#>) :: HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b (<#>) = applyParameter -- | Inline version of @'returnResults'@. (=#>) :: HsFnPrecursor e (LuaE e a) -> FunctionResults e a -> DocumentedFunction e (=#>) = returnResults -- | Return a flexible number of results that have been pushed by the -- function action. (=?>) :: HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e (=?>) = returnResultsOnStack -- | Inline version of @'updateFunctionDescription'@. (#?) :: DocumentedFunction e -> Text -> DocumentedFunction e (#?) = updateFunctionDescription -- -- Push to Lua -- -- | Pushes a documented Haskell function to the Lua stack, making it -- usable as a normal function in Lua. At the same time, the function -- docs are registered in the documentation table. pushDocumentedFunction :: LuaError e => DocumentedFunction e -> LuaE e () pushDocumentedFunction fn = do Lua.pushHaskellFunction $ callFunction fn -- push function pushFunctionDoc $ functionDoc fn -- function documentation registerDocumentation (Lua.nth 2) -- store documentation -- -- Convenience functions -- -- | Creates a parameter. parameter :: Peeker e a -- ^ method to retrieve value from Lua -> TypeSpec -- ^ expected Lua type -> Text -- ^ parameter name -> Text -- ^ parameter description -> Parameter e a parameter peeker type_ name desc = Parameter { parameterPeeker = peeker , parameterDoc = ParameterDoc { parameterName = name , parameterDescription = desc , parameterType = type_ , parameterIsOptional = False } } -- | Makes a parameter optional. opt :: Parameter e a -> Parameter e (Maybe a) opt p = Parameter { parameterPeeker = \idx -> (Nothing <$ peekNoneOrNil idx) <|> (Just <$!> parameterPeeker p idx) , parameterDoc = (parameterDoc p){ parameterIsOptional = True } } -- | Creates an optional parameter. -- -- DEPRECATED: Use @opt (parameter ...)@ instead. optionalParameter :: Peeker e a -- ^ method to retrieve the value from Lua -> TypeSpec -- ^ expected Lua type -> Text -- ^ parameter name -> Text -- ^ parameter description -> Parameter e (Maybe a) optionalParameter peeker type_ name desc = opt $ parameter peeker type_ name desc {-# DEPRECATED optionalParameter "Use `opt (parameter ...)` instead." #-} -- | Creates a function result. functionResult :: Pusher e a -- ^ method to push the Haskell result to Lua -> TypeSpec -- ^ Lua type of result -> Text -- ^ result description -> FunctionResults e a functionResult pusher type_ desc = (:[]) $ FunctionResult { fnResultPusher = pusher , fnResultDoc = ResultValueDoc { resultValueType = type_ , resultValueDescription = desc } } hslua-packaging-2.4.1/src/HsLua/Packaging/Module.hs0000644000000000000000000001242707346545000020223 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.Module Copyright : © 2019-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel 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 name = Module { moduleName = name , moduleDescription = mempty , moduleFields = mempty , moduleFunctions = mempty , moduleOperations = mempty , moduleTypeDocs = mempty , moduleTypeInitializers = mempty } -- | Set the list of module fields. withFields :: Module e -> [Field e] -> Module e withFields mdl fields = mdl { moduleFields = fields } -- | Set the list of functions in the module. withFunctions :: Module e -> [DocumentedFunction e] -> Module e withFunctions mdl fns = let addPrefix fn = let doc = functionDoc fn prefixed = Utf8.toText (fromName $ getName mdl) <> "." <> funDocName doc in fn { functionDoc = doc { funDocName = prefixed } } in mdl { moduleFunctions = map addPrefix fns } -- | Set operations that can be performed on the module object. withOperations :: Module e -> [(Operation, DocumentedFunction e)] -> Module e withOperations mdl ops = mdl { moduleOperations = ops } -- | Sets a textual description withDescription :: HasDescription a => a -> Text -> a withDescription = 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 mdl tp = mdl { moduleTypeInitializers = initType tp : moduleTypeInitializers mdl , moduleTypeDocs = generateTypeDocumentation tp : moduleTypeDocs mdl } -- | Gives a different name renameTo :: HasName a => a -> Name -> a renameTo = setName infixl 0 `withFields`, `withFunctions`, `withDescription`, `withOperations` infixl 0 `associateType` -- -- Field constructor and setters -- -- | Create a new module field. deffield :: Name -> Field e deffield name = Field { fieldName = name , fieldPushValue = return () , fieldDoc = FieldDoc { fieldDocName = Utf8.toText $ fromName name , fieldDocType = anyType , fieldDocDescription = mempty } } -- | Set a specific type for a field. withType :: Field e -> TypeSpec -> Field e withType fld typespec = let doc = fieldDoc fld in fld { fieldDoc = doc { fieldDocType = typespec }} -- | Add a value pusher to a field. withValue :: Field e -> LuaE e () -> Field e withValue fld pusher = fld { fieldPushValue = pusher } infixl 0 `withType`, `withValue` -- | Create a new module (i.e., a Lua table). create :: LuaE e () create = newtable -- | Registers a 'Module'; leaves a copy of the module table on -- the stack. registerModule :: LuaError e => Module e -> LuaE e () registerModule mdl = requirehs (moduleName mdl) (const (pushModule mdl)) -- | Add the module under a different name to the table of preloaded -- packages. preloadModuleWithName :: LuaError e => Module e -> Name -> LuaE e () preloadModuleWithName documentedModule name = preloadModule $ documentedModule { moduleName = name } -- | Preload self-documenting module using the module's default name. preloadModule :: LuaError e => Module e -> LuaE e () preloadModule mdl = preloadhs (moduleName mdl) $ do pushModule mdl return (NumResults 1) -- | Pushes a documented module to the Lua stack. pushModule :: LuaError e => Module e -> LuaE e () pushModule mdl = do checkstack' 10 "pushModule" create -- module table pushModuleDoc (generateModuleDocumentation mdl) registerDocumentation (nth 2) -- set and pop doc -- # Functions -- -- module table now on top forM_ (moduleFunctions mdl) $ \fn -> do -- add function to module pushName (functionName fn) -- push documented function, thereby registering the function docs Fun.pushDocumentedFunction fn rawset (nth 3) -- module table -- # Fields -- forM_ (moduleFields mdl) $ \fld -> do pushName (fieldName fld) fieldPushValue fld rawset (nth 3) case moduleOperations mdl of [] -> pure () ops -> do -- create a metatable for this module and add operations newtable forM_ ops $ \(op, fn) -> do pushName $ metamethodName op Fun.pushDocumentedFunction $ fn `setName` "" rawset (nth 3) setmetatable (nth 2) hslua-packaging-2.4.1/src/HsLua/Packaging/Types.hs0000644000000000000000000001255007346545000020077 0ustar0000000000000000{-| Module : HsLua.Packaging.Types Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : Portable Marshaling and documenting Haskell functions. -} module HsLua.Packaging.Types ( -- * Documented Lua objects Module (..) , Field (..) , DocumentedFunction (..) , DocumentedType -- * Documentation types , DocumentationObject (..) , ModuleDoc (..) , FunctionDoc (..) , TypeDoc (..) , ParameterDoc (..) , ResultsDoc (..) , ResultValueDoc (..) , FieldDoc (..) -- * Type classes , HasName (..) , HasDescription (..) ) where import Data.Text (Text) import Data.Version (Version) import HsLua.Core (LuaE, Name (fromName), NumResults) import HsLua.ObjectOrientation (Operation, UDType) import HsLua.Typing (TypeSpec) import qualified HsLua.Core.Utf8 as Utf8 -- | Type definitions containing documented functions. type DocumentedType e a = UDType e (DocumentedFunction e) a -- | Named and documented Lua module. data Module e = Module { moduleName :: Name , moduleDescription :: Text , moduleFields :: [Field e] , moduleFunctions :: [DocumentedFunction e] , moduleOperations :: [(Operation, DocumentedFunction e)] , moduleTypeInitializers :: [LuaE e Name] -- ^ Lua initializers for the types that come with this module. -- Useful to force full initialization of all metatables. , moduleTypeDocs :: [TypeDoc] -- ^ Documentation for the types that are associated with this module. } -- | Self-documenting module field data Field e = Field { fieldName :: Name , fieldDoc :: FieldDoc , fieldPushValue :: LuaE e () } -- -- Function components -- -- | Haskell equivallent to CFunction, i.e., function callable -- from Lua. data DocumentedFunction e = DocumentedFunction { callFunction :: LuaE e NumResults , functionName :: Name , functionDoc :: FunctionDoc } -- -- Documentation types -- -- | Module documentation data ModuleDoc = ModuleDoc { moduleDocName :: Text -- ^ module name , moduleDocDescription :: Text -- ^ textual module description , moduleDocFields :: [FieldDoc] -- ^ module fields , moduleDocFunctions :: [FunctionDoc] -- ^ module functions , moduleDocTypes :: [TypeDoc] -- ^ module-associated types } deriving (Eq, Ord, Show) -- | Documentation for a Haskell function data FunctionDoc = FunDoc { funDocName :: Text , funDocDescription :: Text , funDocParameters :: [ParameterDoc] , funDocResults :: ResultsDoc , funDocSince :: Maybe Version -- ^ Version in which the function -- was introduced. } deriving (Eq, Ord, Show) -- | Documentation for function parameters. data ParameterDoc = ParameterDoc { parameterName :: Text , parameterType :: TypeSpec , parameterDescription :: Text , parameterIsOptional :: Bool } deriving (Eq, Ord, Show) -- | Documentation for the return values of a function. data ResultsDoc = ResultsDocList [ResultValueDoc] -- ^ List of individual results | ResultsDocMult Text -- ^ Flexible results deriving (Eq, Ord, Show) -- | Documentation for a single return value of a function. data ResultValueDoc = ResultValueDoc { resultValueType :: TypeSpec , resultValueDescription :: Text } deriving (Eq, Ord, Show) -- | Documentation for a module field. data FieldDoc = FieldDoc { fieldDocName :: Text , fieldDocType :: TypeSpec , fieldDocDescription :: Text } deriving (Eq, Ord, Show) -- | Documentation of a data type. data TypeDoc = TypeDoc { typeDocName :: Text , typeDocDescription :: Text , typeDocOperations :: [(Operation, FunctionDoc)] , typeDocMethods :: [FunctionDoc] } deriving (Eq, Ord, Show) -- | Documentation for any of the supported Lua objects. data DocumentationObject = DocObjectFunction FunctionDoc | DocObjectModule ModuleDoc | DocObjectType TypeDoc deriving (Eq, Ord, Show) -- -- Type Classes -- -- | Objects that have descriptions. class HasDescription a where getDescription :: a -> Text setDescription :: a -> Text -> a instance HasDescription FieldDoc where getDescription = fieldDocDescription setDescription fd descr = fd { fieldDocDescription = descr } instance HasDescription (Module e) where getDescription = moduleDescription setDescription mdl descr = mdl { moduleDescription = descr } instance HasDescription ModuleDoc where getDescription = moduleDocDescription setDescription md descr = md { moduleDocDescription = descr } instance HasDescription (Field e) where getDescription = fieldDocDescription . fieldDoc setDescription fld descr = let doc = fieldDoc fld in fld { fieldDoc = setDescription doc descr } -- | Named objects class HasName a where getName :: a -> Name setName :: a -> Name -> a instance HasName (Field e) where getName = fieldName setName fd name = let doc = fieldDoc fd in fd { fieldName = name , fieldDoc = doc { fieldDocName = Utf8.toText $ fromName name } } instance HasName (Module e) where getName = moduleName setName mdl name = mdl { moduleName = name } instance HasName (DocumentedFunction e) where getName = functionName setName fn name = let fnDoc = functionDoc fn in fn { functionName = name , functionDoc = fnDoc { funDocName = Utf8.toText $ fromName name } } hslua-packaging-2.4.1/src/HsLua/Packaging/UDType.hs0000644000000000000000000001210207346545000020136 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.UDType Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel This module provides types and functions to use Haskell values as userdata objects in Lua. These objects wrap a Haskell value and provide methods and properties to interact with the Haskell value. The terminology in this module refers to the userdata values as /UD objects/, and to their type as /UD type/. -} module HsLua.Packaging.UDType ( DocumentedType , DocumentedTypeWithList , deftype , deftype' , method , property , property' , possibleProperty , possibleProperty' , readonly , readonly' , alias , operation , peekUD , pushUD , initType -- Reexported from ObjectOrientation , udparam , udresult , udTypeSpec -- * Helper types for building , Member , Operation (..) , Property , Possible (..) ) where import Data.Map (Map) import Data.Text (Text) import HsLua.Core import HsLua.Marshalling import HsLua.ObjectOrientation import HsLua.ObjectOrientation.Operation (metamethodName) import HsLua.Packaging.Function import HsLua.Packaging.Types (DocumentedType, setName) import HsLua.Typing (pushTypeSpec) import qualified Data.Map as Map -- | A userdata type, capturing the behavior of Lua objects that wrap -- Haskell values. The type name must be unique; once the type has been -- used to push or retrieve a value, the behavior can no longer be -- modified through this type. type DocumentedTypeWithList e a itemtype = UDTypeWithList e (DocumentedFunction e) a itemtype -- | Defines a new type, defining the behavior of objects in Lua. -- Note that the type name must be unique. deftype :: LuaError e => Name -- ^ type name -> [(Operation, DocumentedFunction e)] -- ^ operations -> [Member e (DocumentedFunction e) a] -- ^ methods -> DocumentedType e a deftype name ops methods = addDocHooks $ deftypeGeneric' pushDocumentedFunction name ops methods emptyHooks -- | Defines a new type that could also be treated as a list; defines -- the behavior of objects in Lua. Note that the type name must be -- unique. deftype' :: LuaError e => Name -- ^ type name -> [(Operation, DocumentedFunction e)] -- ^ operations -> [Member e (DocumentedFunction e) a] -- ^ methods -> Maybe (ListSpec e a itemtype) -- ^ list access -> DocumentedTypeWithList e a itemtype deftype' name ops methods mlistSpec = addDocHooks . deftypeGeneric' pushDocumentedFunction name ops methods $ maybe emptyHooks listExtension mlistSpec -- | Use a documented function as an object method. method :: DocumentedFunction e -> Member e (DocumentedFunction e) a method f = methodGeneric (functionName f) f -- | Declares a new object operation from a documented function. operation :: Operation -- ^ the kind of operation -> DocumentedFunction e -- ^ function used to perform the operation -> (Operation, DocumentedFunction e) operation op f = (,) op $ f `setName` metamethodName op -- | Defines a function parameter that takes the given type. udparam :: LuaError e => DocumentedTypeWithList e a itemtype -- ^ expected type -> Text -- ^ parameter name -> Text -- ^ parameter description -> Parameter e a udparam ty = parameter (peekUDGeneric ty) (udTypeSpec ty) -- | Defines a function result of the given type. udresult :: LuaError e => DocumentedTypeWithList e a itemtype -- ^ result type -> Text -- ^ result description -> FunctionResults e a udresult ty = functionResult (pushUD ty) (udTypeSpec ty) -- | Pushes a userdata value of the given type. pushUD :: LuaError e => DocumentedTypeWithList e a itemtype -> a -> LuaE e () pushUD = pushUDGeneric -- | Retrieves a userdata value of the given type. peekUD :: LuaError e => DocumentedTypeWithList e a itemtype -> Peeker e a peekUD = peekUDGeneric -- | Adds a hook to the type that pushes the documentation. addDocHooks :: LuaError e => UDTypeGeneric e (DocumentedFunction e) a -> UDTypeGeneric e (DocumentedFunction e) a addDocHooks ty = let hooks = udHooks ty in ty { udHooks = hooks { hookMetatableSetup = do hookMetatableSetup hooks pushUDTypeDocs ty } } -- | Pushes a documentation table for the given UD type. pushUDTypeDocs :: LuaError e => DocumentedTypeWithList e a itemtype -> LuaE e () pushUDTypeDocs ty = do -- metadata table is at the top of the stack pushName "docs" pushAsTable [ ("name", pushName . udName) , ("properties", pushPropertyDocs . udProperties) ] ty rawset (nth 3) pushPropertyDocs :: LuaError e => Map Name (Property e a) -> LuaE e () pushPropertyDocs = pushKeyValuePairs pushName pushPropDocs . Map.toList where pushPropDocs = pushAsTable [ ("description", pushText . propertyDescription) , ("type", pushTypeSpec . propertyType) ] hslua-packaging-2.4.1/test/HsLua/Packaging/0000755000000000000000000000000007346545000016624 5ustar0000000000000000hslua-packaging-2.4.1/test/HsLua/Packaging/DocumentationTests.hs0000644000000000000000000000323607346545000023020 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-| Module : HsLua.Packaging.DocumentationTests Copyright : © 2021-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Tests for calling exposed Haskell functions. -} module HsLua.Packaging.DocumentationTests (tests) where import Data.Version (makeVersion) import HsLua.Core (top, Status (OK)) import HsLua.Packaging.Documentation import HsLua.Packaging.Function import HsLua.Marshalling (peekIntegral, pushIntegral) import Test.Tasty.HsLua ((=:), shouldBeResultOf) import Test.Tasty (TestTree, testGroup) import qualified HsLua.Core as Lua -- | Calling Haskell functions from Lua. tests :: TestTree tests = testGroup "Documentation" [ testGroup "getdocumentation" [ "retrieves function docs as userdata" =: Lua.TypeUserdata `shouldBeResultOf` do pushDocumentedFunction factorial getdocumentation top , "returns nil for undocumented function" =: Lua.TypeNil `shouldBeResultOf` do OK <- Lua.dostring "return function () return 1 end" getdocumentation top , "Calling the doc object returns a table" =: Lua.TypeTable `shouldBeResultOf` do pushDocumentedFunction factorial _ <- getdocumentation top Lua.pushvalue top Lua.call 1 1 Lua.ltype top ] ] factorial :: DocumentedFunction Lua.Exception factorial = defun "factorial" (liftPure $ \n -> product [1..n]) <#> parameter (peekIntegral @Integer) "integer" "n" "" =#> functionResult pushIntegral "integer or string" "factorial" #? "Calculates the factorial of a positive integer." `since` makeVersion [1,0,0] hslua-packaging-2.4.1/test/HsLua/Packaging/FunctionTests.hs0000644000000000000000000001304707346545000021775 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-| Module : HsLua.Packaging.FunctionTests Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Tests for calling exposed Haskell functions. -} module HsLua.Packaging.FunctionTests (tests) where import Data.Maybe (fromMaybe) import Data.Version (makeVersion) import HsLua.Core (StackIndex, top) import HsLua.Packaging.Convenience import HsLua.Packaging.Documentation (getdocumentation, peekFunctionDoc) import HsLua.Packaging.Function import HsLua.Packaging.Types import HsLua.Marshalling ( forcePeek, peekIntegral, peekRealFloat, peekText , pushIntegral, pushRealFloat) import Test.Tasty.HsLua ((=:), shouldBeResultOf) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit ((@=?)) import qualified HsLua.Core as Lua -- | Calling Haskell functions from Lua. tests :: TestTree tests = testGroup "Call" [ testGroup "push Haskell function" [ "DocumentedFunction building" =: 720 `shouldBeResultOf` do factLua <- factLuaAtIndex <$> Lua.gettop Lua.pushinteger 6 _ <- callFunction factLua forcePeek $ peekIntegral @Integer Lua.top , "error message" =: mconcat [ "Integral expected, got boolean\n" , "\twhile retrieving function argument n\n" , "\twhile retrieving arguments for function factorial"] `shouldBeResultOf` do factLua <- factLuaAtIndex <$> Lua.gettop Lua.pushboolean True _ <- callFunction factLua forcePeek $ peekText Lua.top ] , testGroup "use as C function" [ "push factorial" =: Lua.TypeFunction `shouldBeResultOf` do pushDocumentedFunction $ factLuaAtIndex 0 Lua.ltype Lua.top , "call factorial" =: 120 `shouldBeResultOf` do pushDocumentedFunction $ factLuaAtIndex 0 Lua.pushinteger 5 Lua.call 1 1 forcePeek $ peekIntegral @Integer Lua.top , "use from Lua" =: 24 `shouldBeResultOf` do pushDocumentedFunction $ factLuaAtIndex 0 Lua.setglobal "factorial" Lua.loadstring "return factorial(4)" *> Lua.call 0 1 forcePeek $ peekIntegral @Integer Lua.top , "with setting an optional param" =: 8 `shouldBeResultOf` do pushDocumentedFunction nroot Lua.setglobal "nroot" Lua.loadstring "return nroot(64)" *> Lua.call 0 1 forcePeek $ peekRealFloat @Double Lua.top , "with setting an optional param" =: 2 `shouldBeResultOf` do pushDocumentedFunction nroot Lua.setglobal "nroot" Lua.loadstring "return nroot(64, 6)" *> Lua.call 0 1 forcePeek $ peekRealFloat @Double Lua.top ] , testGroup "documentation access" [ "pushDocumentedFunction pushes one value" =: 1 `shouldBeResultOf` do oldtop <- Lua.gettop pushDocumentedFunction (factLuaAtIndex 0) newtop <- Lua.gettop pure (newtop - oldtop) , "getdocumentation" =: "factorial" `shouldBeResultOf` do pushDocumentedFunction (factLuaAtIndex 0) Lua.TypeUserdata <- getdocumentation top forcePeek (funDocName <$> peekFunctionDoc top) , "undocumented value" =: Lua.TypeNil `shouldBeResultOf` do Lua.pushboolean True getdocumentation top ] , testGroup "helpers" [ "parameter doc" =: ( ParameterDoc { parameterName = "test" , parameterDescription = "test param" , parameterType = "string" , parameterIsOptional = False } @=? parameterDoc (parameter @Lua.Exception peekText "string" "test" "test param") ) , "optional parameter doc" =: ( ParameterDoc { parameterName = "test" , parameterDescription = "test param" , parameterType = "string" , parameterIsOptional = True } @=? parameterDoc (opt (textParam @Lua.Exception "test" "test param")) ) , "functionResult doc" =: ( [ ResultValueDoc { resultValueDescription = "int result" , resultValueType = "integer" } ] @=? fnResultDoc <$> functionResult (pushIntegral @Int) "integer" "int result" ) ] ] factLuaAtIndex :: StackIndex -> DocumentedFunction Lua.Exception factLuaAtIndex idx = toHsFnPrecursor idx "factorial" (liftPure factorial) <#> factorialParam =#> factorialResult #? "Calculates the factorial of a positive integer." `since` makeVersion [1,0,0] -- | Calculate the factorial of a number. factorial :: Integer -> Integer factorial n = product [1..n] factorialParam :: Parameter Lua.Exception Integer factorialParam = Parameter { parameterDoc = ParameterDoc { parameterName = "n" , parameterType = "integer" , parameterDescription = "number for which the factorial is computed" , parameterIsOptional = False } , parameterPeeker = peekIntegral @Integer } factorialResult :: FunctionResults Lua.Exception Integer factorialResult = (:[]) $ FunctionResult (pushIntegral @Integer) (ResultValueDoc "integer" "factorial") -- | Calculate the nth root of a number. Defaults to square root. nroot :: DocumentedFunction Lua.Exception nroot = defun "nroot" ### liftPure2 nroot' <#> parameter (peekRealFloat @Double) "number" "x" "" <#> opt (integralParam @Int "n" "") =#> functionResult pushRealFloat "number" "nth root" where nroot' :: Double -> Maybe Int -> Double nroot' x nOpt = let n = fromMaybe 2 nOpt in x ** (1 / fromIntegral n) hslua-packaging-2.4.1/test/HsLua/Packaging/ModuleTests.hs0000644000000000000000000001105507346545000021432 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-| Module : HsLua.Packaging.ModuleTests Copyright : © 2019-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : Requires GHC 8 or later. Tests creating and loading of modules with Haskell. -} module HsLua.Packaging.ModuleTests (tests) where import HsLua.Core import HsLua.Marshalling ( forcePeek, peekIntegral, peekString, pushIntegral, pushText ) import HsLua.Packaging.Documentation import HsLua.Packaging.Function import HsLua.Packaging.Module import HsLua.Packaging.UDType (deftype) import HsLua.Packaging.Types import Test.Tasty.HsLua ((=:), shouldBeResultOf) import Test.Tasty (TestTree, testGroup) import qualified HsLua.Core as Lua -- | Specifications for Attributes parsing functions. tests :: TestTree tests = testGroup "Module" [ testGroup "creation helpers" [ "pushing a module produces a table" =: Lua.TypeTable `shouldBeResultOf` do pushModule $ defmodule "test" Lua.ltype Lua.top ] , testGroup "module type" [ "register module" =: 1 `shouldBeResultOf` do Lua.openlibs old <- Lua.gettop registerModule mymath new <- Lua.gettop return (new - old) , "call module function" =: 24 `shouldBeResultOf` do Lua.openlibs registerModule mymath _ <- Lua.dostring $ mconcat [ "local mymath = require 'mymath'\n" , "return mymath.factorial(4)" ] forcePeek $ peekIntegral @Prelude.Integer Lua.top , "call module as function" =: "call me maybe" `shouldBeResultOf` do Lua.openlibs registerModule mymath _ <- Lua.dostring "return (require 'mymath')()" forcePeek $ peekString Lua.top , "access name in docs" =: "mymath" `shouldBeResultOf` do Lua.openlibs registerModule mymath TypeUserdata <- getdocumentation top forcePeek $ moduleDocName <$> peekModuleDoc Lua.top , "function name in docs is prefixed with module name" =: "mymath.factorial" `shouldBeResultOf` do Lua.openlibs registerModule mymath TypeUserdata <- getdocumentation top mdldoc <- forcePeek $ peekModuleDoc Lua.top case moduleDocFunctions mdldoc of fd:_ -> pure $ funDocName fd _ -> fail "No documented functions" , "function doc is shared" =: True `shouldBeResultOf` do Lua.openlibs registerModule mymath pushvalue top setglobal "mymath" -- get doc table via module docs TypeUserdata <- getdocumentation top fndoc <- forcePeek $ moduleDocFunctions <$> peekModuleDoc Lua.top >>= \case fd:_ -> pure fd _ -> fail "No documented functions" -- get the function documenation via Lua OK <- dostring "return mymath.factorial" TypeUserdata <- getdocumentation top fndoc' <- forcePeek $ peekFunctionDoc Lua.top -- must be the same return (fndoc == fndoc') , "first field name in docs" =: "mymath.unit" `shouldBeResultOf` do Lua.openlibs registerModule mymath TypeUserdata <- getdocumentation top mdl <- forcePeek $ peekModuleDoc Lua.top case moduleDocFields mdl of f:_ -> pure $ fieldDocName f [] -> fail "No fields" , "document object has associated types" =: ["Void"] `shouldBeResultOf` do Lua.openlibs registerModule mymath TypeUserdata <- getdocumentation top mdl <- forcePeek $ peekModuleDoc Lua.top return . map typeDocName $ moduleDocTypes mdl ] ] mymath :: Module Lua.Exception mymath = defmodule "mymath" `withFields` [ deffield "unit" `withType` "integer" `withDescription` "additive unit" `withValue` pushinteger 1 ] `withFunctions` [factorial] `withOperations` [ (,) Call $ lambda ### (1 <$ pushText "call me maybe") =?> "call result" ] `associateType` deftype "Void" [] [] factorial :: DocumentedFunction Lua.Exception factorial = defun "factorial" ### liftPure (\n -> product [1..n]) <#> factorialParam =#> factorialResult factorialParam :: Parameter Lua.Exception Prelude.Integer factorialParam = parameter peekIntegral "integer" "n" "number for which the factorial is computed" factorialResult :: FunctionResults Lua.Exception Prelude.Integer factorialResult = functionResult pushIntegral "integer" "factorial" hslua-packaging-2.4.1/test/HsLua/Packaging/UDTypeTests.hs0000644000000000000000000001017007346545000021354 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-| Module : HsLua.Packaging.UDTypeTests Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Tests for calling exposed Haskell functions. -} module HsLua.Packaging.UDTypeTests (tests) where import HsLua.Core import HsLua.Packaging.Function import HsLua.Packaging.UDType import HsLua.Marshalling import Test.Tasty (TestTree, testGroup) import Test.Tasty.HsLua ((=:), shouldBeResultOf) import qualified Data.ByteString.Char8 as Char8 -- | Calling Haskell functions from Lua. tests :: TestTree tests = testGroup "DocumentedType" [ testGroup "Foo type" [ "show" =: "Foo 5 \"five\"" `shouldBeResultOf` do openlibs pushUD typeFoo $ Foo 5 "five" setglobal "foo" _ <- dostring "return foo:show()" forcePeek $ peekText top , "pairs iterates over properties" =: ["num", "5", "str", "echo", "show", "function"] `shouldBeResultOf` do openlibs pushUD typeFoo $ Foo 5 "echo" setglobal "echo" OK <- dostring $ Char8.unlines [ "local result = {}" , "for k, v in pairs(echo) do" , " table.insert(result, k)" , " table.insert(" , " result," , " type(v) == 'function' and 'function' or tostring(v)" , " )" , "end" , "return result" ] forcePeek $ peekList peekText top ] , testGroup "Sum type" [ "tostring Quux" =: "Quux 11 \"eleven\"" `shouldBeResultOf` do openlibs pushUD typeQux $ Quux 11 "eleven" setglobal "quux" _ <- dostring "return tostring(quux)" forcePeek $ peekText top , "show Quux" =: "Quux 11 \"eleven\"" `shouldBeResultOf` do openlibs pushUD typeQux $ Quux 11 "eleven" setglobal "quux" _ <- dostring "return quux:show()" forcePeek $ peekText top ] ] -- -- Sample types -- data Foo = Foo Int String deriving (Eq, Show) show' :: LuaError e => DocumentedFunction e show' = defun "show" ### liftPure (show @Foo) <#> udparam typeFoo "foo" "Object" =#> functionResult pushString "string" "stringified foo" typeFoo :: LuaError e => DocumentedType e Foo typeFoo = deftype "Foo" [ operation Tostring show' ] [ property "num" "some number" (pushIntegral, \(Foo n _) -> n) (peekIntegral, \(Foo _ s) n -> Foo n s) , readonly "str" "some string" (pushString, \(Foo _ s) -> s) , method show' ] -- -- Sum Type -- data Qux = Quux Int String | Quuz Point Int deriving (Eq, Show) data Point = Point Double Double deriving (Eq, Show) pushPoint :: LuaError e => Pusher e Point pushPoint (Point x y) = do newtable pushName "x" *> pushRealFloat x *> rawset (nth 3) pushName "y" *> pushRealFloat y *> rawset (nth 3) peekPoint :: LuaError e => Peeker e Point peekPoint idx = do x <- peekFieldRaw peekRealFloat "x" idx y <- peekFieldRaw peekRealFloat "y" idx return $ x `seq` y `seq` Point x y showQux :: LuaError e => DocumentedFunction e showQux = defun "show" ### liftPure (show @Qux) <#> parameter peekQux "qux" "qux" "Object" =#> functionResult pushString "string" "stringified Qux" peekQux :: LuaError e => Peeker e Qux peekQux = peekUD typeQux typeQux :: LuaError e => DocumentedType e Qux typeQux = deftype "Qux" [ operation Tostring showQux ] [ method showQux , property "num" "some number" (pushIntegral, \case Quux n _ -> n Quuz _ n -> n) (peekIntegral, \case Quux _ s -> (`Quux` s) Quuz d _ -> Quuz d) , possibleProperty "str" "a string in Quux" (pushString, \case Quux _ s -> Actual s Quuz {} -> Absent) (peekString, \case Quux n _ -> Actual . Quux n Quuz {} -> const Absent) , possibleProperty "point" "a point in Quuz" (pushPoint, \case Quuz p _ -> Actual p Quux {} -> Absent) (peekPoint, \case Quuz _ n -> Actual . (`Quuz` n) Quux {} -> const Absent) , alias "x" "The x coordinate of a point in Quuz" ["point", "x"] ] hslua-packaging-2.4.1/test/HsLua/0000755000000000000000000000000007346545000014740 5ustar0000000000000000hslua-packaging-2.4.1/test/HsLua/PackagingTests.hs0000644000000000000000000000126107346545000020203 0ustar0000000000000000{-| Module : HsLua.PackagingTests Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Test packaging -} module HsLua.PackagingTests (tests) where import Test.Tasty (TestTree, testGroup) import qualified HsLua.Packaging.DocumentationTests import qualified HsLua.Packaging.FunctionTests import qualified HsLua.Packaging.ModuleTests import qualified HsLua.Packaging.UDTypeTests -- | Tests for package creation. tests :: TestTree tests = testGroup "Packaging" [ HsLua.Packaging.FunctionTests.tests , HsLua.Packaging.ModuleTests.tests , HsLua.Packaging.UDTypeTests.tests , HsLua.Packaging.DocumentationTests.tests ] hslua-packaging-2.4.1/test/0000755000000000000000000000000007346545000013724 5ustar0000000000000000hslua-packaging-2.4.1/test/test-hslua-packaging.hs0000644000000000000000000000063107346545000020273 0ustar0000000000000000{-| Module : Main Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Tests for hslua-packaging. -} import Test.Tasty (TestTree, defaultMain, testGroup) import qualified HsLua.PackagingTests main :: IO () main = defaultMain tests -- | Lua module packaging tests. tests :: TestTree tests = testGroup "Packaging" [HsLua.PackagingTests.tests]