packages feed

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 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>