Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-hslua-packaging for
openSUSE:Factory checked in at 2026-06-10 16:02:03
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-hslua-packaging (Old)
and /work/SRC/openSUSE:Factory/.ghc-hslua-packaging.new.2375 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-hslua-packaging"
Wed Jun 10 16:02:03 2026 rev:8 rq:1358391 version:2.4.1
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-hslua-packaging/ghc-hslua-packaging.changes
2025-07-02 12:09:18.378227016 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-hslua-packaging.new.2375/ghc-hslua-packaging.changes
2026-06-10 16:04:33.457073920 +0200
@@ -1,0 +2,41 @@
+Tue Jan 13 07:50:57 UTC 2026 - Peter Simons <[email protected]>
+
+- Update hslua-packaging to version 2.4.1.
+ ## hslua-packaging-2.4.1
+
+ Released 2026-01-13.
+
+ - Modified Lua documentation objects: calling the userdata objects
+ now returns a table with all the info from the documentation
+ object.
+
+ ## hslua-packaging-2.4.0
+
+ Released 2026-01-08.
+
+ - Modified the *FunctionDoc* type: added the function name to the
+ type and changed field names to be more consistent.
+
+ - Added function `peekFunctionDoc` to retrieve function
+ documentation from the Lua stack.
+
+ - Added a new data type `FieldDoc` that contains all the
+ documentation for a module field. The `Field` type was modified
+ to use this type for docs.
+
+ - Fields and modules should no longer use the data type
+ constructor directly. Instead, values should be created through
+ the newly introduced functions `deffield`, `withName`,
+ `withValue`, and `withDescription` for fields, and `defmodule`,
+ `withFields`, `withFunctions`, `withOperations`, `withDescription`,
+ and `associateType` for modules.
+
+ - The module *HsLua.Typing* is re-exported from *HsLua.Packaging*.
+
+ - Modules have an additional field `moduleTypeDocs`.
+
+ - Require *hslua-objectorientation* 2.5.0.
+
+ - Allow *hslua-typing* 0.2.\*.
+
+-------------------------------------------------------------------
Old:
----
hslua-packaging-2.3.2.tar.gz
New:
----
hslua-packaging-2.4.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-hslua-packaging.spec ++++++
--- /var/tmp/diff_new_pack.73yzpU/_old 2026-06-10 16:04:35.597162606 +0200
+++ /var/tmp/diff_new_pack.73yzpU/_new 2026-06-10 16:04:35.601162772 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-hslua-packaging
#
-# Copyright (c) 2025 SUSE LLC
+# Copyright (c) 2026 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -20,7 +20,7 @@
%global pkgver %{pkg_name}-%{version}
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.3.2
+Version: 2.4.1
Release: 0
Summary: Utilities to build Lua modules
License: MIT
++++++ hslua-packaging-2.3.2.tar.gz -> hslua-packaging-2.4.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-packaging-2.3.2/CHANGELOG.md
new/hslua-packaging-2.4.1/CHANGELOG.md
--- old/hslua-packaging-2.3.2/CHANGELOG.md 2001-09-09 03:46:40.000000000
+0200
+++ new/hslua-packaging-2.4.1/CHANGELOG.md 2001-09-09 03:46:40.000000000
+0200
@@ -2,6 +2,43 @@
`hslua-packaging` uses [PVP Versioning][].
+## hslua-packaging-2.4.1
+
+Released 2026-01-13.
+
+- Modified Lua documentation objects: calling the userdata objects
+ now returns a table with all the info from the documentation
+ object.
+
+## hslua-packaging-2.4.0
+
+Released 2026-01-08.
+
+- Modified the *FunctionDoc* type: added the function name to the
+ type and changed field names to be more consistent.
+
+- Added function `peekFunctionDoc` to retrieve function
+ documentation from the Lua stack.
+
+- Added a new data type `FieldDoc` that contains all the
+ documentation for a module field. The `Field` type was modified
+ to use this type for docs.
+
+- Fields and modules should no longer use the data type
+ constructor directly. Instead, values should be created through
+ the newly introduced functions `deffield`, `withName`,
+ `withValue`, and `withDescription` for fields, and `defmodule`,
+ `withFields`, `withFunctions`, `withOperations`, `withDescription`,
+ and `associateType` for modules.
+
+- The module *HsLua.Typing* is re-exported from *HsLua.Packaging*.
+
+- Modules have an additional field `moduleTypeDocs`.
+
+- Require *hslua-objectorientation* 2.5.0.
+
+- Allow *hslua-typing* 0.2.\*.
+
## hslua-packaging-2.3.2
Released 2025-06-23.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-packaging-2.3.2/LICENSE
new/hslua-packaging-2.4.1/LICENSE
--- old/hslua-packaging-2.3.2/LICENSE 2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/LICENSE 2001-09-09 03:46:40.000000000 +0200
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-packaging-2.3.2/hslua-packaging.cabal
new/hslua-packaging-2.4.1/hslua-packaging.cabal
--- old/hslua-packaging-2.3.2/hslua-packaging.cabal 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/hslua-packaging.cabal 2001-09-09
03:46:40.000000000 +0200
@@ -1,6 +1,6 @@
cabal-version: 2.2
name: hslua-packaging
-version: 2.3.2
+version: 2.4.1
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: [email protected]
-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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-packaging-2.3.2/src/HsLua/Packaging/Convenience.hs
new/hslua-packaging-2.4.1/src/HsLua/Packaging/Convenience.hs
--- old/hslua-packaging-2.3.2/src/HsLua/Packaging/Convenience.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/src/HsLua/Packaging/Convenience.hs
2001-09-09 03:46:40.000000000 +0200
@@ -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 <[email protected]>
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-packaging-2.3.2/src/HsLua/Packaging/Documentation.hs
new/hslua-packaging-2.4.1/src/HsLua/Packaging/Documentation.hs
--- old/hslua-packaging-2.3.2/src/HsLua/Packaging/Documentation.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/src/HsLua/Packaging/Documentation.hs
2001-09-09 03:46:40.000000000 +0200
@@ -1,57 +1,44 @@
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : HsLua.Packaging.Documentation
-Copyright : © 2020-2024 Albert Krewinkel
+Copyright : © 2020-2026 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
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 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 +63,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,50 +90,161 @@
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
+--
+
+-- | Generate documentation for a module.
+generateModuleDocumentation :: Module e -> ModuleDoc
+generateModuleDocumentation mdl =
+ let name = moduleName mdl
+ in ModuleDoc
+ { moduleDocName = nameToText name
+ , moduleDocDescription = moduleDescription mdl
+ , moduleDocFields = map (generateFieldDocumentation name) $ moduleFields
mdl
+ , moduleDocFunctions = map (generateFunctionDocumentation Nothing) $
+ moduleFunctions mdl
+ , moduleDocTypes = moduleTypeDocs mdl
+ }
+
+-- | Generate 'FieldDoc' documentation for a module field.
+generateFieldDocumentation :: Name -- ^ module name
+ -> Field e -- ^ field that's part of the module
+ -> FieldDoc
+generateFieldDocumentation mdlName fld =
+ let doc = fieldDoc fld
+ in doc { fieldDocName = nameToText mdlName <> "." <> fieldDocName doc }
+
+-- | Generate 'FunctionDoc' documentation for module functions.
+generateFunctionDocumentation :: Maybe Name
+ -> DocumentedFunction e
+ -> FunctionDoc
+generateFunctionDocumentation name fn =
+ let doc = functionDoc fn
+ prefix = maybe mempty (\n -> nameToText n <> ".") name
+ in doc { funDocName = prefix <> funDocName doc }
+
+-- | Generate documentation for a 'UDType'.
+generateTypeDocumentation :: DocumentedType e a -> TypeDoc
+generateTypeDocumentation ty =
+ let name = udName ty
+ in TypeDoc
+ { typeDocName = nameToText name
+ , typeDocDescription = ""
+ , typeDocOperations = []
+ , typeDocMethods = map (generateFunctionDocumentation (Just name) . snd) $
+ Map.toList (udMethods ty)
+ }
+
+-- | Convert a Lua name to UTF-8 text.
+nameToText :: Name -> T.Text
+nameToText = Utf8.toText . fromName
+
+--
+-- Retrieving and pushing documentation
+--
+
+-- | The metatable name of documentation objecs
+documentationObjectName :: Name
+documentationObjectName = "HsLua DocumentationObject"
+
+-- | Pushes the metatable for documentation objects.
+peekDocumentationObject :: Peeker e DocumentationObject
+peekDocumentationObject idx = do
+ liftLua (fromuserdata idx documentationObjectName) >>= \case
+ Nothing -> failPeek "Not a documentation object"
+ Just doc -> pure doc
+
+-- | Pushes a 'DocumentationObject' to the Lua stack.
+pushDocumentationObject :: LuaError e => Pusher e DocumentationObject
+pushDocumentationObject obj = do
+ newhsuserdatauv obj 0
+ pushDocumentationObjectMT
+ setmetatable (nth 2)
+
+-- | Pushes the metatable for documentation objects.
+pushDocumentationObjectMT :: LuaError e => LuaE e ()
+pushDocumentationObjectMT = newudmetatable documentationObjectName >>= \case
+ False -> return ()
+ True -> do -- newly created metatable at the top of the stack
+ -- Allow to "call" the documentation object, in which case it should
+ -- return a Lua table that has all the relevant info.
+ pushHaskellFunction $ do
+ -- object is the first argument
+ forcePeek (peekDocumentationObject (nthBottom 1)) >>= \case
+ DocObjectFunction fn -> pushFunctionDocAsTable fn
+ DocObjectModule mdl -> pushModuleDocAsTable mdl
+ DocObjectType ty -> pushTypeDocAsTable ty
+ return (NumResults 1)
+ setfield (nth 2) "__call"
+
+-- | Pushes the documentation of a module as userdata.
+pushModuleDoc :: LuaError e => Pusher e ModuleDoc
+pushModuleDoc = pushDocumentationObject . DocObjectModule
+
+-- | Retrieves a module documentation object from the Lua stack.
+peekModuleDoc :: Peeker e ModuleDoc
+peekModuleDoc idx = peekDocumentationObject idx >>= \case
+ DocObjectModule mdldoc -> pure mdldoc
+ _ -> failPeek "Not a module documentation object"
+
+-- | Pushes function documentation as userdata.
+pushFunctionDoc :: LuaError e => Pusher e FunctionDoc
+pushFunctionDoc = pushDocumentationObject . DocObjectFunction
+
+-- | Retrieve function documentation from the Lua stack.
+peekFunctionDoc :: Peeker e FunctionDoc
+peekFunctionDoc idx = peekDocumentationObject idx >>= \case
+ DocObjectFunction fndoc -> pure fndoc
+ _ -> failPeek "Not a function documentation"
+
+-- | Pushes documentation type documentation as userdata.
+pushTypeDoc :: LuaError e => Pusher e FunctionDoc
+pushTypeDoc = pushDocumentationObject . DocObjectFunction
+
+-- | Retrieve function documentation from the Lua stack.
+peekTypeDoc :: Peeker e TypeDoc
+peekTypeDoc idx = peekDocumentationObject idx >>= \case
+ DocObjectType tydoc -> pure tydoc
+ _ -> failPeek "Not a type documentation"
+
-- | Pushes the documentation of a module as a table with string fields
-- @name@ and @description@.
-pushModuleDoc :: LuaError e => Pusher e (Module e)
-pushModuleDoc = pushAsTable
- [ ("name", pushName . moduleName)
- , ("description", pushText . moduleDescription)
- , ("fields", pushList pushFieldDoc . moduleFields)
- , ("functions", pushList pushFunctionDoc . moduleFunctions)
+pushModuleDocAsTable :: LuaError e => Pusher e ModuleDoc
+pushModuleDocAsTable = pushAsTable
+ [ ("name", pushText . moduleDocName)
+ , ("description", pushText . moduleDocDescription)
+ , ("fields", pushList pushFieldDocAsTable . moduleDocFields)
+ , ("functions", pushList pushFunctionDocAsTable . moduleDocFunctions)
+ , ("types", pushList pushTypeDocAsTable . moduleDocTypes)
]
-- | Pushes the documentation of a field as a table with string fields
-- @name@ and @description@.
-pushFieldDoc :: LuaError e => Pusher e (Field e)
-pushFieldDoc = pushAsTable
- [ ("name", pushText . fieldName)
- , ("type", pushTypeSpec . fieldType)
- , ("description", pushText . fieldDescription)
+pushFieldDocAsTable :: LuaError e => Pusher e FieldDoc
+pushFieldDocAsTable = pushAsTable
+ [ ("name", pushText . fieldDocName)
+ , ("type", pushTypeSpec . fieldDocType)
+ , ("description", pushText . fieldDocDescription)
]
-- | Pushes the documentation of a function as a table with string
-- fields, @name@, @description@, and @since@, sequence field
-- @parameters@, and sequence or string field @results@.
-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)
+pushFunctionDocAsTable :: LuaError e => Pusher e FunctionDoc
+pushFunctionDocAsTable = pushAsTable
+ [ ("name", pushText . funDocName)
+ , ("description", pushText . funDocDescription)
+ , ("parameters", pushList pushParameterDocAsTable . funDocParameters)
+ , ("results", pushResultsDoc . funDocResults)
+ , ("since", maybe pushnil (pushString . showVersion) . funDocSince)
+ ]
-- | Pushes the documentation of a parameter as a table with boolean
-- field @optional@ and string fields @name@, @type@, and @description@.
-pushParameterDoc :: LuaError e => Pusher e ParameterDoc
-pushParameterDoc = pushAsTable
+pushParameterDocAsTable :: LuaError e => Pusher e ParameterDoc
+pushParameterDocAsTable = pushAsTable
[ ("name", pushText . parameterName)
, ("type", pushTypeSpec . parameterType)
, ("description", pushText . parameterDescription)
@@ -159,3 +266,11 @@
[ ("type", pushTypeSpec . resultValueType)
, ("description", pushText . resultValueDescription)
]
+
+-- | Pushes the documentation of a UDType as a Lua table.
+pushTypeDocAsTable :: LuaError e => Pusher e TypeDoc
+pushTypeDocAsTable = pushAsTable
+ [ ("name", pushText . typeDocName)
+ , ("description", pushText . typeDocDescription)
+ , ("methods", pushList pushFunctionDoc . typeDocMethods)
+ ]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-packaging-2.3.2/src/HsLua/Packaging/Function.hs
new/hslua-packaging-2.4.1/src/HsLua/Packaging/Function.hs
--- old/hslua-packaging-2.3.2/src/HsLua/Packaging/Function.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/src/HsLua/Packaging/Function.hs 2001-09-09
03:46:40.000000000 +0200
@@ -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 <[email protected]>
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
--
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-packaging-2.3.2/src/HsLua/Packaging/Module.hs
new/hslua-packaging-2.4.1/src/HsLua/Packaging/Module.hs
--- old/hslua-packaging-2.3.2/src/HsLua/Packaging/Module.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/src/HsLua/Packaging/Module.hs 2001-09-09
03:46:40.000000000 +0200
@@ -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 <[email protected]>
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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-packaging-2.3.2/src/HsLua/Packaging/Rendering.hs
new/hslua-packaging-2.4.1/src/HsLua/Packaging/Rendering.hs
--- old/hslua-packaging-2.3.2/src/HsLua/Packaging/Rendering.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/src/HsLua/Packaging/Rendering.hs 1970-01-01
01:00:00.000000000 +0100
@@ -1,143 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-|
-Module : HsLua.Packaging.Rendering
-Copyright : © 2020-2024 Albert Krewinkel
-License : MIT
-Maintainer : Albert Krewinkel <[email protected]>
-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 " ")
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-packaging-2.3.2/src/HsLua/Packaging/Types.hs
new/hslua-packaging-2.4.1/src/HsLua/Packaging/Types.hs
--- old/hslua-packaging-2.3.2/src/HsLua/Packaging/Types.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/src/HsLua/Packaging/Types.hs 2001-09-09
03:46:40.000000000 +0200
@@ -1,6 +1,6 @@
{-|
Module : HsLua.Packaging.Types
-Copyright : © 2020-2024 Albert Krewinkel
+Copyright : © 2020-2026 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
Stability : alpha
@@ -9,23 +9,34 @@
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
@@ -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 }
+ }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-packaging-2.3.2/src/HsLua/Packaging/UDType.hs
new/hslua-packaging-2.4.1/src/HsLua/Packaging/UDType.hs
--- old/hslua-packaging-2.3.2/src/HsLua/Packaging/UDType.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/src/HsLua/Packaging/UDType.hs 2001-09-09
03:46:40.000000000 +0200
@@ -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 <[email protected]>
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-packaging-2.3.2/src/HsLua/Packaging.hs
new/hslua-packaging-2.4.1/src/HsLua/Packaging.hs
--- old/hslua-packaging-2.3.2/src/HsLua/Packaging.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/src/HsLua/Packaging.hs 2001-09-09
03:46:40.000000000 +0200
@@ -1,6 +1,6 @@
{-|
Module : HsLua.Packaging
-Copyright : © 2019-2024 Albert Krewinkel
+Copyright : © 2019-2026 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-packaging-2.3.2/test/HsLua/Packaging/DocumentationTests.hs
new/hslua-packaging-2.4.1/test/HsLua/Packaging/DocumentationTests.hs
--- old/hslua-packaging-2.3.2/test/HsLua/Packaging/DocumentationTests.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/test/HsLua/Packaging/DocumentationTests.hs
2001-09-09 03:46:40.000000000 +0200
@@ -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 <[email protected]>
@@ -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,22 +23,23 @@
-- | 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.TypeNil `shouldBeResultOf` do
+ OK <- Lua.dostring "return function () return 1 end"
+ getdocumentation top
+
+ , "Calling the doc object returns a table" =:
+ Lua.TypeTable `shouldBeResultOf` do
+ pushDocumentedFunction factorial
+ _ <- getdocumentation top
+ Lua.pushvalue top
+ Lua.call 1 1
Lua.ltype top
]
]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-packaging-2.3.2/test/HsLua/Packaging/FunctionTests.hs
new/hslua-packaging-2.4.1/test/HsLua/Packaging/FunctionTests.hs
--- old/hslua-packaging-2.3.2/test/HsLua/Packaging/FunctionTests.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/test/HsLua/Packaging/FunctionTests.hs
2001-09-09 03:46:40.000000000 +0200
@@ -2,7 +2,7 @@
{-# LANGUAGE TypeApplications #-}
{-|
Module : HsLua.Packaging.FunctionTests
-Copyright : © 2020-2024 Albert Krewinkel
+Copyright : © 2020-2026 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
@@ -14,7 +14,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 +96,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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-packaging-2.3.2/test/HsLua/Packaging/ModuleTests.hs
new/hslua-packaging-2.4.1/test/HsLua/Packaging/ModuleTests.hs
--- old/hslua-packaging-2.3.2/test/HsLua/Packaging/ModuleTests.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/test/HsLua/Packaging/ModuleTests.hs
2001-09-09 03:46:40.000000000 +0200
@@ -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 <[email protected]>
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 =
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-packaging-2.3.2/test/HsLua/Packaging/RenderingTests.hs
new/hslua-packaging-2.4.1/test/HsLua/Packaging/RenderingTests.hs
--- old/hslua-packaging-2.3.2/test/HsLua/Packaging/RenderingTests.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/test/HsLua/Packaging/RenderingTests.hs
1970-01-01 01:00:00.000000000 +0100
@@ -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 <[email protected]>
-
-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"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-packaging-2.3.2/test/HsLua/Packaging/UDTypeTests.hs
new/hslua-packaging-2.4.1/test/HsLua/Packaging/UDTypeTests.hs
--- old/hslua-packaging-2.3.2/test/HsLua/Packaging/UDTypeTests.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/test/HsLua/Packaging/UDTypeTests.hs
2001-09-09 03:46:40.000000000 +0200
@@ -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 <[email protected]>
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-packaging-2.3.2/test/HsLua/PackagingTests.hs
new/hslua-packaging-2.4.1/test/HsLua/PackagingTests.hs
--- old/hslua-packaging-2.3.2/test/HsLua/PackagingTests.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/test/HsLua/PackagingTests.hs 2001-09-09
03:46:40.000000000 +0200
@@ -1,6 +1,6 @@
{-|
Module : HsLua.PackagingTests
-Copyright : © 2020-2024 Albert Krewinkel
+Copyright : © 2020-2026 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
@@ -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
]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-packaging-2.3.2/test/test-hslua-packaging.hs
new/hslua-packaging-2.4.1/test/test-hslua-packaging.hs
--- old/hslua-packaging-2.3.2/test/test-hslua-packaging.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-packaging-2.4.1/test/test-hslua-packaging.hs 2001-09-09
03:46:40.000000000 +0200
@@ -1,6 +1,6 @@
{-|
Module : Main
-Copyright : © 2020-2024 Albert Krewinkel
+Copyright : © 2020-2026 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
