hslua-packaging-2.3.0/0000755000000000000000000000000007346545000012743 5ustar0000000000000000hslua-packaging-2.3.0/CHANGELOG.md0000644000000000000000000000776507346545000014573 0ustar0000000000000000# Changelog `hslua-packaging` uses [PVP Versioning][]. ## 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.3.0/LICENSE0000644000000000000000000000205007346545000013745 0ustar0000000000000000Copyright © 2019-2023 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.3.0/README.md0000644000000000000000000000462607346545000014232 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.3.0/hslua-packaging.cabal0000644000000000000000000000722107346545000016767 0ustar0000000000000000cabal-version: 2.2 name: hslua-packaging version: 2.3.0 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-2023 Albert Krewinkel category: Foreign extra-source-files: README.md , CHANGELOG.md tested-with: GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.3 , GHC == 9.0.2 , GHC == 9.2.5 , GHC == 9.4.4 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 , hslua-objectorientation >= 2.3 && < 2.4 , hslua-typing >= 0.1 && < 0.2 , mtl >= 2.2 && < 2.4 , text >= 1.2 && < 2.1 ghc-options: -Wall -Wincomplete-record-updates -Wnoncanonical-monad-instances -Wredundant-constraints if impl(ghc >= 8.2) ghc-options: -Wcpp-undef -Werror=missing-home-modules if impl(ghc >= 8.4) ghc-options: -Widentities -Wincomplete-uni-patterns -Wpartial-fields -fhide-source-paths library import: common-options exposed-modules: HsLua.Packaging , HsLua.Packaging.Convenience , HsLua.Packaging.Documentation , HsLua.Packaging.Function , HsLua.Packaging.Module , HsLua.Packaging.Rendering , 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.7 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.RenderingTests , HsLua.Packaging.UDTypeTests build-depends: hslua-packaging , bytestring , tasty-hslua , tasty >= 0.11 , tasty-hunit >= 0.9 other-extensions: OverloadedStrings , TypeApplications hslua-packaging-2.3.0/src/HsLua/0000755000000000000000000000000007346545000014546 5ustar0000000000000000hslua-packaging-2.3.0/src/HsLua/Packaging.hs0000644000000000000000000000136607346545000016774 0ustar0000000000000000{-| Module : HsLua.Packaging Copyright : © 2019-2023 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 ) 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 hslua-packaging-2.3.0/src/HsLua/Packaging/0000755000000000000000000000000007346545000016432 5ustar0000000000000000hslua-packaging-2.3.0/src/HsLua/Packaging/Convenience.hs0000644000000000000000000000436707346545000021234 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.Convenience Copyright : © 2021-2023 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.3.0/src/HsLua/Packaging/Documentation.hs0000644000000000000000000001405407346545000021603 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.Documentation Copyright : © 2020-2023 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Provides a function to print documentation if available. -} module HsLua.Packaging.Documentation ( documentation , getdocumentation , registerDocumentation , pushModuleDoc , pushFunctionDoc , pushFieldDoc , docsField ) where import Data.Version (showVersion) import HsLua.Core as Lua import HsLua.Marshalling import HsLua.Packaging.Types import HsLua.Typing (pushTypeSpec) -- | Function that retrieves documentation. documentation :: LuaError e => DocumentedFunction e documentation = DocumentedFunction { callFunction = documentationHaskellFunction , functionName = "documentation" , functionDoc = FunctionDoc { functionDescription = "Retrieves the documentation of the given object." , parameterDocs = [ ParameterDoc { parameterName = "value" , parameterType = "any" , parameterDescription = "documented object" , parameterIsOptional = False } ] , functionResultsDocs = ResultsDocList [ ResultValueDoc "string|nil" "docstring" ] , functionSince = Nothing } } -- | Function that returns the documentation of a given object, or @nil@ -- if no documentation is available. documentationHaskellFunction :: LuaError e => LuaE e NumResults documentationHaskellFunction = isnoneornil (nthBottom 1) >>= \case True -> failLua "expected a non-nil value as argument 1" _ -> NumResults 1 <$ getdocumentation top -- | 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 -- | 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 -- | 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 strings 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 of a module as a table with string fields -- @name@ and @description@. pushModuleDoc :: LuaError e => Pusher e (Module e) pushModuleDoc = pushAsTable [ ("name", pushName . moduleName) , ("description", pushText . moduleDescription) , ("fields", pushList pushFieldDoc . moduleFields) , ("functions", pushList pushFunctionDoc . moduleFunctions) ] -- | Pushes the documentation of a field as a table with string fields -- @name@ and @description@. pushFieldDoc :: LuaError e => Pusher e (Field e) pushFieldDoc = pushAsTable [ ("name", pushText . fieldName) , ("type", pushTypeSpec . fieldType) , ("description", pushText . fieldDescription) ] -- | 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@. pushFunctionDoc :: LuaError e => Pusher e (DocumentedFunction e) pushFunctionDoc fun = pushAsTable [ ("name", pushName . const (functionName fun)) , ("description", pushText . functionDescription) , ("parameters", pushList pushParameterDoc . parameterDocs) , ("results", pushResultsDoc . functionResultsDocs) , ("since", maybe pushnil (pushString . showVersion) . functionSince) ] (functionDoc fun) -- | Pushes the documentation of a parameter as a table with boolean -- field @optional@ and string fields @name@, @type@, and @description@. pushParameterDoc :: LuaError e => Pusher e ParameterDoc pushParameterDoc = 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) ] hslua-packaging-2.3.0/src/HsLua/Packaging/Function.hs0000644000000000000000000002506407346545000020562 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.Function Copyright : © 2020-2023 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 , setName , 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 = FunctionDoc { functionDescription = "" , parameterDocs = reverse $ hsFnParameterDocs bldr , functionResultsDocs = ResultsDocList $ map fnResultDoc fnResults , functionSince = 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 = FunctionDoc { functionDescription = "" , parameterDocs = reverse $ hsFnParameterDocs bldr , functionResultsDocs = ResultsDocMult desc , functionSince = 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 { functionDescription = desc} } -- | Renames a documented function. setName :: Name -> DocumentedFunction e -> DocumentedFunction e setName name fn = fn { functionName = name } -- | 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 { functionSince = 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 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.3.0/src/HsLua/Packaging/Module.hs0000644000000000000000000000666207346545000020225 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.Module Copyright : © 2019-2023 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 (..) , 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 = 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" pushAsTable [ ("name", pushName . moduleName) , ("description", pushText . moduleDescription) , ("fields", pushList pushFieldDoc . moduleFields) , ("types", pushTypesFunction . moduleTypeInitializers) ] mdl create -- module table pushvalue (nth 2) -- push documentation object registerDocumentation (nth 2) -- set and pop doc -- # Functions -- -- module table now on top -- documentation table in pos 2 newtable -- function documention pushName "functions" pushvalue (nth 2) rawset (nth 5) -- function documentation table now on top -- module table in position 2 -- module documentation table in pos 3 forM_ (zip [1..] (moduleFunctions mdl)) $ \(i, fn) -> do -- push documented function, thereby registering the function docs Fun.pushDocumentedFunction fn -- add function to module pushName (functionName fn) pushvalue (nth 2) -- C function rawset (nth 5) -- module table -- set documentation _ <- getdocumentation top rawseti (nth 3) i pop 1 -- C Function pop 1 -- function documentation table remove (nth 2) -- module documentation table -- # Fields -- forM_ (moduleFields mdl) $ \field -> do pushText (fieldName field) fieldPushValue field 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 $ Fun.setName "" fn rawset (nth 3) setmetatable (nth 2) pushTypesFunction :: LuaError e => Pusher e [LuaE e Name] pushTypesFunction initializers = pushHaskellFunction $ do sequence initializers >>= pushList pushName pure 1 hslua-packaging-2.3.0/src/HsLua/Packaging/Rendering.hs0000644000000000000000000001002407346545000020700 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.Rendering Copyright : © 2020-2023 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : Portable Render function and module documentation. -} module HsLua.Packaging.Rendering {-# DEPRECATED "Use getdocumentation with a custom renderer." #-} ( -- * Documentation render , renderModule , renderFunction ) where import Data.Text (Text) import Data.Version (showVersion) import HsLua.Core import HsLua.Packaging.Types import HsLua.Typing (typeSpecToString) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified HsLua.Core.Utf8 as Utf8 -- -- Module documentation -- -- | Alias for 'renderModule'. render :: Module e -> Text render = renderModule -- | Renders module documentation as Markdown. renderModule :: Module e -> Text renderModule mdl = let fields = moduleFields mdl in T.unlines [ "# " <> T.decodeUtf8 (fromName $ moduleName mdl) , "" , moduleDescription mdl , renderFields fields , renderFunctions (moduleFunctions mdl) ] -- | Renders the full function documentation section. renderFunctions :: [DocumentedFunction e] -> Text renderFunctions = \case [] -> mempty fs -> "\n## Functions\n\n" <> T.intercalate "\n\n" (map (("### " <>) . renderFunction) fs) -- | Renders documentation of a function. renderFunction :: DocumentedFunction e -- ^ function -> Text -- ^ function docs renderFunction fn = let fnDoc = functionDoc fn fnName = Utf8.toText $ fromName (functionName fn) name = if T.null fnName then "" else fnName in T.intercalate "\n" [ name <> " (" <> renderFunctionParams fnDoc <> ")" , "" , renderFunctionDoc fnDoc ] -- | Renders the parameter names of a function, separated by commas. renderFunctionParams :: FunctionDoc -> Text renderFunctionParams fd = T.intercalate ", " . map parameterName $ parameterDocs fd -- | Render documentation for fields as Markdown. renderFields :: [Field e] -> Text renderFields fs = if null fs then mempty else mconcat [ "\n" , T.intercalate "\n\n" (map (("### " <>) . renderField) fs) ] -- | Renders documentation for a single field. renderField :: Field e -> Text renderField f = fieldName f <> "\n\n" <> fieldDescription f -- -- Function documentation -- -- | Renders the documentation of a function as Markdown. renderFunctionDoc :: FunctionDoc -> Text renderFunctionDoc (FunctionDoc desc paramDocs resultDoc mVersion) = let sinceTag = case mVersion of Nothing -> mempty Just version -> T.pack $ "\n\n*Since: " <> showVersion version <> "*" in (if T.null desc then "" else desc <> sinceTag <> "\n\n") <> renderParamDocs paramDocs <> renderResultsDoc resultDoc -- | Renders function parameter documentation as a Markdown blocks. renderParamDocs :: [ParameterDoc] -> Text renderParamDocs pds = "Parameters:\n\n" <> T.intercalate "\n" (map renderParamDoc pds) -- | Renders the documentation of a function parameter as a Markdown -- line. renderParamDoc :: ParameterDoc -> Text renderParamDoc pd = mconcat [ parameterName pd , "\n: " , parameterDescription pd , " (", T.pack (typeSpecToString (parameterType pd)), ")\n" ] -- | Renders the documentation of a function result as a Markdown list -- item. renderResultsDoc :: ResultsDoc -> Text renderResultsDoc = \case ResultsDocList [] -> mempty ResultsDocList rds -> "\nReturns:\n\n" <> T.intercalate "\n" (map renderResultValueDoc rds) ResultsDocMult txt -> " - " <> indent 4 txt -- | Renders the documentation of a function result as a Markdown list -- item. renderResultValueDoc :: ResultValueDoc -> Text renderResultValueDoc rd = mconcat [ " - " , resultValueDescription rd , " (", T.pack (typeSpecToString $ resultValueType rd), ")" ] indent :: Int -> Text -> Text indent n = T.replace "\n" (T.replicate n " ") hslua-packaging-2.3.0/src/HsLua/Packaging/Types.hs0000644000000000000000000000462207346545000020076 0ustar0000000000000000{-| Module : HsLua.Packaging.Types Copyright : © 2020-2023 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Stability : alpha Portability : Portable Marshaling and documenting Haskell functions. -} module HsLua.Packaging.Types ( -- * Documented module Module (..) , Field (..) -- * Documented functions , DocumentedFunction (..) -- ** Documentation types , FunctionDoc (..) , ParameterDoc (..) , ResultsDoc (..) , ResultValueDoc (..) ) where import Data.Text (Text) import Data.Version (Version) import HsLua.Core (LuaE, Name, NumResults) import HsLua.ObjectOrientation (Operation) import HsLua.Typing (TypeSpec) -- | 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] } -- | Self-documenting module field data Field e = Field { fieldName :: Text , fieldType :: TypeSpec , fieldDescription :: Text , 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 -- -- | Documentation for a Haskell function data FunctionDoc = FunctionDoc { functionDescription :: Text , parameterDocs :: [ParameterDoc] , functionResultsDocs :: ResultsDoc , functionSince :: 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) hslua-packaging-2.3.0/src/HsLua/Packaging/UDType.hs0000644000000000000000000001162307346545000020143 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.UDType Copyright : © 2020-2023 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 , udparam , udresult , udDocs , 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.Typing (pushTypeSpec) import qualified Data.Map as Map -- | Type definitions containing documented functions. type DocumentedType e a = UDType e (DocumentedFunction e) a -- | 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 = deftypeGeneric pushDocumentedFunction -- | 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' = deftypeGeneric' pushDocumentedFunction -- | 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 $ setName (metamethodName op) f -- | 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 pushUDTypeDocs -- | Retrieves a userdata value of the given type. peekUD :: LuaError e => DocumentedTypeWithList e a itemtype -> Peeker e a peekUD = peekUDGeneric -- | Ensures that the type has been fully initialized, i.e., that all -- metatables have been created and stored in the registry. Returns the -- name of the initialized type. initType :: LuaError e => DocumentedTypeWithList e a itemtype -> LuaE e Name initType = initTypeGeneric pushUDTypeDocs -- | 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.3.0/test/HsLua/Packaging/0000755000000000000000000000000007346545000016622 5ustar0000000000000000hslua-packaging-2.3.0/test/HsLua/Packaging/DocumentationTests.hs0000644000000000000000000000342607346545000023017 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-| Module : HsLua.Packaging.DocumentationTests Copyright : © 2021-2023 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), Type (TypeNil, TypeString)) import HsLua.Packaging.Documentation import HsLua.Packaging.Function import HsLua.Marshalling (forcePeek, peekIntegral, pushIntegral, peekText) 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 "Function docs" [ "retrieves function docs" =: "factorial" `shouldBeResultOf` do pushDocumentedFunction factorial Lua.setglobal (functionName factorial) pushDocumentedFunction documentation Lua.setglobal "documentation" OK <- Lua.dostring "return documentation(factorial)" TypeString <- Lua.getfield top "name" forcePeek $ peekText top , "returns nil for undocumented function" =: TypeNil `shouldBeResultOf` do pushDocumentedFunction documentation Lua.setglobal "documentation" OK <- Lua.dostring "return documentation(function () return 1 end)" 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.3.0/test/HsLua/Packaging/FunctionTests.hs0000644000000000000000000001305707346545000021774 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-| Module : HsLua.Packaging.FunctionTests Copyright : © 2020-2023 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) 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.TypeTable <- getdocumentation top Lua.TypeString <- Lua.getfield top "name" forcePeek (peekText 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.3.0/test/HsLua/Packaging/ModuleTests.hs0000644000000000000000000001042207346545000021425 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-| Module : HsLua.Packaging.ModuleTests Copyright : © 2019-2023 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, peekFieldRaw, peekIntegral, peekList, peekName, peekString , pushIntegral, pushText) import HsLua.Packaging.Documentation import HsLua.Packaging.Function import HsLua.Packaging.Module import HsLua.Packaging.UDType (deftype, initType) 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" [ "create produces a table" =: Lua.TypeTable `shouldBeResultOf` do Lua.newtable 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 TypeTable <- getdocumentation top forcePeek $ peekFieldRaw peekString "name" Lua.top , "first function name in docs" =: "factorial" `shouldBeResultOf` do Lua.openlibs registerModule mymath TypeTable <- getdocumentation top TypeTable <- getfield top "functions" TypeTable <- rawgeti top 1 forcePeek $ peekFieldRaw peekString "name" Lua.top , "function doc is shared" =: True `shouldBeResultOf` do Lua.openlibs registerModule mymath pushvalue top setglobal "mymath" -- get doc table via module docs TypeTable <- getdocumentation top TypeTable <- getfield top "functions" TypeTable <- rawgeti top 1 -- get doc table via function OK <- dostring "return mymath.factorial" TypeTable <- getdocumentation top -- must be the same rawequal (nth 1) (nth 3) , "first field name in docs" =: "unit" `shouldBeResultOf` do Lua.openlibs registerModule mymath TypeTable <- getdocumentation top TypeTable <- getfield top "fields" TypeTable <- rawgeti top 1 forcePeek $ peekFieldRaw peekString "name" Lua.top , "document object has associated types" =: ["Void"] `shouldBeResultOf` do Lua.openlibs registerModule mymath TypeTable <- getdocumentation top TypeFunction <- getfield top "types" call 0 1 forcePeek $ peekList peekName top ] ] mymath :: Module Lua.Exception mymath = Module { moduleName = "mymath" , moduleDescription = "A math module." , moduleFields = [ Field "unit" "integer" "additive unit" (pushinteger 1) ] , moduleFunctions = [factorial] , moduleOperations = [ (,) Call $ lambda ### (1 <$ pushText "call me maybe") =?> "call result" ] , moduleTypeInitializers = [initType (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.3.0/test/HsLua/Packaging/RenderingTests.hs0000644000000000000000000000740207346545000022121 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-warnings-deprecations #-} {-| Module : HsLua.Packaging.RenderingTests Copyright : © 2020-2023 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Tests for calling exposed Haskell functions. -} module HsLua.Packaging.RenderingTests (tests) where import Data.Maybe (fromMaybe) import Data.Version (makeVersion) import HsLua.Packaging.Convenience import HsLua.Packaging.Function import HsLua.Packaging.Module import HsLua.Packaging.Rendering import HsLua.Marshalling (peekIntegral, peekRealFloat, pushIntegral, pushRealFloat) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit ((@=?), testCase) import qualified Data.Text as T import qualified HsLua.Core as Lua -- | Calling Haskell functions from Lua. tests :: TestTree tests = testGroup "Rendering" $ let factorialDocs = T.intercalate "\n" [ "factorial (n)" , "" , "Calculates the factorial of a positive integer." , "" , "*Since: 1.0.0*" , "" , "Parameters:" , "" , "n" , ": number for which the factorial is computed (integer)" , "" , "Returns:" , "" , " - factorial (integer)" ] nrootDocs = T.intercalate "\n" [ "nroot (x, n)" , "" , "Parameters:" , "" , "x" , ": (number)" , "" , "n" , ": (integer)" , "" , "Returns:" , "" , " - nth root (number)" ] eulerDocs = T.intercalate "\n" [ "euler_mascheroni" , "" , "Euler-Mascheroni constant" ] in [ testGroup "Function" [ testCase "rendered docs" $ factorialDocs @=? renderFunction factorial ] , testGroup "Module" [ testCase "module docs" (T.unlines [ "# mymath" , "" , "A math module." , "" , "### " `T.append` eulerDocs , "" , "## Functions" , "" , "### " `T.append` factorialDocs , "" , "### " `T.append` nrootDocs ] @=? render mymath) ] ] -- | 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) mymath :: Module Lua.Exception mymath = Module { moduleName = "mymath" , moduleDescription = "A math module." , moduleFields = [euler_mascheroni] , moduleFunctions = [ factorial, nroot ] , moduleOperations = [] , moduleTypeInitializers = [] } -- | Euler-Mascheroni constant euler_mascheroni :: Field Lua.Exception euler_mascheroni = Field { fieldName = "euler_mascheroni" , fieldType = "number" , fieldDescription = "Euler-Mascheroni constant" , fieldPushValue = pushRealFloat @Double 0.57721566490153286060651209008240243 } -- | Calculate the factorial of a number. factorial :: DocumentedFunction Lua.Exception factorial = defun "factorial" ### liftPure (\n -> product [1..n]) <#> factorialParam =#> factorialResult #? "Calculates the factorial of a positive integer." `since` makeVersion [1,0,0] factorialParam :: Parameter Lua.Exception Integer factorialParam = parameter peekIntegral "integer" "n" "number for which the factorial is computed" factorialResult :: FunctionResults Lua.Exception Integer factorialResult = functionResult pushIntegral "integer" "factorial" hslua-packaging-2.3.0/test/HsLua/Packaging/UDTypeTests.hs0000644000000000000000000001017007346545000021352 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-| Module : HsLua.Packaging.UDTypeTests Copyright : © 2020-2023 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.3.0/test/HsLua/0000755000000000000000000000000007346545000014736 5ustar0000000000000000hslua-packaging-2.3.0/test/HsLua/PackagingTests.hs0000644000000000000000000000141207346545000020177 0ustar0000000000000000{-| Module : HsLua.PackagingTests Copyright : © 2020-2023 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.RenderingTests import qualified HsLua.Packaging.UDTypeTests -- | Tests for package creation. tests :: TestTree tests = testGroup "Packaging" [ HsLua.Packaging.FunctionTests.tests , HsLua.Packaging.ModuleTests.tests , HsLua.Packaging.RenderingTests.tests , HsLua.Packaging.UDTypeTests.tests , HsLua.Packaging.DocumentationTests.tests ] hslua-packaging-2.3.0/test/0000755000000000000000000000000007346545000013722 5ustar0000000000000000hslua-packaging-2.3.0/test/test-hslua-packaging.hs0000644000000000000000000000063107346545000020271 0ustar0000000000000000{-| Module : Main Copyright : © 2020-2023 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]