hslua-packaging 2.3.2 → 2.4.0
raw patch · 18 files changed
+481/−539 lines, 18 filesdep ~hslua-objectorientationdep ~hslua-typingPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hslua-objectorientation, hslua-typing
API changes (from Hackage documentation)
- HsLua.Packaging.Documentation: documentation :: LuaError e => DocumentedFunction e
- HsLua.Packaging.Documentation: pushFieldDoc :: LuaError e => Pusher e (Field e)
- HsLua.Packaging.Function: setName :: Name -> DocumentedFunction e -> DocumentedFunction e
- HsLua.Packaging.Module: [fieldDescription] :: Field e -> Text
- HsLua.Packaging.Module: [fieldType] :: Field e -> TypeSpec
- HsLua.Packaging.Rendering: render :: Module e -> Text
- HsLua.Packaging.Rendering: renderFunction :: DocumentedFunction e -> Text
- HsLua.Packaging.Rendering: renderModule :: Module e -> Text
- HsLua.Packaging.Types: FunctionDoc :: Text -> [ParameterDoc] -> ResultsDoc -> Maybe Version -> FunctionDoc
- HsLua.Packaging.Types: [fieldDescription] :: Field e -> Text
- HsLua.Packaging.Types: [fieldType] :: Field e -> TypeSpec
- HsLua.Packaging.Types: [functionDescription] :: FunctionDoc -> Text
- HsLua.Packaging.Types: [functionResultsDocs] :: FunctionDoc -> ResultsDoc
- HsLua.Packaging.Types: [functionSince] :: FunctionDoc -> Maybe Version
- HsLua.Packaging.Types: [parameterDocs] :: FunctionDoc -> [ParameterDoc]
- HsLua.Packaging.UDType: udDocs :: UDTypeGeneric e fn a -> TypeDocs
+ HsLua.Packaging.Documentation: DocObjectFunction :: FunctionDoc -> DocumentationObject
+ HsLua.Packaging.Documentation: DocObjectModule :: ModuleDoc -> DocumentationObject
+ HsLua.Packaging.Documentation: DocObjectType :: TypeDoc -> DocumentationObject
+ HsLua.Packaging.Documentation: FunDoc :: Text -> Text -> [ParameterDoc] -> ResultsDoc -> Maybe Version -> FunctionDoc
+ HsLua.Packaging.Documentation: ModuleDoc :: Text -> Text -> [FieldDoc] -> [FunctionDoc] -> [TypeDoc] -> ModuleDoc
+ HsLua.Packaging.Documentation: [funDocDescription] :: FunctionDoc -> Text
+ HsLua.Packaging.Documentation: [funDocName] :: FunctionDoc -> Text
+ HsLua.Packaging.Documentation: [funDocParameters] :: FunctionDoc -> [ParameterDoc]
+ HsLua.Packaging.Documentation: [funDocResults] :: FunctionDoc -> ResultsDoc
+ HsLua.Packaging.Documentation: [funDocSince] :: FunctionDoc -> Maybe Version
+ HsLua.Packaging.Documentation: [moduleDocDescription] :: ModuleDoc -> Text
+ HsLua.Packaging.Documentation: [moduleDocFields] :: ModuleDoc -> [FieldDoc]
+ HsLua.Packaging.Documentation: [moduleDocFunctions] :: ModuleDoc -> [FunctionDoc]
+ HsLua.Packaging.Documentation: [moduleDocName] :: ModuleDoc -> Text
+ HsLua.Packaging.Documentation: [moduleDocTypes] :: ModuleDoc -> [TypeDoc]
+ HsLua.Packaging.Documentation: data DocumentationObject
+ HsLua.Packaging.Documentation: data FunctionDoc
+ HsLua.Packaging.Documentation: data ModuleDoc
+ HsLua.Packaging.Documentation: generateFunctionDocumentation :: Maybe Name -> DocumentedFunction e -> FunctionDoc
+ HsLua.Packaging.Documentation: generateModuleDocumentation :: Module e -> ModuleDoc
+ HsLua.Packaging.Documentation: generateTypeDocumentation :: DocumentedType e a -> TypeDoc
+ HsLua.Packaging.Documentation: peekDocumentationObject :: Peeker e DocumentationObject
+ HsLua.Packaging.Documentation: peekFunctionDoc :: Peeker e FunctionDoc
+ HsLua.Packaging.Documentation: peekModuleDoc :: Peeker e ModuleDoc
+ HsLua.Packaging.Documentation: peekTypeDoc :: Peeker e TypeDoc
+ HsLua.Packaging.Documentation: pushDocumentationObject :: Pusher e DocumentationObject
+ HsLua.Packaging.Documentation: pushTypeDoc :: Pusher e FunctionDoc
+ HsLua.Packaging.Module: ModuleDoc :: Text -> Text -> [FieldDoc] -> [FunctionDoc] -> [TypeDoc] -> ModuleDoc
+ HsLua.Packaging.Module: [fieldDoc] :: Field e -> FieldDoc
+ HsLua.Packaging.Module: [moduleDocDescription] :: ModuleDoc -> Text
+ HsLua.Packaging.Module: [moduleDocFields] :: ModuleDoc -> [FieldDoc]
+ HsLua.Packaging.Module: [moduleDocFunctions] :: ModuleDoc -> [FunctionDoc]
+ HsLua.Packaging.Module: [moduleDocName] :: ModuleDoc -> Text
+ HsLua.Packaging.Module: [moduleDocTypes] :: ModuleDoc -> [TypeDoc]
+ HsLua.Packaging.Module: [moduleTypeDocs] :: Module e -> [TypeDoc]
+ HsLua.Packaging.Module: associateType :: LuaError e => Module e -> DocumentedType e a -> Module e
+ HsLua.Packaging.Module: class HasDescription a
+ HsLua.Packaging.Module: class HasName a
+ HsLua.Packaging.Module: data ModuleDoc
+ HsLua.Packaging.Module: deffield :: Name -> Field e
+ HsLua.Packaging.Module: defmodule :: Name -> Module e
+ HsLua.Packaging.Module: getDescription :: HasDescription a => a -> Text
+ HsLua.Packaging.Module: getName :: HasName a => a -> Name
+ HsLua.Packaging.Module: infixl 0 `withValue`
+ HsLua.Packaging.Module: renameTo :: HasName a => a -> Name -> a
+ HsLua.Packaging.Module: setDescription :: HasDescription a => a -> Text -> a
+ HsLua.Packaging.Module: setName :: HasName a => a -> Name -> a
+ HsLua.Packaging.Module: withDescription :: HasDescription a => a -> Text -> a
+ HsLua.Packaging.Module: withFields :: Module e -> [Field e] -> Module e
+ HsLua.Packaging.Module: withFunctions :: Module e -> [DocumentedFunction e] -> Module e
+ HsLua.Packaging.Module: withOperations :: Module e -> [(Operation, DocumentedFunction e)] -> Module e
+ HsLua.Packaging.Module: withType :: Field e -> TypeSpec -> Field e
+ HsLua.Packaging.Module: withValue :: Field e -> LuaE e () -> Field e
+ HsLua.Packaging.Types: DocObjectFunction :: FunctionDoc -> DocumentationObject
+ HsLua.Packaging.Types: DocObjectModule :: ModuleDoc -> DocumentationObject
+ HsLua.Packaging.Types: DocObjectType :: TypeDoc -> DocumentationObject
+ HsLua.Packaging.Types: FieldDoc :: Text -> TypeSpec -> Text -> FieldDoc
+ HsLua.Packaging.Types: FunDoc :: Text -> Text -> [ParameterDoc] -> ResultsDoc -> Maybe Version -> FunctionDoc
+ HsLua.Packaging.Types: ModuleDoc :: Text -> Text -> [FieldDoc] -> [FunctionDoc] -> [TypeDoc] -> ModuleDoc
+ HsLua.Packaging.Types: TypeDoc :: Text -> Text -> [(Operation, FunctionDoc)] -> [FunctionDoc] -> TypeDoc
+ HsLua.Packaging.Types: [fieldDocDescription] :: FieldDoc -> Text
+ HsLua.Packaging.Types: [fieldDocName] :: FieldDoc -> Text
+ HsLua.Packaging.Types: [fieldDocType] :: FieldDoc -> TypeSpec
+ HsLua.Packaging.Types: [fieldDoc] :: Field e -> FieldDoc
+ HsLua.Packaging.Types: [funDocDescription] :: FunctionDoc -> Text
+ HsLua.Packaging.Types: [funDocName] :: FunctionDoc -> Text
+ HsLua.Packaging.Types: [funDocParameters] :: FunctionDoc -> [ParameterDoc]
+ HsLua.Packaging.Types: [funDocResults] :: FunctionDoc -> ResultsDoc
+ HsLua.Packaging.Types: [funDocSince] :: FunctionDoc -> Maybe Version
+ HsLua.Packaging.Types: [moduleDocDescription] :: ModuleDoc -> Text
+ HsLua.Packaging.Types: [moduleDocFields] :: ModuleDoc -> [FieldDoc]
+ HsLua.Packaging.Types: [moduleDocFunctions] :: ModuleDoc -> [FunctionDoc]
+ HsLua.Packaging.Types: [moduleDocName] :: ModuleDoc -> Text
+ HsLua.Packaging.Types: [moduleDocTypes] :: ModuleDoc -> [TypeDoc]
+ HsLua.Packaging.Types: [moduleTypeDocs] :: Module e -> [TypeDoc]
+ HsLua.Packaging.Types: [typeDocDescription] :: TypeDoc -> Text
+ HsLua.Packaging.Types: [typeDocMethods] :: TypeDoc -> [FunctionDoc]
+ HsLua.Packaging.Types: [typeDocName] :: TypeDoc -> Text
+ HsLua.Packaging.Types: [typeDocOperations] :: TypeDoc -> [(Operation, FunctionDoc)]
+ HsLua.Packaging.Types: class HasDescription a
+ HsLua.Packaging.Types: class HasName a
+ HsLua.Packaging.Types: data DocumentationObject
+ HsLua.Packaging.Types: data FieldDoc
+ HsLua.Packaging.Types: data ModuleDoc
+ HsLua.Packaging.Types: data TypeDoc
+ HsLua.Packaging.Types: getDescription :: HasDescription a => a -> Text
+ HsLua.Packaging.Types: getName :: HasName a => a -> Name
+ HsLua.Packaging.Types: instance GHC.Classes.Eq HsLua.Packaging.Types.DocumentationObject
+ HsLua.Packaging.Types: instance GHC.Classes.Eq HsLua.Packaging.Types.FieldDoc
+ HsLua.Packaging.Types: instance GHC.Classes.Eq HsLua.Packaging.Types.ModuleDoc
+ HsLua.Packaging.Types: instance GHC.Classes.Eq HsLua.Packaging.Types.TypeDoc
+ HsLua.Packaging.Types: instance GHC.Classes.Ord HsLua.Packaging.Types.DocumentationObject
+ HsLua.Packaging.Types: instance GHC.Classes.Ord HsLua.Packaging.Types.FieldDoc
+ HsLua.Packaging.Types: instance GHC.Classes.Ord HsLua.Packaging.Types.ModuleDoc
+ HsLua.Packaging.Types: instance GHC.Classes.Ord HsLua.Packaging.Types.TypeDoc
+ HsLua.Packaging.Types: instance GHC.Show.Show HsLua.Packaging.Types.DocumentationObject
+ HsLua.Packaging.Types: instance GHC.Show.Show HsLua.Packaging.Types.FieldDoc
+ HsLua.Packaging.Types: instance GHC.Show.Show HsLua.Packaging.Types.ModuleDoc
+ HsLua.Packaging.Types: instance GHC.Show.Show HsLua.Packaging.Types.TypeDoc
+ HsLua.Packaging.Types: instance HsLua.Packaging.Types.HasDescription (HsLua.Packaging.Types.Field e)
+ HsLua.Packaging.Types: instance HsLua.Packaging.Types.HasDescription (HsLua.Packaging.Types.Module e)
+ HsLua.Packaging.Types: instance HsLua.Packaging.Types.HasDescription HsLua.Packaging.Types.FieldDoc
+ HsLua.Packaging.Types: instance HsLua.Packaging.Types.HasDescription HsLua.Packaging.Types.ModuleDoc
+ HsLua.Packaging.Types: instance HsLua.Packaging.Types.HasName (HsLua.Packaging.Types.DocumentedFunction e)
+ HsLua.Packaging.Types: instance HsLua.Packaging.Types.HasName (HsLua.Packaging.Types.Field e)
+ HsLua.Packaging.Types: instance HsLua.Packaging.Types.HasName (HsLua.Packaging.Types.Module e)
+ HsLua.Packaging.Types: setDescription :: HasDescription a => a -> Text -> a
+ HsLua.Packaging.Types: setName :: HasName a => a -> Name -> a
+ HsLua.Packaging.Types: type DocumentedType e a = UDType e DocumentedFunction e a
- HsLua.Packaging.Documentation: pushFunctionDoc :: LuaError e => Pusher e (DocumentedFunction e)
+ HsLua.Packaging.Documentation: pushFunctionDoc :: Pusher e FunctionDoc
- HsLua.Packaging.Documentation: pushModuleDoc :: LuaError e => Pusher e (Module e)
+ HsLua.Packaging.Documentation: pushModuleDoc :: Pusher e ModuleDoc
- HsLua.Packaging.Module: Field :: Text -> TypeSpec -> Text -> LuaE e () -> Field e
+ HsLua.Packaging.Module: Field :: Name -> FieldDoc -> LuaE e () -> Field e
- HsLua.Packaging.Module: Module :: Name -> Text -> [Field e] -> [DocumentedFunction e] -> [(Operation, DocumentedFunction e)] -> [LuaE e Name] -> Module e
+ HsLua.Packaging.Module: Module :: Name -> Text -> [Field e] -> [DocumentedFunction e] -> [(Operation, DocumentedFunction e)] -> [LuaE e Name] -> [TypeDoc] -> Module e
- HsLua.Packaging.Module: [fieldName] :: Field e -> Text
+ HsLua.Packaging.Module: [fieldName] :: Field e -> Name
- HsLua.Packaging.Types: Field :: Text -> TypeSpec -> Text -> LuaE e () -> Field e
+ HsLua.Packaging.Types: Field :: Name -> FieldDoc -> LuaE e () -> Field e
- HsLua.Packaging.Types: Module :: Name -> Text -> [Field e] -> [DocumentedFunction e] -> [(Operation, DocumentedFunction e)] -> [LuaE e Name] -> Module e
+ HsLua.Packaging.Types: Module :: Name -> Text -> [Field e] -> [DocumentedFunction e] -> [(Operation, DocumentedFunction e)] -> [LuaE e Name] -> [TypeDoc] -> Module e
- HsLua.Packaging.Types: [fieldName] :: Field e -> Text
+ HsLua.Packaging.Types: [fieldName] :: Field e -> Name
Files
- CHANGELOG.md +29/−0
- LICENSE +1/−1
- hslua-packaging.cabal +9/−16
- src/HsLua/Packaging.hs +3/−1
- src/HsLua/Packaging/Convenience.hs +1/−1
- src/HsLua/Packaging/Documentation.hs +130/−95
- src/HsLua/Packaging/Function.hs +16/−19
- src/HsLua/Packaging/Module.hs +110/−37
- src/HsLua/Packaging/Rendering.hs +0/−143
- src/HsLua/Packaging/Types.hs +117/−14
- src/HsLua/Packaging/UDType.hs +3/−6
- test/HsLua/Packaging/DocumentationTests.hs +10/−17
- test/HsLua/Packaging/FunctionTests.hs +5/−5
- test/HsLua/Packaging/ModuleTests.hs +44/−38
- test/HsLua/Packaging/RenderingTests.hs +0/−141
- test/HsLua/Packaging/UDTypeTests.hs +1/−1
- test/HsLua/PackagingTests.hs +1/−3
- test/test-hslua-packaging.hs +1/−1
CHANGELOG.md view
@@ -2,6 +2,35 @@ `hslua-packaging` uses [PVP Versioning][]. +## 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.
LICENSE view
@@ -1,4 +1,4 @@-Copyright © 2019-2024 Albert Krewinkel+Copyright © 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
hslua-packaging.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: hslua-packaging-version: 2.3.2+version: 2.4.0 synopsis: Utilities to build Lua modules. description: Utilities to package up Haskell functions and values into a Lua module.@@ -14,19 +14,14 @@ license-file: LICENSE author: Albert Krewinkel maintainer: tarleb@hslua.org-copyright: © 2019-2024 Albert Krewinkel+copyright: © 2019-2026 Albert Krewinkel category: Foreign extra-source-files: README.md , CHANGELOG.md-tested-with: GHC == 8.8.4- , GHC == 8.10.3- , GHC == 9.0.2- , GHC == 9.2.8- , GHC == 9.4.8- , GHC == 9.6.7- , GHC == 9.8.4- , GHC == 9.10.2- , GHC == 9.12.2+tested-with: GHC == 9.6+ , GHC == 9.8+ , GHC == 9.10+ , GHC == 9.12 source-repository head type: git@@ -38,7 +33,6 @@ build-depends: base >= 4.11 && < 5 , hslua-core >= 2.2.1 && < 2.4 , hslua-marshalling >= 2.2.1 && < 2.4- , text >= 1.2 && < 2.2 ghc-options: -Wall -Wcpp-undef@@ -62,7 +56,6 @@ , HsLua.Packaging.Documentation , HsLua.Packaging.Function , HsLua.Packaging.Module- , HsLua.Packaging.Rendering , HsLua.Packaging.Types , HsLua.Packaging.UDType hs-source-dirs: src@@ -71,8 +64,9 @@ other-extensions: DeriveFunctor , OverloadedStrings build-depends: containers >= 0.5.9 && < 0.9- , hslua-objectorientation >= 2.4 && < 2.5- , hslua-typing >= 0.1 && < 0.2+ , 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@@ -84,7 +78,6 @@ , HsLua.Packaging.DocumentationTests , HsLua.Packaging.FunctionTests , HsLua.Packaging.ModuleTests- , HsLua.Packaging.RenderingTests , HsLua.Packaging.UDTypeTests build-depends: hslua-packaging , bytestring
src/HsLua/Packaging.hs view
@@ -1,6 +1,6 @@ {-| Module : HsLua.Packaging-Copyright : © 2019-2024 Albert Krewinkel+Copyright : © 2019-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <tarleb@hslua.org> @@ -17,6 +17,7 @@ , module HsLua.Packaging.Documentation -- * Types , module HsLua.Packaging.Types+ , module HsLua.Typing ) where import HsLua.Packaging.Convenience@@ -25,3 +26,4 @@ import HsLua.Packaging.Module import HsLua.Packaging.UDType import HsLua.Packaging.Types+import HsLua.Typing
src/HsLua/Packaging/Convenience.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.Convenience-Copyright : © 2021-2024 Albert Krewinkel+Copyright : © 2021-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <tarleb@hslua.org>
src/HsLua/Packaging/Documentation.hs view
@@ -1,57 +1,43 @@ {-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.Documentation-Copyright : © 2020-2024 Albert Krewinkel+Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <tarleb@hslua.org> Provides a function to print documentation if available. -} module HsLua.Packaging.Documentation- ( documentation- , getdocumentation+ ( -- * Setting and retrieving documentation+ getdocumentation , registerDocumentation+ , docsField+ -- * Documentation Types+ , ModuleDoc (..)+ , FunctionDoc (..)+ , DocumentationObject (..)+ , pushDocumentationObject+ , peekDocumentationObject , pushModuleDoc+ , peekModuleDoc , pushFunctionDoc- , pushFieldDoc- , docsField+ , peekFunctionDoc+ , pushTypeDoc+ , peekTypeDoc+ -- * Creating documentation values+ , generateFunctionDocumentation+ , generateModuleDocumentation+ , generateTypeDocumentation ) where -import Data.Version (showVersion)+import Control.Monad (void) import HsLua.Core as Lua import HsLua.Marshalling+import HsLua.ObjectOrientation (UDTypeGeneric (..)) 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+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.@@ -76,6 +62,15 @@ 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@@ -94,68 +89,108 @@ 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"+-- Generating+-- --- | 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)- ]+-- | 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+ } --- | 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)- ]+-- | 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 } --- | 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)+-- | 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 } --- | 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)- ]+-- | 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)+ } --- | 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+-- | Convert a Lua name to UTF-8 text.+nameToText :: Name -> T.Text+nameToText = Utf8.toText . fromName --- | 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)- ]+--+-- 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 :: Pusher e DocumentationObject+pushDocumentationObject obj = do+ newhsuserdatauv obj 0+ pushDocumentationObjectMT+ setmetatable (nth 2)++-- | Pushes the metatable for documentation objects.+pushDocumentationObjectMT :: LuaE e ()+pushDocumentationObjectMT = void $ newudmetatable documentationObjectName++-- | Pushes the documentation of a module as userdata.+pushModuleDoc :: 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 :: 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 :: 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"
src/HsLua/Packaging/Function.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.Function-Copyright : © 2020-2024 Albert Krewinkel+Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <tarleb@hslua.org> Stability : alpha@@ -37,7 +37,6 @@ , (=?>) , (#?) -- * Modifying functions- , setName , since -- * Pushing to Lua , pushDocumentedFunction@@ -188,11 +187,12 @@ 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+ , functionDoc = FunDoc+ { funDocName = Utf8.toText . fromName $ hsFnName bldr+ , funDocDescription = ""+ , funDocParameters = reverse $ hsFnParameterDocs bldr+ , funDocResults = ResultsDocList $ map fnResultDoc fnResults+ , funDocSince = Nothing } } @@ -213,11 +213,12 @@ Lua.error Right x -> x , functionName = hsFnName bldr- , functionDoc = FunctionDoc- { functionDescription = ""- , parameterDocs = reverse $ hsFnParameterDocs bldr- , functionResultsDocs = ResultsDocMult desc- , functionSince = Nothing+ , functionDoc = FunDoc+ { funDocName = Utf8.toText . fromName $ hsFnName bldr+ , funDocDescription = ""+ , funDocParameters = reverse $ hsFnParameterDocs bldr+ , funDocResults = ResultsDocMult desc+ , funDocSince = Nothing } } @@ -234,18 +235,14 @@ -> 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 }+ 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 { functionSince = Just version }}+ in fn { functionDoc = fnDoc { funDocSince = Just version }} -- -- Operators@@ -291,7 +288,7 @@ => DocumentedFunction e -> LuaE e () pushDocumentedFunction fn = do Lua.pushHaskellFunction $ callFunction fn -- push function- pushFunctionDoc fn -- function documentation+ pushFunctionDoc $ functionDoc fn -- function documentation registerDocumentation (Lua.nth 2) -- store documentation --
src/HsLua/Packaging/Module.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.Module-Copyright : © 2019-2024 Albert Krewinkel+Copyright : © 2019-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <tarleb@hslua.org> Stability : alpha@@ -12,7 +12,25 @@ 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@@ -22,13 +40,94 @@ where import Control.Monad (forM_)+import Data.Text (Text) import HsLua.Core-import HsLua.Marshalling (Pusher, pushAsTable, pushList, pushName, pushText)+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@@ -56,46 +155,25 @@ 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+ pushModuleDoc (generateModuleDocumentation mdl) 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+ forM_ (moduleFunctions mdl) $ \fn -> do -- 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+ -- push documented function, thereby registering the function docs+ Fun.pushDocumentedFunction fn+ rawset (nth 3) -- module table -- # Fields --- forM_ (moduleFields mdl) $ \field -> do- pushText (fieldName field)- fieldPushValue field+ forM_ (moduleFields mdl) $ \fld -> do+ pushName (fieldName fld)+ fieldPushValue fld rawset (nth 3) case moduleOperations mdl of [] -> pure ()@@ -104,11 +182,6 @@ newtable forM_ ops $ \(op, fn) -> do pushName $ metamethodName op- Fun.pushDocumentedFunction $ Fun.setName "" fn+ Fun.pushDocumentedFunction $ fn `setName` "" rawset (nth 3) setmetatable (nth 2)--pushTypesFunction :: LuaError e => Pusher e [LuaE e Name]-pushTypesFunction initializers = pushHaskellFunction $ do- sequence initializers >>= pushList pushName- pure 1
− src/HsLua/Packaging/Rendering.hs
@@ -1,143 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-|-Module : HsLua.Packaging.Rendering-Copyright : © 2020-2024 Albert Krewinkel-License : MIT-Maintainer : Albert Krewinkel <tarleb@hslua.org>-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 "<anonymous function>"- 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 " ")
src/HsLua/Packaging/Types.hs view
@@ -1,6 +1,6 @@ {-| Module : HsLua.Packaging.Types-Copyright : © 2020-2024 Albert Krewinkel+Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <tarleb@hslua.org> Stability : alpha@@ -9,24 +9,35 @@ Marshaling and documenting Haskell functions. -} module HsLua.Packaging.Types- ( -- * Documented module+ ( -- * Documented Lua objects Module (..) , Field (..)- -- * Documented functions , DocumentedFunction (..)- -- ** Documentation types+ , 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, NumResults)-import HsLua.ObjectOrientation (Operation)+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@@ -35,13 +46,16 @@ , 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 :: Text- , fieldType :: TypeSpec- , fieldDescription :: Text+ { fieldName :: Name+ , fieldDoc :: FieldDoc , fieldPushValue :: LuaE e () } @@ -61,12 +75,23 @@ -- 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 = FunctionDoc- { functionDescription :: Text- , parameterDocs :: [ParameterDoc]- , functionResultsDocs :: ResultsDoc- , functionSince :: Maybe Version -- ^ Version in which the 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)@@ -92,3 +117,81 @@ , 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 }+ }
src/HsLua/Packaging/UDType.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-| Module : HsLua.Packaging.UDType-Copyright : © 2020-2024 Albert Krewinkel+Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <tarleb@hslua.org> @@ -31,7 +31,6 @@ , initType -- Reexported from ObjectOrientation , udparam , udresult- , udDocs , udTypeSpec -- * Helper types for building , Member@@ -47,12 +46,10 @@ 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 --- | 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@@ -92,7 +89,7 @@ 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+operation op f = (,) op $ f `setName` metamethodName op -- | Defines a function parameter that takes the given type. udparam :: LuaError e
test/HsLua/Packaging/DocumentationTests.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE TypeApplications #-} {-| Module : HsLua.Packaging.DocumentationTests-Copyright : © 2021-2024 Albert Krewinkel+Copyright : © 2021-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <tarleb@hslua.org> @@ -11,10 +11,10 @@ module HsLua.Packaging.DocumentationTests (tests) where import Data.Version (makeVersion)-import HsLua.Core (top, Status (OK), Type (TypeNil, TypeString))+import HsLua.Core (top, Status (OK)) import HsLua.Packaging.Documentation import HsLua.Packaging.Function-import HsLua.Marshalling (forcePeek, peekIntegral, pushIntegral, peekText)+import HsLua.Marshalling (peekIntegral, pushIntegral) import Test.Tasty.HsLua ((=:), shouldBeResultOf) import Test.Tasty (TestTree, testGroup) @@ -23,23 +23,16 @@ -- | Calling Haskell functions from Lua. tests :: TestTree tests = testGroup "Documentation"- [ testGroup "Function docs"- [ "retrieves function docs" =:- "factorial" `shouldBeResultOf` do+ [ testGroup "getdocumentation"+ [ "retrieves function docs as userdata" =:+ Lua.TypeUserdata `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+ getdocumentation 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+ Lua.TypeNil `shouldBeResultOf` do+ OK <- Lua.dostring "return function () return 1 end"+ getdocumentation top ] ]
test/HsLua/Packaging/FunctionTests.hs view
@@ -1,8 +1,9 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-| Module : HsLua.Packaging.FunctionTests-Copyright : © 2020-2024 Albert Krewinkel+Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <tarleb@hslua.org> @@ -14,7 +15,7 @@ import Data.Version (makeVersion) import HsLua.Core (StackIndex, top) import HsLua.Packaging.Convenience-import HsLua.Packaging.Documentation (getdocumentation)+import HsLua.Packaging.Documentation (getdocumentation, peekFunctionDoc) import HsLua.Packaging.Function import HsLua.Packaging.Types import HsLua.Marshalling@@ -96,9 +97,8 @@ , "getdocumentation" =: "factorial" `shouldBeResultOf` do pushDocumentedFunction (factLuaAtIndex 0)- Lua.TypeTable <- getdocumentation top- Lua.TypeString <- Lua.getfield top "name"- forcePeek (peekText top)+ Lua.TypeUserdata <- getdocumentation top+ forcePeek (funDocName <$> peekFunctionDoc top) , "undocumented value" =: Lua.TypeNil `shouldBeResultOf` do
test/HsLua/Packaging/ModuleTests.hs view
@@ -1,8 +1,9 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-| Module : HsLua.Packaging.ModuleTests-Copyright : © 2019-2024 Albert Krewinkel+Copyright : © 2019-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <tarleb@hslua.org> Stability : alpha@@ -14,12 +15,12 @@ import HsLua.Core import HsLua.Marshalling- ( forcePeek, peekFieldRaw, peekIntegral, peekList, peekName, peekString- , pushIntegral, pushText)+ ( forcePeek, peekIntegral, peekString, pushIntegral, pushText ) import HsLua.Packaging.Documentation import HsLua.Packaging.Function import HsLua.Packaging.Module-import HsLua.Packaging.UDType (deftype, initType)+import HsLua.Packaging.UDType (deftype)+import HsLua.Packaging.Types import Test.Tasty.HsLua ((=:), shouldBeResultOf) import Test.Tasty (TestTree, testGroup) @@ -29,9 +30,9 @@ tests :: TestTree tests = testGroup "Module" [ testGroup "creation helpers"- [ "create produces a table" =:+ [ "pushing a module produces a table" =: Lua.TypeTable `shouldBeResultOf` do- Lua.newtable+ pushModule $ defmodule "test" Lua.ltype Lua.top ] , testGroup "module type"@@ -64,17 +65,18 @@ "mymath" `shouldBeResultOf` do Lua.openlibs registerModule mymath- TypeTable <- getdocumentation top- forcePeek $ peekFieldRaw peekString "name" Lua.top+ TypeUserdata <- getdocumentation top+ forcePeek $ moduleDocName <$> peekModuleDoc Lua.top - , "first function name in docs" =:- "factorial" `shouldBeResultOf` do+ , "function name in docs is prefixed with module name" =:+ "mymath.factorial" `shouldBeResultOf` do Lua.openlibs registerModule mymath- TypeTable <- getdocumentation top- TypeTable <- getfield top "functions"- TypeTable <- rawgeti top 1- forcePeek $ peekFieldRaw peekString "name" Lua.top+ 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@@ -83,50 +85,54 @@ 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+ 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"- TypeTable <- getdocumentation top+ TypeUserdata <- getdocumentation top+ fndoc' <- forcePeek $ peekFunctionDoc Lua.top -- must be the same- rawequal (nth 1) (nth 3)+ return (fndoc == fndoc') , "first field name in docs" =:- "unit" `shouldBeResultOf` do+ "mymath.unit" `shouldBeResultOf` do Lua.openlibs registerModule mymath- TypeTable <- getdocumentation top- TypeTable <- getfield top "fields"- TypeTable <- rawgeti top 1- forcePeek $ peekFieldRaw peekString "name" Lua.top+ 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- TypeTable <- getdocumentation top- TypeFunction <- getfield top "types"- call 0 1- forcePeek $ peekList peekName top+ TypeUserdata <- getdocumentation top+ mdl <- forcePeek $ peekModuleDoc Lua.top+ return . map typeDocName $ moduleDocTypes mdl ] ] mymath :: Module Lua.Exception-mymath = Module- { moduleName = "mymath"- , moduleDescription = "A math module."- , moduleFields = [- Field "unit" "integer" "additive unit" (pushinteger 1)+mymath = defmodule "mymath"+ `withFields`+ [ deffield "unit"+ `withType` "integer"+ `withDescription` "additive unit"+ `withValue` pushinteger 1 ]- , moduleFunctions = [factorial]- , moduleOperations =+ `withFunctions` [factorial]+ `withOperations` [ (,) Call $ lambda ### (1 <$ pushText "call me maybe") =?> "call result" ]- , moduleTypeInitializers = [initType (deftype "Void" [] [])]- }+ `associateType` deftype "Void" [] [] factorial :: DocumentedFunction Lua.Exception factorial =
− test/HsLua/Packaging/RenderingTests.hs
@@ -1,141 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}-{-# OPTIONS_GHC -Wno-warnings-deprecations #-}-{-|-Module : HsLua.Packaging.RenderingTests-Copyright : © 2020-2024 Albert Krewinkel-License : MIT-Maintainer : Albert Krewinkel <tarleb@hslua.org>--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"
test/HsLua/Packaging/UDTypeTests.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE TypeApplications #-} {-| Module : HsLua.Packaging.UDTypeTests-Copyright : © 2020-2024 Albert Krewinkel+Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <tarleb@hslua.org>
test/HsLua/PackagingTests.hs view
@@ -1,6 +1,6 @@ {-| Module : HsLua.PackagingTests-Copyright : © 2020-2024 Albert Krewinkel+Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <tarleb@hslua.org> @@ -12,7 +12,6 @@ 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.@@ -20,7 +19,6 @@ tests = testGroup "Packaging" [ HsLua.Packaging.FunctionTests.tests , HsLua.Packaging.ModuleTests.tests- , HsLua.Packaging.RenderingTests.tests , HsLua.Packaging.UDTypeTests.tests , HsLua.Packaging.DocumentationTests.tests ]
test/test-hslua-packaging.hs view
@@ -1,6 +1,6 @@ {-| Module : Main-Copyright : © 2020-2024 Albert Krewinkel+Copyright : © 2020-2026 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel <tarleb@hslua.org>