packages feed

hslua-packaging (empty) → 2.0.0

raw patch · 16 files changed

+1669/−0 lines, 16 filesdep +basedep +bytestringdep +containers

Dependencies added: base, bytestring, containers, hslua-core, hslua-marshalling, hslua-objectorientation, hslua-packaging, mtl, tasty, tasty-hslua, tasty-hunit, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,22 @@+## Changelog++`hslua-packaging` uses [PVP Versioning](https://pvp.haskell.org).++### hslua-packaging 2.0.0++Release pending.++- Initially created. Contains modules previously found in the+  modules `Foreign.Lua.Call` and `Foreign.Lua.Module` from+  `hslua-1.3`.++- Moved module hierarchy from Foreign.Lua to HsLua.++- Added support for a "since" tag on documented functions; allows+  to mark the library version when a function was introduced in+  its present form.++- Improved syntax for the creation of documented functions.++- Documentation for functions is now stored in Lua; a method to+  access it is available as a HaskellFunction.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright © 2019-2021 Albert Krewinkel++Permission is hereby granted, free of charge, to any person obtaining a+copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,91 @@+# hslua-packaging++[![Build status][GitHub Actions badge]][GitHub Actions]+[![AppVeyor Status]](https://ci.appveyor.com/project/tarleb/hslua-r2y18)+[![Hackage]](https://hackage.haskell.org/package/hslua-packaging)++Utilities to package up Haskell functions and values into a Lua+module.++[GitHub Actions badge]: https://img.shields.io/github/workflow/status/hslua/hslua/CI.svg?logo=github+[GitHub Actions]: https://github.com/hslua/hslua/actions+[AppVeyor Status]: https://ci.appveyor.com/api/projects/status/ldutrilgxhpcau94/branch/main?svg=true+[Hackage]: https://img.shields.io/hackage/v/hslua-packaging.svg++This package is part of [HsLua], a Haskell framework built around+the embeddable scripting language [Lua].++[HsLua]: https://hslua.org/+[Lua]: https://lua.org/++## Functions++It is rarely enough to just expose Haskell functions to Lua, they+must also be documented. This library allows to combine both into+one step, as one would do in source files.++Functions can be exposed to Lua if they follow the type++    a_0 -> a_1 -> ... -> a_n -> LuaE e b++where each a~i~, 0 ≤ i ≤ n can be retrieved from the Lua stack.++Let's look at an example: we want to expose the *factorial*+function, making use of Haskell's arbitrary size integers. Below+is how we would document and expose it to Lua.++``` haskell+-- | Calculate the factorial of a number.+factorial :: DocumentedFunction Lua.Exception+factorial = defun "factorial"+  ### liftPure (\n -> product [1..n])+  <#> n+  =#> productOfNumbers+  #? "Calculates the factorial of a positive integer."+  `since` makeVersion [1,0,0]+ where+   n :: Parameter Lua.Exception Integer+   n = parameter peekIntegral "integer"+         "n"+         "number for which the factorial is computed"++   productOfNumbers :: FunctionResults Lua.Exception Integer+   productOfNumbers =+     functionResult pushIntegral "integer"+       "produce of all numbers from 1 upto n"+```++This produces a value which can be pushed to Lua as a function++``` haskell+pushDocumentedFunction factorial+setglobal "factorial"+```++and can then be called from Lua++``` lua+> factorial(4)+24+> factorial(23)+"25852016738884976640000"+```++The documentation can be rendered as Markdown with `renderFunction`:++```+factorial (n)++Calculates the factorial of a positive integer.++*Since: 1.0.0*++Parameters:++n+:   number for which the factorial is computed (integer)++Returns:++ - product of all integers from 1 upto n (integer)+```
+ hslua-packaging.cabal view
@@ -0,0 +1,86 @@+cabal-version:       2.2+name:                hslua-packaging+version:             2.0.0+synopsis:            Utilities to build Lua modules.+description:         Utilities to package up Haskell functions and+                     values into a Lua module.+                     .+                     This package is part of HsLua, a Haskell framework+                     built around the embeddable scripting language+                     <https://lua.org Lua>.+homepage:            https://hslua.org/+bug-reports:         https://github.com/hslua/hslua/issues+license:             MIT+license-file:        LICENSE+author:              Albert Krewinkel+maintainer:          albert+hslua@zeitkraut.de+copyright:           © 2019-2021 Albert Krewinkel+category:            Foreign+extra-source-files:  README.md+                   , CHANGELOG.md+tested-with:         GHC == 8.0.2+                   , GHC == 8.2.2+                   , GHC == 8.4.4+                   , GHC == 8.6.5+                   , GHC == 8.8.4+                   , GHC == 8.10.3+                   , GHC == 9.0.1++source-repository head+  type:                git+  location:            https://github.com/hslua/hslua.git+  subdir:              hslua-packaging++common common-options+  default-language:    Haskell2010+  build-depends:       base                    >= 4.8    && < 5+                     , hslua-core              >= 2.0    && < 2.1+                     , hslua-marshalling       >= 2.0    && < 2.1+                     , hslua-objectorientation >= 2.0    && < 2.1+                     , mtl                     >= 2.2    && < 2.3+                     , text                    >= 1.0    && < 1.3+  ghc-options:         -Wall+                       -Wincomplete-record-updates+                       -Wnoncanonical-monad-instances+                       -Wredundant-constraints+  if impl(ghc >= 8.2)+    ghc-options:         -Wcpp-undef+                         -Werror=missing-home-modules+  if impl(ghc >= 8.4)+    ghc-options:         -Widentities+                         -Wincomplete-uni-patterns+                         -Wpartial-fields+                         -fhide-source-paths++library+  import:              common-options+  exposed-modules:     HsLua.Packaging+                     , HsLua.Packaging.Function+                     , HsLua.Packaging.Module+                     , HsLua.Packaging.Rendering+                     , HsLua.Packaging.Types+                     , HsLua.Packaging.UDType+  hs-source-dirs:      src+  default-extensions:  LambdaCase+  other-extensions:    DeriveFunctor+                     , OverloadedStrings+  build-depends:       containers              >= 0.5.9    && < 0.7++test-suite test-hslua-packaging+  import:              common-options+  type:                exitcode-stdio-1.0+  main-is:             test-hslua-packaging.hs+  hs-source-dirs:      test+  ghc-options:         -threaded+  other-modules:       HsLua.PackagingTests+                     , HsLua.Packaging.FunctionTests+                     , HsLua.Packaging.ModuleTests+                     , HsLua.Packaging.RenderingTests+                     , HsLua.Packaging.UDTypeTests+  build-depends:       hslua-packaging+                     , bytestring+                     , tasty-hslua+                     , tasty                   >= 0.11+                     , tasty-hunit             >= 0.9+  other-extensions:    OverloadedStrings+                     , TypeApplications
+ src/HsLua/Packaging.hs view
@@ -0,0 +1,25 @@+{-|+Module      : HsLua.Packaging+Copyright   : © 2019-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>++Tools to create Lua modules.+-}+module HsLua.Packaging+  ( -- * Modules+    module HsLua.Packaging.Module+  , module HsLua.Packaging.Function+    -- * Object oriented marshalling+  , module HsLua.Packaging.UDType+    -- * Create documentation+  , module HsLua.Packaging.Rendering+    -- * Types+  , module HsLua.Packaging.Types+  ) where++import HsLua.Packaging.Function+import HsLua.Packaging.Module+import HsLua.Packaging.Rendering+import HsLua.Packaging.UDType+import HsLua.Packaging.Types
+ src/HsLua/Packaging/Function.hs view
@@ -0,0 +1,385 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : HsLua.Packaging.Function+Copyright   : © 2020-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability   : alpha+Portability : Portable++Marshaling and documenting Haskell functions.+-}+module HsLua.Packaging.Function+  ( DocumentedFunction (..)+    -- * Creating documented functions+  , defun+  , lambda+  , applyParameter+  , returnResult+  , returnResultsOnStack+  , liftPure+  , liftPure2+  , liftPure3+  , liftPure4+  , liftPure5+    -- ** Types+  , Parameter (..)+  , FunctionResult (..)+  , FunctionResults+    -- ** Operators+  , (###)+  , (<#>)+  , (=#>)+  , (=?>)+  , (#?)+    -- * Modifying functions+  , setName+  , since+    -- * Pushing to Lua+  , pushDocumentedFunction+    -- * Accessing documentation in Lua+  , docsField+  , pushDocumentation+    -- * Convenience functions+  , parameter+  , optionalParameter+  , functionResult+    -- * Internal+  , toHsFnPrecursor+  ) where++import Control.Applicative ((<|>))+import Control.Monad.Except+import Data.Text (Text)+import Data.Version (Version)+import HsLua.Core+import HsLua.Marshalling+import HsLua.Packaging.Rendering (renderFunction)+import HsLua.Packaging.Types+import qualified HsLua.Core as Lua+import qualified HsLua.Core.Utf8 as Utf8++#if !MIN_VERSION_base(4,12,0)+import Data.Semigroup (Semigroup ((<>)))+#endif++--+-- Haskell function building+--++-- | Helper type used to create 'HaskellFunction's.+data HsFnPrecursor e a = HsFnPrecursor+  { hsFnPrecursorAction :: Peek e a+  , hsFnMaxParameterIdx :: StackIndex+  , hsFnParameterDocs :: [ParameterDoc]+  , hsFnName :: Name+  }+  deriving (Functor)++-- | Result of a call to a Haskell function.+data FunctionResult e a+  = FunctionResult+  { fnResultPusher  :: Pusher e a+  , fnResultDoc     :: ResultValueDoc+  }++-- | List of function results in the order in which they are+-- returned in Lua.+type FunctionResults e a = [FunctionResult e a]++-- | Function parameter.+data Parameter e a = Parameter+  { parameterPeeker :: Peeker e a+  , parameterDoc    :: ParameterDoc+  }+++-- | Begin wrapping a monadic Lua function such that it can be turned+-- into a documented function exposable to Lua.+defun :: Name -> a -> HsFnPrecursor e a+defun = toHsFnPrecursor (StackIndex 0)++-- | Just like @defun@, but uses an empty name for the documented+-- function. Should be used when defining methods or operators.+lambda :: a -> HsFnPrecursor e a+lambda = defun (Name mempty)++-- | Turns a pure function into a monadic Lua function.+--+-- The resulting function is strict.+liftPure :: (a -> b)+         -> (a -> LuaE e b)+liftPure f !a = return $! f a++-- | Turns a binary function into a Lua function.+--+-- The resulting function is strict in both its arguments.+liftPure2 :: (a -> b -> c)+          -> (a -> b -> LuaE e c)+liftPure2 f !a !b = return $! f a b++-- | Turns a ternary function into a Lua function.+--+-- The resulting function is strict in all of its arguments.+liftPure3 :: (a -> b -> c -> d)+          -> (a -> b -> c -> LuaE e d)+liftPure3 f !a !b !c = return $! f a b c++-- | Turns a quarternary function into a Lua function.+--+-- The resulting function is strict in all of its arguments.+liftPure4 :: (a -> b -> c -> d -> e)+          -> (a -> b -> c -> d -> LuaE err e)+liftPure4 f !a !b !c !d = return $! f a b c d++-- | Turns a quinary function into a Lua function.+--+-- The resulting function is strict in all of its arguments.+liftPure5 :: (a -> b -> c -> d -> e -> f)+          -> (a -> b -> c -> d -> e -> LuaE err f)+liftPure5 f !a !b !c !d !e = return $! f a b c d e++-- | Create a HaskellFunction precursor from a monadic function,+-- selecting the stack index after which the first function parameter+-- will be placed.+toHsFnPrecursor :: StackIndex -> Name -> a -> HsFnPrecursor e a+toHsFnPrecursor idx name f = HsFnPrecursor+  { hsFnPrecursorAction = return f+  , hsFnMaxParameterIdx = idx+  , hsFnParameterDocs = mempty+  , hsFnName = name+  }++-- | Partially apply a parameter.+applyParameter :: HsFnPrecursor e (a -> b)+               -> Parameter e a+               -> HsFnPrecursor e b+applyParameter bldr param = do+  let action = hsFnPrecursorAction bldr+  let i = hsFnMaxParameterIdx bldr + 1+  let context = Name . Utf8.fromText $ "function argument " <>+        (parameterName . parameterDoc) param+  let nextAction f = withContext context $ do+        !x <- parameterPeeker param i+        return $ f x+  bldr+    { hsFnPrecursorAction = action >>= nextAction+    , hsFnMaxParameterIdx = i+    , hsFnParameterDocs = parameterDoc param : hsFnParameterDocs bldr+    }++-- | Take a 'HaskellFunction' precursor and convert it into a full+-- 'HaskellFunction', using the given 'FunctionResult's to return+-- the result to Lua.+returnResults :: HsFnPrecursor e (LuaE e a)+              -> FunctionResults e a+              -> DocumentedFunction e+returnResults bldr fnResults = DocumentedFunction+  { callFunction = do+      hsResult <- runPeek+                . retrieving ("arguments for function " <> hsFnName bldr)+                $ hsFnPrecursorAction bldr+      case resultToEither hsResult of+        Left err -> do+          pushString err+          Lua.error+        Right x -> do+          result <- x+          forM_ fnResults $ \(FunctionResult push _) -> push result+          return $! NumResults (fromIntegral $ length fnResults)+  , functionName = hsFnName bldr+  , functionDoc = FunctionDoc+    { functionDescription = ""+    , parameterDocs = reverse $ hsFnParameterDocs bldr+    , functionResultsDocs = ResultsDocList $ map fnResultDoc fnResults+    , functionSince = Nothing+    }+  }++-- | Take a 'HaskellFunction' precursor and convert it into a full+-- 'HaskellFunction', using the given 'FunctionResult's to return+-- the result to Lua.+returnResultsOnStack :: HsFnPrecursor e (LuaE e NumResults)+                     -> Text+                     -> DocumentedFunction e+returnResultsOnStack bldr desc = DocumentedFunction+  { callFunction = do+      hsResult <- runPeek+                . retrieving ("arguments for function " <> hsFnName bldr)+                $ hsFnPrecursorAction bldr+      case resultToEither hsResult of+        Left err -> do+          pushString err+          Lua.error+        Right x -> x+  , functionName = hsFnName bldr+  , functionDoc = FunctionDoc+    { functionDescription = ""+    , parameterDocs = reverse $ hsFnParameterDocs bldr+    , functionResultsDocs = ResultsDocMult desc+    , functionSince = Nothing+    }+  }++-- | Like @'returnResult'@, but returns only a single result.+returnResult :: HsFnPrecursor e (LuaE e a)+             -> FunctionResult e a+             -> DocumentedFunction e+returnResult bldr = returnResults bldr . (:[])++-- | Updates the description of a Haskell function. Leaves the function+-- unchanged if it has no documentation.+updateFunctionDescription :: DocumentedFunction e+                          -> Text+                          -> DocumentedFunction e+updateFunctionDescription fn desc =+  let fnDoc = functionDoc fn+  in fn { functionDoc = fnDoc { functionDescription = desc} }++-- | Renames a documented function.+setName :: Name -> DocumentedFunction e -> DocumentedFunction e+setName name fn = fn { functionName = name }++-- | Sets the library version at which the function was introduced in its+-- current form.+since :: DocumentedFunction e -> Version -> DocumentedFunction e+since fn version =+  let fnDoc = functionDoc fn+  in fn { functionDoc = fnDoc { functionSince = Just version  }}++--+-- Operators+--++infixl 8 ###, <#>, =#>, =?>, #?, `since`++-- | Like '($)', but left associative.+(###) :: (a -> HsFnPrecursor e a) -> a -> HsFnPrecursor e a+(###) = ($)++-- | Inline version of @'applyParameter'@.+(<#>) :: HsFnPrecursor e (a -> b)+      -> Parameter e a+      -> HsFnPrecursor e b+(<#>) = applyParameter++-- | Inline version of @'returnResults'@.+(=#>) :: HsFnPrecursor e (LuaE e a)+      -> FunctionResults e a+      -> DocumentedFunction e+(=#>) = returnResults++-- | Return a flexible number of results that have been pushed by the+-- function action.+(=?>) :: HsFnPrecursor e (LuaE e NumResults)+      -> Text+      -> DocumentedFunction e+(=?>) = returnResultsOnStack++-- | Inline version of @'updateFunctionDescription'@.+(#?) :: DocumentedFunction e -> Text -> DocumentedFunction e+(#?) = updateFunctionDescription++--+-- Push to Lua+--++-- | Name of the registry field holding the documentation table. The+-- documentation table is indexed by the documented objects, like module+-- tables and functions, and contains documentation strings as values.+--+-- The table is an ephemeron table, i.e., an entry gets garbage+-- collected if the key is no longer reachable.+docsField :: Name+docsField = "HsLua docs"++-- | Pushes a documented Haskell function to the Lua stack, making it+-- usable as a normal function in Lua. At the same time, the function+-- docs are registered in the documentation table.+pushDocumentedFunction :: LuaError e+                       => DocumentedFunction e -> LuaE e ()+pushDocumentedFunction fn = do+  -- push function+  Lua.pushHaskellFunction $ callFunction fn++  -- store documentation+  Lua.getfield registryindex docsField >>= \case+    TypeTable -> return () -- already have the documentation table+    _ -> do+      Lua.pop 1            -- pop non-table value+      Lua.newtable         -- create documentation table+      Lua.pushstring "k"   -- Make it an "ephemeron table" and..+      Lua.setfield (nth 2) "__mode"  -- collect docs if function is GCed+      Lua.pushvalue top    -- add copy of table to registry+      Lua.setfield registryindex docsField+  Lua.pushvalue (nth 2)  -- the function+  pushText $ renderFunction fn+  Lua.rawset (nth 3)+  Lua.pop 1              -- pop doc table, leave function on stack++-- | Pushes the documentation of the object at the given index to the+-- stack, or just *nil* if no documentation is available.+pushDocumentation :: LuaError e => StackIndex -> LuaE e NumResults+pushDocumentation idx = do+  idx' <- Lua.absindex idx+  Lua.getfield registryindex docsField >>= \case+    TypeTable -> do+      Lua.pushvalue idx'+      Lua.rawget (nth 2)+    _ -> do -- no documentation table available+      Lua.pop 1    -- pop contents of docsField+      Lua.pushnil+  return (NumResults 1)++--+-- Convenience functions+--++-- | Creates a parameter.+parameter :: Peeker e a   -- ^ method to retrieve value from Lua+          -> Text         -- ^ expected Lua type+          -> Text         -- ^ parameter name+          -> Text         -- ^ parameter description+          -> Parameter e a+parameter peeker type_ name desc = Parameter+  { parameterPeeker = peeker+  , parameterDoc = ParameterDoc+    { parameterName = name+    , parameterDescription = desc+    , parameterType = type_+    , parameterIsOptional = False+    }+  }++-- | Creates an optional parameter.+optionalParameter :: Peeker e a   -- ^ method to retrieve the value from Lua+                  -> Text         -- ^ expected Lua type+                  -> Text         -- ^ parameter name+                  -> Text         -- ^ parameter description+                  -> Parameter e (Maybe a)+optionalParameter peeker type_ name desc = Parameter+  { parameterPeeker = \idx -> (Nothing <$ peekNoneOrNil idx)+                          <|> (Just <$!> peeker idx)+  , parameterDoc = ParameterDoc+    { parameterName = name+    , parameterDescription = desc+    , parameterType = type_+    , parameterIsOptional = True+    }+  }++-- | Creates a function result.+functionResult :: Pusher e a      -- ^ method to push the Haskell result to Lua+               -> Text            -- ^ Lua type of result+               -> Text            -- ^ result description+               -> FunctionResults e a+functionResult pusher type_ desc = (:[]) $ FunctionResult+  { fnResultPusher = pusher+  , fnResultDoc = ResultValueDoc+                  { resultValueType = type_+                  , resultValueDescription = desc+                  }+  }
+ src/HsLua/Packaging/Module.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : HsLua.Packaging.Module+Copyright   : © 2019-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>+Stability   : alpha+Portability : Requires GHC 8 or later.++Utility functions for HsLua modules.+-}+module HsLua.Packaging.Module+  ( -- * Documented module+    Module (..)+  , Field (..)+  , registerModule+  , preloadModule+  , preloadModuleWithName+  , pushModule+  , Operation (..)+  )+where++import Control.Monad (forM_)+import HsLua.Core+import HsLua.Marshalling (pushName, pushText)+import HsLua.ObjectOrientation.Operation (Operation (..), metamethodName)+import HsLua.Packaging.Types+import qualified HsLua.Packaging.Function as Call++-- | Create a new module (i.e., a Lua table).+create :: LuaE e ()+create = newtable++-- | Registers a 'Module'; leaves a copy of the module table on+-- the stack.+registerModule :: LuaError e => Module e -> LuaE e ()+registerModule mdl =+  requirehs (moduleName mdl) (pushModule mdl)++-- | Add the module under a different name to the table of preloaded+-- packages.+preloadModuleWithName :: LuaError e => Module e -> Name -> LuaE e ()+preloadModuleWithName documentedModule name = preloadModule $+  documentedModule { moduleName = name }++-- | Preload self-documenting module using the module's default name.+preloadModule :: LuaError e => Module e -> LuaE e ()+preloadModule mdl =+  preloadhs (moduleName mdl) $ do+    pushModule mdl+    return (NumResults 1)++-- | Pushes a documented module to the Lua stack.+pushModule :: LuaError e => Module e -> LuaE e ()+pushModule mdl = do+  create+  forM_ (moduleFunctions mdl) $ \fn -> do+    pushName (functionName fn)+    Call.pushDocumentedFunction fn+    rawset (nth 3)+  forM_ (moduleFields mdl) $ \field -> do+    pushText (fieldName field)+    fieldPushValue field+    rawset (nth 3)+  case moduleOperations mdl of+    [] -> pure ()+    ops -> do+      -- create a metatable for this module and add operations+      newtable+      forM_ ops $ \(op, fn) -> do+        pushName $ metamethodName op+        Call.pushDocumentedFunction $ Call.setName "" fn+        rawset (nth 3)+      setmetatable (nth 2)
+ src/HsLua/Packaging/Rendering.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : HsLua.Packaging.Rendering+Copyright   : © 2020-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability   : alpha+Portability : Portable++Render function and module documentation.+-}+module HsLua.Packaging.Rendering+  ( -- * Documentation+    render+  , renderModule+  , renderFunction+  ) where++import Data.Text (Text)+import Data.Version (showVersion)+import HsLua.Core+import HsLua.Packaging.Types+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified HsLua.Core.Utf8 as Utf8++#if !MIN_VERSION_base(4,12,0)+import Data.Semigroup (Semigroup ((<>)))+#endif++--+-- 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+  , " (", 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+  , " (", resultValueType rd, ")"+  ]++indent :: Int -> Text -> Text+indent n = T.replace "\n" (T.replicate n " ")
+ src/HsLua/Packaging/Types.hs view
@@ -0,0 +1,91 @@+{-|+Module      : HsLua.Packaging.Types+Copyright   : © 2020-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability   : alpha+Portability : Portable++Marshaling and documenting Haskell functions.+-}+module HsLua.Packaging.Types+  ( -- * Documented module+    Module (..)+  , Field (..)+    -- * Documented functions+  , DocumentedFunction (..)+    -- ** Documentation types+  , FunctionDoc (..)+  , ParameterDoc (..)+  , ResultsDoc (..)+  , ResultValueDoc (..)+  ) where++import Data.Text (Text)+import Data.Version (Version)+import HsLua.Core (LuaE, Name, NumResults)+import HsLua.ObjectOrientation (Operation)++-- | Named and documented Lua module.+data Module e = Module+  { moduleName :: Name+  , moduleDescription :: Text+  , moduleFields :: [Field e]+  , moduleFunctions :: [DocumentedFunction e]+  , moduleOperations :: [(Operation, DocumentedFunction e)]+  }++-- | Self-documenting module field+data Field e = Field+  { fieldName :: Text+  , fieldDescription :: Text+  , fieldPushValue :: LuaE e ()+  }++--+-- Function components+--++-- | Haskell equivallent to CFunction, i.e., function callable+-- from Lua.+data DocumentedFunction e = DocumentedFunction+  { callFunction :: LuaE e NumResults+  , functionName :: Name+  , functionDoc  :: FunctionDoc+  }++--+-- Documentation types+--++-- | Documentation for a Haskell function+data FunctionDoc = FunctionDoc+  { functionDescription :: Text+  , parameterDocs       :: [ParameterDoc]+  , functionResultsDocs :: ResultsDoc+  , functionSince       :: Maybe Version  -- ^ Version in which the function+                                          -- was introduced.+  }+  deriving (Eq, Ord, Show)++-- | Documentation for function parameters.+data ParameterDoc = ParameterDoc+  { parameterName :: Text+  , parameterType :: Text+  , parameterDescription :: Text+  , parameterIsOptional :: Bool+  }+  deriving (Eq, Ord, Show)++-- | Documentation for the return values of a function.+data ResultsDoc+  = ResultsDocList [ResultValueDoc]  -- ^ List of individual results+  | ResultsDocMult Text              -- ^ Flexible results+  deriving (Eq, Ord, Show)++-- | Documentation for a single return value of a function.+data ResultValueDoc = ResultValueDoc+  { resultValueType :: Text+  , resultValueDescription :: Text+  }+  deriving (Eq, Ord, Show)
+ src/HsLua/Packaging/UDType.hs view
@@ -0,0 +1,89 @@+{-|+Module      : HsLua.Packaging.UDType+Copyright   : © 2020-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>++This module provides types and functions to use Haskell values as+userdata objects in Lua. These objects wrap a Haskell value and provide+methods and properties to interact with the Haskell value.++The terminology in this module refers to the userdata values as /UD+objects/, and to their type as /UD type/.+-}+module HsLua.Packaging.UDType+  ( DocumentedType+  , DocumentedTypeWithList+  , deftype+  , deftype'+  , method+  , property+  , possibleProperty+  , readonly+  , alias+  , operation+  , peekUD+  , pushUD+  , udparam+    -- * Helper types for building+  , Member+  , Operation (..)+  , Property+  , Possible (..)+  ) where++import Data.Text (Text)+import HsLua.Core+import HsLua.ObjectOrientation+import HsLua.ObjectOrientation.Operation (metamethodName)+import HsLua.Packaging.Function+import qualified HsLua.Core.Utf8 as Utf8++-- | Type definitions containing documented functions.+type DocumentedType e a = UDType e (DocumentedFunction e) a++-- | A userdata type, capturing the behavior of Lua objects that wrap+-- Haskell values. The type name must be unique; once the type has been+-- used to push or retrieve a value, the behavior can no longer be+-- modified through this type.+type DocumentedTypeWithList e a itemtype =+  UDTypeWithList e (DocumentedFunction e) a itemtype++-- | Defines a new type, defining the behavior of objects in Lua.+-- Note that the type name must be unique.+deftype :: LuaError e+        => Name                                 -- ^ type name+        -> [(Operation, DocumentedFunction e)]  -- ^ operations+        -> [Member e (DocumentedFunction e) a]  -- ^ methods+        -> DocumentedType e a+deftype = deftypeGeneric pushDocumentedFunction++-- | Defines a new type that could also be treated as a list; defines+-- the behavior of objects in Lua. Note that the type name must be+-- unique.+deftype' :: LuaError e+         => Name                                 -- ^ type name+         -> [(Operation, DocumentedFunction e)]  -- ^ operations+         -> [Member e (DocumentedFunction e) a]  -- ^ methods+         -> Maybe (ListSpec e a itemtype)  -- ^ list access+         -> DocumentedTypeWithList e a itemtype+deftype' = deftypeGeneric' pushDocumentedFunction++-- | Use a documented function as an object method.+method :: DocumentedFunction e+       -> Member e (DocumentedFunction e) a+method f = methodGeneric (functionName f) f++-- | Declares a new object operation from a documented function.+operation :: Operation             -- ^ the kind of operation+          -> DocumentedFunction e  -- ^ function used to perform the operation+          -> (Operation, DocumentedFunction e)+operation op f = (,) op $ setName (metamethodName op) f++-- | Defines a function parameter that takes the given type.+udparam :: LuaError e+        => DocumentedTypeWithList e a itemtype  -- ^ expected type+        -> Text            -- ^ parameter name+        -> Text            -- ^ parameter description+        -> Parameter e a+udparam ty = parameter (peekUD ty) (Utf8.toText . fromName $ udName ty)
+ test/HsLua/Packaging/FunctionTests.hs view
@@ -0,0 +1,178 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-|+Module      : HsLua.Packaging.FunctionTests+Copyright   : © 2020-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>++Tests for calling exposed Haskell functions.+-}+module HsLua.Packaging.FunctionTests (tests) where++import Data.Maybe (fromMaybe)+import Data.Version (makeVersion)+import HsLua.Core (StackIndex, top)+import HsLua.Packaging.Function+import HsLua.Packaging.Types+import HsLua.Marshalling+  ( forcePeek, peekIntegral, peekRealFloat, peekText+  , pushIntegral, pushRealFloat)+import Test.Tasty.HsLua ((=:), shouldBeResultOf, shouldHoldForResultOf)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit ((@=?))++import qualified Data.Text as T+import qualified HsLua.Core as Lua++-- | Calling Haskell functions from Lua.+tests :: TestTree+tests = testGroup "Call"+  [ testGroup "push Haskell function"+    [ "DocumentedFunction building" =:+      720+      `shouldBeResultOf` do+        factLua <- factLuaAtIndex <$> Lua.gettop+        Lua.pushinteger 6+        _ <- callFunction factLua+        forcePeek $ peekIntegral @Integer Lua.top++    , "error message" =:+      mconcat [ "Integral expected, got boolean\n"+              , "\twhile retrieving function argument n\n"+              , "\twhile retrieving arguments for function factorial"]+      `shouldBeResultOf` do+        factLua <- factLuaAtIndex <$> Lua.gettop+        Lua.pushboolean True+        _ <- callFunction factLua+        forcePeek $ peekText Lua.top+    ]+  , testGroup "use as C function"+    [ "push factorial" =:+      Lua.TypeFunction+      `shouldBeResultOf` do+        pushDocumentedFunction $ factLuaAtIndex 0+        Lua.ltype Lua.top+    , "call factorial" =:+      120+      `shouldBeResultOf` do+        pushDocumentedFunction $ factLuaAtIndex 0+        Lua.pushinteger 5+        Lua.call 1 1+        forcePeek $ peekIntegral @Integer Lua.top+    , "use from Lua" =:+      24+      `shouldBeResultOf` do+        pushDocumentedFunction $ factLuaAtIndex 0+        Lua.setglobal "factorial"+        Lua.loadstring "return factorial(4)" *> Lua.call 0 1+        forcePeek $ peekIntegral @Integer Lua.top++    , "with setting an optional param" =:+      8+      `shouldBeResultOf` do+        pushDocumentedFunction nroot+        Lua.setglobal "nroot"+        Lua.loadstring "return nroot(64)" *> Lua.call 0 1+        forcePeek $ peekRealFloat @Double Lua.top+    , "with setting an optional param" =:+      2+      `shouldBeResultOf` do+        pushDocumentedFunction nroot+        Lua.setglobal "nroot"+        Lua.loadstring "return nroot(64, 6)" *> Lua.call 0 1+        forcePeek $ peekRealFloat @Double Lua.top+    ]++  , testGroup "documentation access"+    [ "pushDocumentation" =:+      ("factorial (n)\n" `T.isPrefixOf`) `shouldHoldForResultOf` do+        pushDocumentedFunction (factLuaAtIndex 0)+        numres <- pushDocumentation top+        Lua.liftIO $ numres @=? Lua.NumResults 1+        forcePeek $ peekText top++    , "undocumented value" =:+      Lua.TypeNil `shouldBeResultOf` do+        Lua.pushboolean True+        numres <- pushDocumentation top+        Lua.liftIO $ numres @=? Lua.NumResults 1+        Lua.ltype top+    ]++  , testGroup "helpers"+    [ "parameter doc" =:+      ( ParameterDoc+        { parameterName = "test"+        , parameterDescription = "test param"+        , parameterType = "string"+        , parameterIsOptional = False+        }+        @=?+        parameterDoc+          (parameter @Lua.Exception peekText "string" "test" "test param")+      )+    , "optionalParameter doc" =:+      ( ParameterDoc+        { parameterName = "test"+        , parameterDescription = "test param"+        , parameterType = "string"+        , parameterIsOptional = True+        }+        @=?+        parameterDoc+          (optionalParameter @Lua.Exception peekText "string" "test" "test param")+      )+    , "functionResult doc" =:+      ( [ ResultValueDoc+          { resultValueDescription = "int result"+          , resultValueType = "integer"+          }+        ]+        @=?+        fnResultDoc <$>+          functionResult (pushIntegral @Int) "integer" "int result"+      )+    ]+  ]++factLuaAtIndex :: StackIndex -> DocumentedFunction Lua.Exception+factLuaAtIndex idx =+  toHsFnPrecursor idx "factorial" (liftPure factorial)+  <#> factorialParam+  =#> factorialResult+  #? "Calculates the factorial of a positive integer."+  `since` makeVersion [1,0,0]++-- | Calculate the factorial of a number.+factorial :: Integer -> Integer+factorial n = product [1..n]++factorialParam :: Parameter Lua.Exception Integer+factorialParam = Parameter+  { parameterDoc = ParameterDoc+    { parameterName = "n"+    , parameterType = "integer"+    , parameterDescription = "number for which the factorial is computed"+    , parameterIsOptional = False+    }+  , parameterPeeker = peekIntegral @Integer+  }++factorialResult :: FunctionResults Lua.Exception Integer+factorialResult = (:[]) $ FunctionResult+  (pushIntegral @Integer)+  (ResultValueDoc "integer" "factorial")++-- | Calculate the nth root of a number. Defaults to square root.+nroot :: DocumentedFunction Lua.Exception+nroot = defun "nroot"+  ### liftPure2 nroot'+  <#> parameter (peekRealFloat @Double) "number" "x" ""+  <#> optionalParameter (peekIntegral @Int) "integer" "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)
+ test/HsLua/Packaging/ModuleTests.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-|+Module      : HsLua.Packaging.ModuleTests+Copyright   : © 2019-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>+Stability   : alpha+Portability : Requires GHC 8 or later.++Tests creating and loading of modules with Haskell.+-}+module HsLua.Packaging.ModuleTests (tests) where++import HsLua.Marshalling+  (Result (Success), peekIntegral, peekString, pushIntegral, pushText, runPeek)+import HsLua.Packaging.Function+import HsLua.Packaging.Module+import Test.Tasty.HsLua ((=:), pushLuaExpr, shouldBeResultOf)+import Test.Tasty (TestTree, testGroup)++import qualified HsLua.Core as Lua++-- | Specifications for Attributes parsing functions.+tests :: TestTree+tests = testGroup "Module"+  [ testGroup "requirehs"+    [ "pushes module to stack" =:+      1 `shouldBeResultOf` do+        Lua.openlibs+        old <- Lua.gettop+        Lua.requirehs "foo" (Lua.pushnumber 5.0)+        new <- Lua.gettop+        return (new - old)++    , "module can be loaded with `require`" =:+      let testModule = "string as a module"+      in Just testModule `shouldBeResultOf` do+        Lua.openlibs+        Lua.requirehs "test.module" (Lua.pushstring testModule)+        pushLuaExpr "require 'test.module'"+        Lua.tostring Lua.top+    ]++  , testGroup "preloadhs"+    [ "does not modify the stack" =:+      0 `shouldBeResultOf` do+        Lua.openlibs+        old <- Lua.gettop+        Lua.preloadhs "foo" (1 <$ Lua.pushnumber 5.0)+        new <- Lua.gettop+        return (new - old)++    , "module can be loaded with `require`" =:+      let testModule = "string as a module"+      in Just testModule `shouldBeResultOf` do+        Lua.openlibs+        Lua.preloadhs "test.module" (1 <$ Lua.pushstring testModule)+        pushLuaExpr "require 'test.module'"+        Lua.tostring Lua.top+    ]++  , testGroup "creation helpers"+    [ "create produces a table" =:+      Lua.TypeTable `shouldBeResultOf` do+        Lua.newtable+        Lua.ltype Lua.top+    ]+  , testGroup "module type"+    [ "register module" =:+      1 `shouldBeResultOf` do+        Lua.openlibs+        old <- Lua.gettop+        registerModule mymath+        new <- Lua.gettop+        return (new - old)++    , "call module function" =:+      Success 24 `shouldBeResultOf` do+        Lua.openlibs+        registerModule mymath+        _ <- Lua.dostring $ mconcat+             [ "local mymath = require 'mymath'\n"+             , "return mymath.factorial(4)"+             ]+        runPeek $ peekIntegral @Integer Lua.top++    , "call module as function" =:+      Success "call me maybe" `shouldBeResultOf` do+        Lua.openlibs+        registerModule mymath+        _ <- Lua.dostring "return (require 'mymath')()"+        runPeek $ peekString Lua.top++    ]+  ]++mymath :: Module Lua.Exception+mymath = Module+  { moduleName = "mymath"+  , moduleDescription = "A math module."+  , moduleFields = []+  , moduleFunctions = [factorial]+  , moduleOperations =+    [ (,) Call $ lambda+      ### (1 <$ pushText "call me maybe")+      =?> "call result"+    ]+  }++factorial :: DocumentedFunction Lua.Exception+factorial =+  defun "factorial"+  ### liftPure (\n -> product [1..n])+  <#> factorialParam+  =#> factorialResult++factorialParam :: Parameter Lua.Exception Integer+factorialParam =+  parameter (peekIntegral @Integer) "integer"+    "n"+    "number for which the factorial is computed"++factorialResult :: FunctionResults Lua.Exception Integer+factorialResult =+  functionResult (pushIntegral @Integer) "integer" "factorial"
+ test/HsLua/Packaging/RenderingTests.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-|+Module      : HsLua.Packaging.RenderingTests+Copyright   : © 2020-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>++Tests for calling exposed Haskell functions.+-}+module HsLua.Packaging.RenderingTests (tests) where++import Data.Maybe (fromMaybe)+import Data.Version (makeVersion)+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" ""+  <#> optionalParameter (peekIntegral @Int) "integer" "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 = []+  }++-- | Euler-Mascheroni constant+euler_mascheroni :: Field Lua.Exception+euler_mascheroni = Field+  { fieldName = "euler_mascheroni"+  , 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
@@ -0,0 +1,156 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-|+Module      : HsLua.Packaging.UDTypeTests+Copyright   : © 2020-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>++Tests for calling exposed Haskell functions.+-}+module HsLua.Packaging.UDTypeTests (tests) where++import HsLua.Core+import HsLua.Packaging.Function+import HsLua.Packaging.UDType+import HsLua.Marshalling+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HsLua ((=:), shouldBeResultOf)+import qualified Data.ByteString.Char8 as Char8++-- | Calling Haskell functions from Lua.+tests :: TestTree+tests = testGroup "DocumentedType"+  [ testGroup "Foo type"+    [ "show" =:+      "Foo 5 \"five\"" `shouldBeResultOf` do+        openlibs+        pushUD typeFoo $ Foo 5 "five"+        setglobal "foo"+        _ <- dostring "return foo:show()"+        forcePeek $ peekText top++    , "pairs iterates over properties" =:+      ["num", "5", "str", "echo", "show", "function"] `shouldBeResultOf` do+        openlibs+        pushUD typeFoo $ Foo 5 "echo"+        setglobal "echo"+        OK <- dostring $ Char8.unlines+          [ "local result = {}"+          , "for k, v in pairs(echo) do"+          , "  table.insert(result, k)"+          , "  table.insert("+          , "    result,"+          , "    type(v) == 'function' and 'function' or tostring(v)"+          , "  )"+          , "end"+          , "return result"+          ]+        forcePeek $ peekList peekText top+    ]++  , testGroup "Sum type"+    [ "tostring Quux" =:+      "Quux 11 \"eleven\"" `shouldBeResultOf` do+        openlibs+        pushUD typeQux $ Quux 11 "eleven"+        setglobal "quux"+        _ <- dostring "return tostring(quux)"+        forcePeek $ peekText top+    , "show Quux" =:+      "Quux 11 \"eleven\"" `shouldBeResultOf` do+        openlibs+        pushUD typeQux $ Quux 11 "eleven"+        setglobal "quux"+        _ <- dostring "return quux:show()"+        forcePeek $ peekText top+    ]+  ]++--+-- Sample types+--++data Foo = Foo Int String+  deriving (Eq, Show)++show' :: LuaError e => DocumentedFunction e+show' = defun "show"+  ### liftPure (show @Foo)+  <#> udparam typeFoo "foo" "Object"+  =#> functionResult pushString "string" "stringified foo"++typeFoo :: LuaError e => DocumentedType e Foo+typeFoo = deftype "Foo"+  [ operation Tostring show'+  ]+  [ property "num" "some number"+      (pushIntegral, \(Foo n _) -> n)+      (peekIntegral, \(Foo _ s) n -> Foo n s)+  , readonly "str" "some string" (pushString, \(Foo _ s) -> s)+  , method show'+  ]++--+-- Sum Type+--+data Qux+  = Quux Int String+  | Quuz Point Int+  deriving (Eq, Show)++data Point = Point Double Double+  deriving (Eq, Show)++pushPoint :: LuaError e => Pusher e Point+pushPoint (Point x y) = do+  newtable+  pushName "x" *> pushRealFloat x *> rawset (nth 3)+  pushName "y" *> pushRealFloat y *> rawset (nth 3)++peekPoint :: LuaError e => Peeker e Point+peekPoint idx = do+  x <- peekFieldRaw peekRealFloat "x" idx+  y <- peekFieldRaw peekRealFloat "y" idx+  return $ x `seq` y `seq` Point x y++showQux :: LuaError e => DocumentedFunction e+showQux = defun "show"+  ### liftPure (show @Qux)+  <#> parameter peekQux "qux" "qux" "Object"+  =#> functionResult pushString "string" "stringified Qux"++peekQux :: LuaError e => Peeker e Qux+peekQux = peekUD typeQux++typeQux :: LuaError e => DocumentedType e Qux+typeQux = deftype "Qux"+  [ operation Tostring showQux ]+  [ method showQux+  , property "num" "some number"+      (pushIntegral, \case+          Quux n _ -> n+          Quuz _ n -> n)+      (peekIntegral, \case+          Quux _ s -> (`Quux` s)+          Quuz d _ -> Quuz d)++  , possibleProperty "str" "a string in Quux"+    (pushString, \case+        Quux _ s -> Actual s+        Quuz {}  -> Absent)+    (peekString, \case+        Quux n _ -> Actual . Quux n+        Quuz {}  -> const Absent)++  , possibleProperty "point" "a point in Quuz"+    (pushPoint, \case+        Quuz p _ -> Actual p+        Quux {}  -> Absent)+    (peekPoint, \case+        Quuz _ n -> Actual . (`Quuz` n)+        Quux {}  -> const Absent)++  , alias "x" "The x coordinate of a point in Quuz" ["point", "x"]+  ]
+ test/HsLua/PackagingTests.hs view
@@ -0,0 +1,24 @@+{-|+Module      : HsLua.PackagingTests+Copyright   : © 2020-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>++Test packaging+-}+module HsLua.PackagingTests (tests) where++import Test.Tasty (TestTree, testGroup)+import qualified HsLua.Packaging.FunctionTests+import qualified HsLua.Packaging.ModuleTests+import qualified HsLua.Packaging.RenderingTests+import qualified HsLua.Packaging.UDTypeTests++-- | Tests for package creation.+tests :: TestTree+tests = testGroup "Packaging"+  [ HsLua.Packaging.FunctionTests.tests+  , HsLua.Packaging.ModuleTests.tests+  , HsLua.Packaging.RenderingTests.tests+  , HsLua.Packaging.UDTypeTests.tests+  ]
+ test/test-hslua-packaging.hs view
@@ -0,0 +1,18 @@+{-|+Module      : Main+Copyright   : © 2020-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>++Tests for hslua-packaging.+-}+import Test.Tasty (TestTree, defaultMain, testGroup)++import qualified HsLua.PackagingTests++main :: IO ()+main = defaultMain tests++-- | Lua module packaging tests.+tests :: TestTree+tests = testGroup "Packaging" [HsLua.PackagingTests.tests]