hslua-core 1.0.0 → 2.0.0

raw patch · 22 files changed

+2025/−1339 lines, 22 filesdep ~bytestring

Dependency ranges changed: bytestring

Files

• CHANGELOG.md +21/−0
• README.md +29/−7
• hslua-core.cabal +18/−9
• src/HsLua/Core.hs +36/−22
• src/HsLua/Core/Auxiliary.hs +153/−103
• src/HsLua/Core/Closures.hs +61/−0
• src/HsLua/Core/Error.hs +150/−81
• src/HsLua/Core/Functions.hs +0/−945
• src/HsLua/Core/Package.hs +62/−0
• src/HsLua/Core/Primary.hs +1001/−0
• src/HsLua/Core/Run.hs +8/−39
• src/HsLua/Core/Types.hs +107/−82
• src/HsLua/Core/Unsafe.hs +30/−0
• src/HsLua/Core/Userdata.hs +71/−0
• test/HsLua/Core/AuxiliaryTests.hs +26/−5
• test/HsLua/Core/ClosuresTests.hs +54/−0
• test/HsLua/Core/ErrorTests.hs +35/−5
• test/HsLua/Core/RunTests.hs +3/−5
• test/HsLua/Core/UnsafeTests.hs +36/−0
• test/HsLua/Core/UserdataTests.hs +67/−0
• test/HsLua/CoreTests.hs +49/−30
• test/Test/Tasty/HsLua.hs +8/−6

@@ -4,6 +4,27 @@  [1]: https://pvp.haskell.org +## hslua-core 2.0.0++Release pending.++- Error handling has been reworked completely. The type of+  exceptions used and handled by HsLua is now exposed to the type+  system. The type `Lua` makes use of a default error type. Custom+  error handling can be implemented by using the `LuaE` type with+  an exception type that is an instance of class `LuaError`.++- Added new module HsLua.Core.Userdata. It contains thin wrappers+  around the functions available for creating+  Haskell-value-wrapping userdata objects.++- Added new module HsLua.Core.Closures, containing functions to+  expose Haskell functions to Lua.++- Reverted to using the auxlib `luaL_loadfile` function to load a+  Lua file. Previously files were opened and read in Haskell, but+  some functionality of the auxlib function was missing.+ ## hslua-core 1.0.0  Released 2021-02-27.

@@ -16,13 +16,19 @@ Overview -------- -[Lua](https://lua.org) is a small, well-designed, embeddable-scripting language. It has become the de-facto default to make-programs extensible and is widely used everywhere from servers-over games and desktop applications up to security software and-embedded devices. This package provides the basic building blocks-for coders to embed Lua into their programs.+[Lua] is a small, well-designed, embeddable scripting language. It+has become the de-facto default to make programs extensible and is+widely used everywhere from servers over games and desktop+applications up to security software and embedded devices. This+package provides the basic building blocks for coders to embed Lua+into their programs. +This package is part of [HsLua], a Haskell framework built around+the embeddable scripting language [Lua].++[HsLua]: https://hslua.org/+[Lua]: https://lua.org/+ Interacting with Lua -------------------- @@ -72,4 +78,20 @@  This package provides all basic building blocks to interact with the Lua stack. If you'd like more comfort, please consider using-the `hslua` package.+the `hslua-packaging` and `hslua-classes` packages.+++Error handling+--------------++Errors and exceptions must always be caught and converted when+passing language boundaries. The exception type which can be+handled is encoded as the type `e` in the monad `LuaE e`. Only+exceptions of this type may be thrown; throwing different+exceptions across language boundaries will lead to a program+crash.++Exceptions must support certain operations as defined by the+`LuaError` typeclass. The class ensures that errors can be+converted from and to Lua values, and that a new exception can be+created from a String message.

@@ -1,13 +1,13 @@ cabal-version:       2.2 name:                hslua-core-version:             1.0.0+version:             2.0.0 synopsis:            Bindings to Lua, an embeddable scripting language description:         Wrappers and helpers to bridge Haskell and                      <https://www.lua.org/ Lua>.                      .                      It builds upon the /lua/ package, which allows to bundle                      a Lua interpreter with a Haskell program.-homepage:            https://hslua.github.io/+homepage:            https://hslua.org/ bug-reports:         https://github.com/hslua/hslua/issues license:             MIT license-file:        LICENSE@@ -26,7 +26,8 @@                    , GHC == 8.4.4                    , GHC == 8.6.5                    , GHC == 8.8.4-                   , GHC == 8.10.3+                   , GHC == 8.10.4+                   , GHC == 9.0.1  source-repository head   type:                git@@ -35,7 +36,7 @@ common common-options   default-language:    Haskell2010   build-depends:       base          >= 4.8    && < 5-                     , bytestring    >= 0.10.2 && < 0.11+                     , bytestring    >= 0.10.2 && < 0.12                      , exceptions    >= 0.8    && < 0.11                      , lua           >= 2.0    && < 2.1                      , mtl           >= 2.2    && < 2.3@@ -56,20 +57,25 @@ library   import:              common-options   exposed-modules:     HsLua.Core+                     , HsLua.Core.Closures                      , HsLua.Core.Error+                     , HsLua.Core.Package                      , HsLua.Core.Run                      , HsLua.Core.Types+                     , HsLua.Core.Unsafe+                     , HsLua.Core.Userdata                      , HsLua.Core.Utf8   other-modules:       HsLua.Core.Auxiliary-                     , HsLua.Core.Functions+                     , HsLua.Core.Primary   reexported-modules:  lua:Lua   hs-source-dirs:      src   default-extensions:  LambdaCase-  other-extensions:    DeriveDataTypeable-                     , DeriveFunctor-                     , FlexibleContexts-                     , FlexibleInstances+  other-extensions:    CPP+                     , DeriveDataTypeable+                     , GeneralizedNewtypeDeriving+                     , OverloadedStrings                      , ScopedTypeVariables+                     , TypeApplications  test-suite test-hslua-core   import:              common-options@@ -79,8 +85,11 @@   ghc-options:         -threaded -Wno-unused-do-bind   other-modules:       HsLua.CoreTests                      , HsLua.Core.AuxiliaryTests+                     , HsLua.Core.ClosuresTests                      , HsLua.Core.ErrorTests                      , HsLua.Core.RunTests+                     , HsLua.Core.UnsafeTests+                     , HsLua.Core.UserdataTests                      , Test.Tasty.HsLua                      , Test.HsLua.Arbitrary   build-depends:       hslua-core

@@ -17,21 +17,18 @@ module HsLua.Core   ( -- * Run Lua computations     run-  , run'   , runWith   , runEither   -- * Lua Computations-  , Lua (..)-  , runWithConverter+  , LuaE (..)+  , Lua   , unsafeRunWith   , liftIO   , state   , LuaEnvironment (..)-  , ErrorConversion (..)-  , errorConversion-  , unsafeErrorConversion   -- * Lua API types   , CFunction+  , PreCFunction   , Lua.Integer (..)   , Lua.Number (..)   -- ** Stack index@@ -43,6 +40,8 @@   -- ** Number of arguments and return values   , NumArgs (..)   , NumResults (..)+  -- ** Table fields+  , Name (..)   -- * Lua API   -- ** Constants and pseudo-indices   , multret@@ -65,9 +64,6 @@   , checkstack   -- ** types and type checks   , Type (..)-  , TypeCode (..)-  , fromType-  , toType   , ltype   , typename   , isboolean@@ -95,7 +91,6 @@   , rawlen   -- ** Comparison and arithmetic functions   , RelationalOperator (..)-  , fromRelationalOperator   , compare   , equal   , lessthan@@ -120,6 +115,7 @@   , newtable   , newuserdata   , getmetatable+  , getuservalue   -- ** set functions (stack → Lua)   , setglobal   , settable@@ -127,6 +123,7 @@   , rawset   , rawseti   , setmetatable+  , setuservalue   -- ** load and call functions (load and run Lua code)   , call   , pcall@@ -136,10 +133,9 @@   , loadstring   -- ** Coroutine functions   , Status (..)-  , toStatus   , status   -- ** garbage-collection function and options-  , GCCONTROL (..)+  , GCControl (..)   , gc   -- ** miscellaneous and helper functions   , next@@ -166,6 +162,7 @@   , newmetatable   , tostring'   , traceback+  , where'   -- ** References   , Reference (..)   , ref@@ -176,25 +173,42 @@   , noref   , refnil   -- ** Registry fields-  , loadedTableRegistryField-  , preloadTableRegistryField+  , loaded+  , preload+  -- * Haskell userdata values+  --+  -- | Push arbitrary Haskell values to the Lua stack.+  , newhsuserdata+  , newudmetatable+  , fromuserdata+  , putuserdata+  -- ** Haskell functions and closures+  , HaskellFunction+  , pushHaskellFunction+  , pushPreCFunction   -- * Error handling+  , LuaError (..)   , Exception (..)-  , throwException-  , catchException-  , withExceptionMessage   , try-  , throwMessage-  , errorMessage+  , failLua   , throwErrorAsException-  , throwTopMessage-  , throwTopMessageWithState+  , throwTypeMismatchError+  , changeErrorType+    -- ** Helpers+  , popErrorMessage+  , pushTypeMismatchError+    -- * Package+  , requirehs+  , preloadhs   ) where  import Prelude hiding (EQ, LT, compare, concat, error)  import HsLua.Core.Auxiliary+import HsLua.Core.Closures import HsLua.Core.Error-import HsLua.Core.Functions+import HsLua.Core.Package+import HsLua.Core.Primary import HsLua.Core.Run import HsLua.Core.Types as Lua+import HsLua.Core.Userdata

@@ -1,4 +1,6 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-} {-| Module      : HsLua.Core.Auxiliary Copyright   : © 2007–2012 Gracjan Polak;@@ -12,7 +14,8 @@ Wrappers for the auxiliary library. -} module HsLua.Core.Auxiliary-  ( dostring+  ( -- * The Auxiliary Library+    dostring   , dofile   , getmetafield   , getmetatable'@@ -24,84 +27,98 @@   , newstate   , tostring'   , traceback-  -- * References+  , where'+    -- ** References   , getref   , ref   , unref-  -- * Registry fields-  , loadedTableRegistryField-  , preloadTableRegistryField+    -- ** Registry fields+  , loaded+  , preload   ) where -import Control.Exception (IOException, try)+import Control.Monad ((<$!>)) import Data.ByteString (ByteString)-import Foreign.C (withCString)-import HsLua.Core.Types (Lua, Status, StackIndex, liftLua, multret)+import Data.String (IsString (fromString))+import HsLua.Core.Error (LuaError, throwErrorAsException)+import HsLua.Core.Types+  (LuaE, Name (Name), Status, StackIndex, liftLua, multret, runWith) import Lua (top) import Lua.Auxiliary import Lua.Ersatz.Auxiliary+import Foreign.C (withCString) import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr  import qualified Data.ByteString as B-import qualified HsLua.Core.Functions as Lua+import qualified HsLua.Core.Primary as Lua import qualified HsLua.Core.Types as Lua-import qualified HsLua.Core.Utf8 as Utf8 import qualified Foreign.Storable as Storable --- * The Auxiliary Library- -- | Loads and runs the given string. -- -- Returns 'Lua.OK' on success, or an error if either loading of the -- string or calling of the thunk failed.-dostring :: ByteString -> Lua Status+dostring :: ByteString -> LuaE e Status dostring s = do   loadRes <- loadstring s   if loadRes == Lua.OK     then Lua.pcall 0 multret Nothing     else return loadRes+{-# INLINABLE dostring #-} --- | Loads and runs the given file. Note that the filepath is interpreted by--- Haskell, not Lua. The resulting chunk is named using the UTF8 encoded--- filepath.-dofile :: FilePath -> Lua Status+-- | Loads and runs the given file. Note that the filepath is+-- interpreted by Haskell, not Lua. The resulting chunk is named using+-- the UTF8 encoded filepath.+dofile :: FilePath -> LuaE e Status dofile fp = do   loadRes <- loadfile fp   if loadRes == Lua.OK     then Lua.pcall 0 multret Nothing     else return loadRes+{-# INLINABLE dofile #-} --- | Pushes onto the stack the field @e@ from the metatable of the object at--- index @obj@ and returns the type of the pushed value. If the object does not--- have a metatable, or if the metatable does not have this field, pushes--- nothing and returns TypeNil.+-- | Pushes onto the stack the field @e@ from the metatable of the+-- object at index @obj@ and returns the type of the pushed value. If+-- the object does not have a metatable, or if the metatable does not+-- have this field, pushes nothing and returns 'TypeNil'.+--+-- Wraps 'luaL_getmetafield'. getmetafield :: StackIndex -- ^ obj-             -> String     -- ^ e-             -> Lua Lua.Type-getmetafield obj e = liftLua $ \l ->-  withCString e $ fmap Lua.toType . luaL_getmetafield l obj+             -> Name       -- ^ e+             -> LuaE e Lua.Type+getmetafield obj (Name name) = liftLua $ \l ->+  B.useAsCString name $! fmap Lua.toType . luaL_getmetafield l obj+{-# INLINABLE getmetafield #-} --- | Pushes onto the stack the metatable associated with name @tname@ in the--- registry (see @newmetatable@) (@nil@ if there is no metatable associated--- with that name). Returns the type of the pushed value.-getmetatable' :: String -- ^ tname-              -> Lua Lua.Type-getmetatable' tname = liftLua $ \l ->-  withCString tname $ fmap Lua.toType . luaL_getmetatable l+-- | Pushes onto the stack the metatable associated with name @tname@ in+-- the registry (see 'newmetatable') (@nil@ if there is no metatable+-- associated with that name). Returns the type of the pushed value.+--+-- Wraps 'luaL_getmetatable'.+getmetatable' :: Name      -- ^ tname+              -> LuaE e Lua.Type+getmetatable' (Name tname) = liftLua $ \l ->+  B.useAsCString tname $ fmap Lua.toType . luaL_getmetatable l+{-# INLINABLE getmetatable' #-}  -- | Push referenced value from the table at the given index.-getref :: StackIndex -> Reference -> Lua ()+getref :: LuaError e => StackIndex -> Reference -> LuaE e () getref idx ref' = Lua.rawgeti idx (fromIntegral (Lua.fromReference ref'))+{-# INLINABLE getref #-} --- | Ensures that the value @t[fname]@, where @t@ is the value at index @idx@,--- is a table, and pushes that table onto the stack. Returns True if it finds a--- previous table there and False if it creates a new table.-getsubtable :: StackIndex -> String -> Lua Bool-getsubtable idx fname = do+-- | Ensures that the value @t[fname]@, where @t@ is the value at index+-- @idx@, is a table, and pushes that table onto the stack. Returns True+-- if it finds a previous table there and False if it creates a new+-- table.+getsubtable :: LuaError e+            => StackIndex   -- ^ idx+            -> Name         -- ^ fname+            -> LuaE e Bool+getsubtable idx fname@(Name namestr) = do   -- This is a reimplementation of luaL_getsubtable from lauxlib.c.   idx' <- Lua.absindex idx-  Lua.pushstring (Utf8.fromString fname)+  Lua.pushstring namestr   Lua.gettable idx' >>= \case     Lua.TypeTable -> return True     _ -> do@@ -110,6 +127,7 @@       Lua.pushvalue top -- copy to be left at top       Lua.setfield idx' fname       return False+{-# INLINABLE getsubtable #-}  -- | Loads a ByteString as a Lua chunk. --@@ -117,14 +135,15 @@ -- chunk name, used for debug information and error messages. Note that -- @name@ is used as a C string, so it may not contain null-bytes. ----- See <https://www.lua.org/manual/5.3/manual.html#luaL_loadbuffer luaL_loadbuffer>.+-- Wraps 'luaL_loadbuffer'. loadbuffer :: ByteString -- ^ Program to load-           -> String     -- ^ chunk name-           -> Lua Status-loadbuffer bs name = liftLua $ \l ->+           -> Name       -- ^ chunk name+           -> LuaE e Status+loadbuffer bs (Name name) = liftLua $ \l ->   B.useAsCStringLen bs $ \(str, len) ->-  withCString name-    (fmap Lua.toStatus . luaL_loadbuffer l str (fromIntegral len))+  B.useAsCString name $!+    fmap Lua.toStatus . luaL_loadbuffer l str (fromIntegral len)+{-# INLINABLE loadbuffer #-}  -- | Loads a file as a Lua chunk. This function uses @lua_load@ (see -- @'Lua.load'@) to load the chunk in the file named filename. The first@@ -143,16 +162,10 @@ -- -- See <https://www.lua.org/manual/5.3/manual.html#luaL_loadfile luaL_loadfile>. loadfile :: FilePath -- ^ filename-         -> Lua Status-loadfile fp = Lua.liftIO contentOrError >>= \case-  Right script -> loadbuffer script ("@" ++ fp)-  Left e -> do-    Lua.pushstring (Utf8.fromString (show e))-    return Lua.ErrFile- where-  contentOrError :: IO (Either IOException ByteString)-  contentOrError = try (B.readFile fp)-+         -> LuaE e Status+loadfile fp = liftLua $ \l ->+  withCString fp $! fmap Lua.toStatus . luaL_loadfile l+{-# INLINABLE loadfile #-}  -- | Loads a string as a Lua chunk. This function uses @lua_load@ to -- load the chunk in the given ByteString. The given string may not@@ -164,28 +177,29 @@ -- Also as @'Lua.load'@, this function only loads the chunk; it does not -- run it. ----- See <https://www.lua.org/manual/5.3/manual.html#luaL_loadstring luaL_loadstring>.-loadstring :: ByteString -> Lua Status-loadstring s = loadbuffer s (Utf8.toString s)-+-- See+-- <https://www.lua.org/manual/5.3/manual.html#luaL_loadstring luaL_loadstring>.+loadstring :: ByteString -> LuaE e Status+loadstring s = loadbuffer s (Name s)+{-# INLINE loadstring #-} --- | If the registry already has the key tname, returns @False@. Otherwise,--- creates a new table to be used as a metatable for userdata, adds to this new--- table the pair @__name = tname@, adds to the registry the pair @[tname] = new--- table@, and returns @True@. (The entry @__name@ is used by some--- error-reporting functions.)+-- | If the registry already has the key tname, returns @False@.+-- Otherwise, creates a new table to be used as a metatable for+-- userdata, adds to this new table the pair @__name = tname@, adds to+-- the registry the pair @[tname] = new table@, and returns @True@. (The+-- entry @__name@ is used by some error-reporting functions.) ----- In both cases pushes onto the stack the final value associated with @tname@ in--- the registry.+-- In both cases pushes onto the stack the final value associated with+-- @tname@ in the registry. ----- The value of @tname@ is used as a C string and hence must not contain null--- bytes.+-- The value of @tname@ is used as a C string and hence must not contain+-- null bytes. ----- See also:--- <https://www.lua.org/manual/5.3/manual.html#luaL_newmetatable luaL_newmetatable>.-newmetatable :: String -> Lua Bool-newmetatable tname = liftLua $ \l ->-  Lua.fromLuaBool <$> withCString tname (luaL_newmetatable l)+-- Wraps 'luaL_newmetatable'.+newmetatable :: Name -> LuaE e Bool+newmetatable (Name tname) = liftLua $ \l ->+  Lua.fromLuaBool <$!> B.useAsCString tname (luaL_newmetatable l)+{-# INLINABLE newmetatable #-}  -- | Creates a new Lua state. It calls @lua_newstate@ with an allocator -- based on the standard C @realloc@ function and then sets a panic@@ -193,65 +207,101 @@ -- of the Lua 5.3 Reference Manual) that prints an error message to the -- standard error output in case of fatal errors. ----- See also:+-- Wraps 'hsluaL_newstate'. See also: -- <https://www.lua.org/manual/5.3/manual.html#luaL_newstate luaL_newstate>. newstate :: IO Lua.State newstate = hsluaL_newstate+{-# INLINE newstate #-} --- | Creates and returns a reference, in the table at index @t@, for the object--- at the top of the stack (and pops the object).+-- | Creates and returns a reference, in the table at index @t@, for the+-- object at the top of the stack (and pops the object). ----- A reference is a unique integer key. As long as you do not manually add--- integer keys into table @t@, @ref@ ensures the uniqueness of the key it--- returns. You can retrieve an object referred by reference @r@ by calling--- @rawgeti t r@. Function @'unref'@ frees a reference and its associated--- object.+-- A reference is a unique integer key. As long as you do not manually+-- add integer keys into table @t@, @ref@ ensures the uniqueness of the+-- key it returns. You can retrieve an object referred by reference @r@+-- by calling @rawgeti t r@. Function @'unref'@ frees a reference and+-- its associated object. -- -- If the object at the top of the stack is nil, @'ref'@ returns the -- constant @'Lua.refnil'@. The constant @'Lua.noref'@ is guaranteed to -- be different from any reference returned by @'ref'@. ----- See also: <https://www.lua.org/manual/5.3/manual.html#luaL_ref luaL_ref>.-ref :: StackIndex -> Lua Reference+-- Wraps 'luaL_ref'.+ref :: StackIndex -> LuaE e Reference ref t = liftLua $ \l -> Lua.toReference <$> luaL_ref l t+{-# INLINABLE ref #-} --- | Converts any Lua value at the given index to a @'ByteString'@ in a--- reasonable format. The resulting string is pushed onto the stack and also--- returned by the function.+-- | Converts any Lua value at the given index to a 'ByteString' in a+-- reasonable format. The resulting string is pushed onto the stack and+-- also returned by the function. ----- If the value has a metatable with a @__tostring@ field, then @tolstring'@--- calls the corresponding metamethod with the value as argument, and uses the--- result of the call as its result.-tostring' :: StackIndex -> Lua B.ByteString+-- If the value has a metatable with a @__tostring@ field, then+-- @tolstring'@ calls the corresponding metamethod with the value as+-- argument, and uses the result of the call as its result.+--+-- Wraps 'hsluaL_tolstring'.+tostring' :: forall e. LuaError e => StackIndex -> LuaE e B.ByteString tostring' n = do   l <- Lua.state-  e <- Lua.errorConversion   Lua.liftIO $ alloca $ \lenPtr -> do     cstr <- hsluaL_tolstring l n lenPtr     if cstr == nullPtr-      then Lua.errorToException e l+      then runWith @e l throwErrorAsException       else do         cstrLen <- Storable.peek lenPtr         B.packCStringLen (cstr, fromIntegral cstrLen)+{-# INLINABLE tostring' #-} --- | Creates and pushes a traceback of the stack L1. If a message is given it--- appended at the beginning of the traceback. The level parameter tells at--- which level to start the traceback.-traceback :: Lua.State -> Maybe String -> Int -> Lua ()+-- | Creates and pushes a traceback of the stack L1. If a message is+-- given it appended at the beginning of the traceback. The level+-- parameter tells at which level to start the traceback.+--+-- Wraps 'luaL_traceback'.+traceback :: Lua.State -> Maybe ByteString -> Int -> LuaE e () traceback l1 msg level = liftLua $ \l ->   case msg of     Nothing -> luaL_traceback l l1 nullPtr (fromIntegral level)-    Just msg' -> withCString msg' $ \cstr ->+    Just msg' -> B.useAsCString msg' $ \cstr ->       luaL_traceback l l1 cstr (fromIntegral level)+{-# INLINABLE traceback #-} --- | Releases reference @'ref'@ from the table at index @idx@ (see @'ref'@). The--- entry is removed from the table, so that the referred object can be--- collected. The reference @'ref'@ is also freed to be used again.+-- | Releases reference @'ref'@ from the table at index @idx@ (see+-- @'ref'@). The entry is removed from the table, so that the referred+-- object can be collected. The reference @'ref'@ is also freed to be+-- used again. ----- See also:+-- Wraps 'luaL_unref'. See also: -- <https://www.lua.org/manual/5.3/manual.html#luaL_unref luaL_unref>. unref :: StackIndex -- ^ idx       -> Reference  -- ^ ref-      -> Lua ()+      -> LuaE e () unref idx r = liftLua $ \l ->   luaL_unref l idx (Lua.fromReference r)+{-# INLINABLE unref #-}++-- | Pushes onto the stack a string identifying the current position of+-- the control at level @lvl@ in the call stack. Typically this string+-- has the following format:+--+-- > chunkname:currentline:+--+-- Level 0 is the running function, level 1 is the function that called+-- the running function, etc.+--+-- This function is used to build a prefix for error messages.+where' :: Int        -- ^ lvl+       -> LuaE e ()+where' lvl = liftLua $ \l -> luaL_where l (fromIntegral lvl)+{-# INLINABLE where' #-}++--+-- Registry fields+--++-- | Key to the registry field that holds the table of loaded modules.+loaded :: Name+loaded = fromString loadedTableRegistryField++-- | Key to the registry field that holds the table of loader functions.+preload :: Name+preload = fromString preloadTableRegistryField

@@ -0,0 +1,61 @@+{-|+Module      : HsLua.Core.Closures+Copyright   : © 2007–2012 Gracjan Polak;+              © 2012–2016 Ömer Sinan Ağacan;+              © 2017-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability   : beta+Portability : non-portable (depends on GHC)++Expose Haskell functions as Lua closures.+-}+module HsLua.Core.Closures+  ( pushPreCFunction+  , pushHaskellFunction+  ) where++import Prelude hiding (error)+import HsLua.Core.Error (LuaError (..))+import HsLua.Core.Primary (error)+import HsLua.Core.Types (LuaE, PreCFunction, HaskellFunction, liftLua, runWith)+import Lua.Call (hslua_pushhsfunction)+import qualified Control.Monad.Catch as Catch++-- | Converts a pre C function to a Lua function and pushes it to the+-- stack.+--+-- Pre C functions collect parameters from the stack and return a @CInt@+-- that represents number of return values left on the stack.+-- See 'Lua.CFunction' for more info.+pushPreCFunction :: PreCFunction -> LuaE e ()+pushPreCFunction preCFn = liftLua $ \l ->+  hslua_pushhsfunction l preCFn+{-# INLINABLE pushPreCFunction #-}++-- | Pushes Haskell function as a callable userdata. All values created+-- will be garbage collected. The function should behave similar to a+-- 'CFunction'.+--+-- Error conditions should be indicated by raising a catchable exception+-- or by returning the result of @'Lua.error'@.+--+-- Example:+--+-- > mod23 :: Lua NumResults+-- > mod23 = do+-- >   mn <- tointeger (nthBottom 1)+-- >   case mn of+-- >     Nothing -> pushstring "expected an integer" *> error+-- >     Just n  -> pushinteger (n `mod` 23)+-- > pushHaskellFunction mod23+-- > setglobal "mod23"+pushHaskellFunction :: LuaError e => HaskellFunction e -> LuaE e ()+pushHaskellFunction fn = do+  let preCFn l = runWith l (exceptionToError fn)+  pushPreCFunction preCFn+{-# INLINABLE pushHaskellFunction #-}++exceptionToError :: LuaError e => HaskellFunction e -> HaskellFunction e+exceptionToError op = op `Catch.catch` \e -> pushException e *> error+{-# INLINABLE exceptionToError #-}

@@ -1,39 +1,43 @@-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# OPTIONS_GHC -fno-warn-orphans       #-}+{-# LANGUAGE CPP                  #-}+{-# LANGUAGE DeriveDataTypeable   #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TypeApplications     #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- Don't warn about lua_concat; the way it's use here is safe.+{-# OPTIONS_GHC -Wno-warnings-deprecations #-} {-| Module      : HsLua.Core.Error Copyright   : © 2017-2021 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>-Stability   : beta-Portability : DeriveDataTypeable  Lua exceptions and exception handling. -} module HsLua.Core.Error   ( Exception (..)-  , catchException-  , throwException-  , withExceptionMessage-  , throwErrorAsException-  , throwTopMessage-  , throwTopMessageWithState-  , errorMessage+  , LuaError (..)+  , Lua   , try+  , failLua+  , throwErrorAsException+  , throwTypeMismatchError+  , changeErrorType     -- * Helpers for hslua C wrapper functions.-  , throwMessage   , liftLuaThrow+  , popErrorMessage+  , pushTypeMismatchError   ) where  import Control.Applicative (Alternative (..))+import Control.Monad ((<$!>), void) import Data.ByteString (ByteString)+import Data.Proxy (Proxy (Proxy)) import Data.Typeable (Typeable)-import HsLua.Core.Types (Lua)-import Lua (lua_pop, lua_pushlstring, hsluaL_tolstring) import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr+import HsLua.Core.Types (LuaE, liftLua)+import Lua  import qualified Control.Exception as E import qualified Control.Monad.Catch as Catch@@ -41,11 +45,38 @@ import qualified Data.ByteString.Char8 as Char8 import qualified Data.ByteString.Unsafe as B import qualified Foreign.Storable as Storable-import qualified Lua.Types as Lua import qualified HsLua.Core.Types as Lua import qualified HsLua.Core.Utf8 as Utf8 --- | Exceptions raised by Lua-related operations.+#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail (..))+#endif++-- | A Lua operation.+--+-- This type is suitable for most users. It uses a default exception for+-- error handling. Users who need more control over error handling can+-- use 'LuaE' with a custom error type instead.+type Lua a = LuaE Exception a++-- | Any type that you wish to use for error handling in HsLua must be+-- an instance of the @LuaError@ class.+class E.Exception e => LuaError e where+  -- | Converts the error at the top of the stack into an exception and+  -- pops the error off the stack.+  --+  -- This function is expected to produce a valid result for any Lua+  -- value; neither a Haskell exception nor a Lua error may result when+  -- this is called.+  popException :: LuaE e e+  -- | Pushes an exception to the top of the Lua stack. The pushed Lua+  -- object is used as an error object, and it is recommended that+  -- calling @tostring()@ on the object produces an informative message.+  pushException :: e -> LuaE e ()+  -- | Creates a new exception with the given message.+  luaException :: String -> e++-- | Default Lua error type. Exceptions raised by Lua-related operations. newtype Exception = Exception { exceptionMessage :: String}   deriving (Eq, Typeable) @@ -54,91 +85,129 @@  instance E.Exception Exception --- | Raise a Lua @'Exception'@ containing the given error message.-throwException :: String -> Lua a-throwException = Catch.throwM . Exception-{-# INLINABLE throwException #-}+instance LuaError Exception where+  popException = do+    Exception . Utf8.toString <$!> liftLua popErrorMessage+  {-# INLINABLE popException #-} --- | Catch a Lua @'Exception'@.-catchException :: Lua a -> (Exception -> Lua a) -> Lua a-catchException = Catch.catch-{-# INLINABLE catchException #-}+  pushException (Exception msg) = Lua.liftLua $ \l ->+    B.unsafeUseAsCStringLen (Utf8.fromString msg) $ \(msgPtr, z) ->+      lua_pushlstring l msgPtr (fromIntegral z)+  {-# INLINABLE pushException #-} --- | Catch Lua @'Exception'@, alter the message and rethrow.-withExceptionMessage :: (String -> String) -> Lua a -> Lua a-withExceptionMessage modifier luaOp =-  luaOp `catchException` \(Exception msg) -> throwException (modifier msg)-{-# INLINABLE withExceptionMessage #-}+  luaException = Exception+  {-# INLINABLE luaException #-}  -- | Return either the result of a Lua computation or, if an exception was -- thrown, the error.-try :: Lua a -> Lua (Either Exception a)+try :: Catch.Exception e => LuaE e a -> LuaE e (Either e a) try = Catch.try {-# INLINABLE try #-} --- | Convert a Lua error into a Haskell exception. The error message is--- expected to be at the top of the stack.-throwErrorAsException :: Lua a+-- | Raises an exception in the Lua monad.+failLua :: forall e a. LuaError e => String -> LuaE e a+failLua msg = Catch.throwM (luaException @e msg)+{-# INLINABLE failLua #-}++-- | Converts a Lua error at the top of the stack into a Haskell+-- exception and throws it.+throwErrorAsException :: LuaError e => LuaE e a throwErrorAsException = do-  e <- Lua.errorConversion-  l <- Lua.state-  Lua.liftIO (Lua.errorToException e l)+  err <- popException+  Catch.throwM $! err+{-# INLINABLE throwErrorAsException #-} --- | Alias for `throwErrorAsException`; will be deprecated in the next--- mayor release.-throwTopMessage :: Lua a-throwTopMessage = throwErrorAsException+-- | Raises an exception that's appropriate when the type of a Lua+-- object at the given index did not match the expected type. The name+-- or description of the expected type is taken as an argument.+throwTypeMismatchError :: forall e a. LuaError e+                       => ByteString -> StackIndex -> LuaE e a+throwTypeMismatchError expected idx = do+  pushTypeMismatchError expected idx+  throwErrorAsException+{-# INLINABLE throwTypeMismatchError #-} --- | Helper function which uses proper error-handling to throw an--- exception with the given message.-throwMessage :: String -> Lua a-throwMessage msg = do-  Lua.liftLua $ \l ->-    B.unsafeUseAsCStringLen (Utf8.fromString msg) $ \(msgPtr, z) ->-      lua_pushlstring l msgPtr (fromIntegral z)-  e <- Lua.errorConversion-  Lua.liftLua (Lua.errorToException e)+-- | Change the error type of a computation.+changeErrorType :: forall old new a. LuaE old a -> LuaE new a+changeErrorType op = Lua.liftLua $ \l -> do+  x <- Lua.runWith l op+  return $! x+{-# INLINABLE changeErrorType #-} -instance Alternative Lua where-  empty = throwMessage "empty"-  x <|> y = do-    e <- Lua.errorConversion-    Lua.alternative e x y --- | Convert the object at the top of the stack into a string and throw--- it as a HsLua @'Exception'@. ----- This function serves as the default to convert Lua errors to Haskell--- exceptions.-throwTopMessageWithState :: Lua.State -> IO a-throwTopMessageWithState l = do-  msg <- Lua.liftIO (errorMessage l)-  Catch.throwM $ Exception (Utf8.toString msg)+-- Orphan instances+-- +instance LuaError e => Alternative (LuaE e) where+  empty = failLua "empty"+  x <|> y = x `Catch.catch` (\(_ :: e) -> y)++instance LuaError e => MonadFail (LuaE e) where+  fail = failLua++--+-- Helpers+--+ -- | Takes a failable HsLua function and transforms it into a -- monadic 'Lua' operation. Throws an exception if an error -- occured.-liftLuaThrow :: (Lua.State -> Ptr Lua.StatusCode -> IO a) -> Lua a-liftLuaThrow f = do-  (result, status) <- Lua.liftLua $ \l -> alloca $ \statusPtr -> do-    result <- f l statusPtr-    status <- Lua.toStatus <$> Storable.peek statusPtr-    return (result, status)-  if status == Lua.OK-    then return result-    else throwTopMessage+liftLuaThrow :: forall e a. LuaError e+             => (Lua.State -> Ptr Lua.StatusCode -> IO a)+             -> LuaE e a+liftLuaThrow f = Lua.liftLua (throwOnError (Proxy @e) f) --- | Retrieve and pop the top object as an error message. This is very similar--- to tostring', but ensures that we don't recurse if getting the message--- failed.-errorMessage :: Lua.State -> IO ByteString-errorMessage l = alloca $ \lenPtr -> do+-- | Helper function which takes an ersatz function and checks for+-- errors during its execution. If an error occured, it is converted+-- into a 'LuaError' and thrown as an exception.+throwOnError :: forall e a. LuaError e+             => Proxy e+             -> (Lua.State -> Ptr Lua.StatusCode -> IO a)+             -> Lua.State+             -> IO a+throwOnError _errProxy f l = alloca $ \statusPtr -> do+  result <- f l statusPtr+  status <- Storable.peek statusPtr+  if status == LUA_OK+    then return $! result+    else Lua.runWith l (throwErrorAsException @e)+++-- | Retrieve and pop the top object as an error message. This is very+-- similar to tostring', but ensures that we don't recurse if getting+-- the message failed.+--+-- This helpful as a \"last resort\" method when implementing+-- 'peekException'.+popErrorMessage :: Lua.State -> IO ByteString+popErrorMessage l = alloca $ \lenPtr -> do   cstr <- hsluaL_tolstring l (-1) lenPtr   if cstr == nullPtr-    then return $ Char8.pack ("An error occurred, but the error object " ++-                              "cannot be converted into a string.")+    then do+      lua_pop l 1+      return $ Char8.pack+        "An error occurred, but the error object could not be retrieved."     else do       cstrLen <- Storable.peek lenPtr       msg <- B.packCStringLen (cstr, fromIntegral cstrLen)-      lua_pop l 2+      lua_pop l 2  -- pop original msg and product of hsluaL_tolstring       return msg++-- | Creates an error to notify about a Lua type mismatch and pushes it+-- to the stack.+pushTypeMismatchError :: ByteString  -- ^ name or description of expected type+                      -> StackIndex  -- ^ stack index of mismatching object+                      -> LuaE e ()+pushTypeMismatchError expected idx = liftLua $ \l -> do+  idx' <- lua_absindex l idx+  let pushstring str = B.unsafeUseAsCStringLen str $ \(cstr, cstrLen) ->+        lua_pushlstring l cstr (fromIntegral cstrLen)+  let pushtype = lua_type l idx' >>= lua_typename l >>= lua_pushstring l+  pushstring expected+  pushstring " expected, got "+  B.unsafeUseAsCString "__name" (luaL_getmetafield l idx) >>= \case+    LUA_TSTRING -> return () -- pushed the name+    LUA_TNIL    -> void pushtype+    _           -> lua_pop l 1 <* pushtype+  lua_concat l 3

@@ -1,945 +0,0 @@-{-|-Module      : HsLua.Core.Functions-Copyright   : © 2007–2012 Gracjan Polak;-              © 2012–2016 Ömer Sinan Ağacan;-              © 2017-2021 Albert Krewinkel-License     : MIT-Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>-Stability   : beta-Portability : non-portable (depends on GHC)--Monadic functions which operate within the Lua type.--The functions in this module are mostly just thin wrappers around the respective-C functions. However, C function which can throw an error are wrapped such that-the error is converted into an @'Exception'@. Memory allocation errors,-however, are not caught and will cause the host program to terminate.--}-module HsLua.Core.Functions where--import Prelude hiding (EQ, LT, compare, concat, error)--import Control.Monad-import Data.ByteString (ByteString)-import Data.Maybe (fromMaybe)-import HsLua.Core.Error-import HsLua.Core.Types as Lua-import Lua-import Foreign.Marshal.Alloc (alloca)-import Foreign.Ptr--import qualified Data.ByteString as B-import qualified Data.ByteString.Unsafe as B-import qualified Foreign.C as C-import qualified HsLua.Core.Utf8 as Utf8-import qualified Foreign.Storable as F------- Helper functions------- | Execute an action only if the given index is a table. Throw an--- error otherwise.-ensureTable :: StackIndex -> (Lua.State -> IO ()) -> Lua ()-ensureTable idx ioOp = do-  isTbl <- istable idx-  if isTbl-    then liftLua ioOp-    else do-      tyName <- ltype idx >>= typename-      throwMessage ("table expected, got " ++ tyName)------- API functions------- | Converts the acceptable index @idx@ into an equivalent absolute index (that--- is, one that does not depend on the stack top).-absindex :: StackIndex -> Lua StackIndex-absindex = liftLua1 lua_absindex---- |  Calls a function.------ To call a function you must use the following protocol: first, the function--- to be called is pushed onto the stack; then, the arguments to the function--- are pushed in direct order; that is, the first argument is pushed first.--- Finally you call @call@; @nargs@ is the number of arguments that you pushed--- onto the stack. All arguments and the function value are popped from the--- stack when the function is called. The function results are pushed onto the--- stack when the function returns. The number of results is adjusted to--- @nresults@, unless @nresults@ is @multret@. In this case, all results from--- the function are pushed. Lua takes care that the returned values fit into the--- stack space. The function results are pushed onto the stack in direct order--- (the first result is pushed first), so that after the call the last result is--- on the top of the stack.------ Any error inside the called function cause a @'Exception'@ to be thrown.------ The following example shows how the host program can do the equivalent to--- this Lua code:------ > a = f("how", t.x, 14)------ Here it is in Haskell (assuming the OverloadedStrings language extension):------ > getglobal "f"         -- function to be called--- > pushstring  "how"     -- 1st argument--- > getglobal "t"         -- table to be indexed--- > getfield (-1) "x"     -- push result of t.x (2nd arg)--- > remove (-2)           -- remove 't' from the stack--- > pushinteger 14        -- 3rd argument--- > call 3 1              -- call 'f' with 3 arguments and 1 result--- > setglobal "a"         -- set global 'a'------ Note that the code above is "balanced": at its end, the stack is back to its--- original configuration. This is considered good programming practice.------ See <https://www.lua.org/manual/5.3/manual.html#lua_call lua_call>.-call :: NumArgs -> NumResults -> Lua ()-call nargs nresults = do-  res <- pcall nargs nresults Nothing-  when (res /= OK) throwTopMessage---- | Ensures that the stack has space for at least @n@ extra slots (that is,--- that you can safely push up to @n@ values into it). It returns false if it--- cannot fulfill the request, either because it would cause the stack to be--- larger than a fixed maximum size (typically at least several thousand--- elements) or because it cannot allocate memory for the extra space. This--- function never shrinks the stack; if the stack already has space for the--- extra slots, it is left unchanged.------ This is a wrapper function of--- <https://www.lua.org/manual/5.3/manual.html#lua_checkstack lua_checkstack>.-checkstack :: Int -> Lua Bool-checkstack n = liftLua $ \l -> fromLuaBool <$> lua_checkstack l (fromIntegral n)---- | Destroys all objects in the given Lua state (calling the corresponding--- garbage-collection metamethods, if any) and frees all dynamic memory used by--- this state. On several platforms, you may not need to call this function,--- because all resources are naturally released when the host program ends. On--- the other hand, long-running programs that create multiple states, such as--- daemons or web servers, will probably need to close states as soon as they--- are not needed.------ This is a wrapper function of--- <https://www.lua.org/manual/5.3/manual.html#lua_close lua_close>.-close :: Lua.State -> IO ()-close = lua_close---- | Compares two Lua values. Returns @True@ if the value at index @idx1@--- satisfies @op@ when compared with the value at index @idx2@, following the--- semantics of the corresponding Lua operator (that is, it may call--- metamethods). Otherwise returns @False@. Also returns @False@ if any of the--- indices is not valid.------ The value of op must be of type @RelationalOperator@:------    EQ: compares for equality (==)---    LT: compares for less than (<)---    LE: compares for less or equal (<=)------ This is a wrapper function of--- <https://www.lua.org/manual/5.3/manual.html#lua_compare lua_compare>.-compare :: StackIndex -> StackIndex -> RelationalOperator -> Lua Bool-compare idx1 idx2 relOp = fromLuaBool <$> do-  liftLuaThrow $ \l -> hslua_compare l idx1 idx2 (fromRelationalOperator relOp)---- | Concatenates the @n@ values at the top of the stack, pops them, and leaves--- the result at the top. If @n@ is 1, the result is the single value on the--- stack (that is, the function does nothing); if @n@ is 0, the result is the--- empty string. Concatenation is performed following the usual semantics of Lua--- (see <https://www.lua.org/manual/5.3/manual.html#3.4.6 §3.4.6> of the lua--- manual).------ This is a wrapper function of--- <https://www.lua.org/manual/5.3/manual.html#lua_concat lua_concat>.-concat :: NumArgs -> Lua ()-concat n = liftLuaThrow (`hslua_concat` n)---- | Copies the element at index @fromidx@ into the valid index @toidx@,--- replacing the value at that position. Values at other positions are not--- affected.------ See also <https://www.lua.org/manual/5.3/manual.html#lua_copy lua_copy> in--- the lua manual.-copy :: StackIndex -> StackIndex -> Lua ()-copy fromidx toidx = liftLua $ \l -> lua_copy l fromidx toidx---- | Creates a new empty table and pushes it onto the stack. Parameter narr is a--- hint for how many elements the table will have as a sequence; parameter nrec--- is a hint for how many other elements the table will have. Lua may use these--- hints to preallocate memory for the new table. This preallocation is useful--- for performance when you know in advance how many elements the table will--- have. Otherwise you can use the function lua_newtable.------ This is a wrapper for function--- <https://www.lua.org/manual/5.3/manual.html#lua_createtable lua_createtable>.-createtable :: Int -> Int -> Lua ()-createtable narr nrec = liftLua $ \l ->-  lua_createtable l (fromIntegral narr) (fromIntegral nrec)---- TODO: implement dump---- | Returns @True@ if the two values in acceptable indices index1 and--- index2 are equal, following the semantics of the Lua @==@ operator--- (that is, may call metamethods). Otherwise returns @False@. Also--- returns @False@ if any of the indices is non valid. Uses @'compare'@--- internally.-equal :: StackIndex  -- ^ index1-      -> StackIndex  -- ^ index2-      -> Lua Bool-equal index1 index2 = compare index1 index2 EQ---- | This is a convenience function to implement error propagation--- convention described in [Error handling in hslua](#g:1). hslua--- doesn't implement the @lua_error@ function from Lua C API because--- it's never safe to use. (see [Error handling in hslua](#g:1) for--- details)-error :: Lua NumResults-error = liftLua hslua_error---- |  Controls the garbage collector.------ This function performs several tasks, according to the value of the parameter--- what:------   * @'GCSTOP'@: stops the garbage collector.------   * @'GCRESTART'@: restarts the garbage collector.------   * @'GCCOLLECT'@: performs a full garbage-collection cycle.------   * @'GCCOUNT'@: returns the current amount of memory (in Kbytes) in use by---     Lua.------   * @'GCCOUNTB'@: returns the remainder of dividing the current amount of---     bytes of memory in use by Lua by 1024.------   * @'GCSTEP'@: performs an incremental step of garbage collection. The step---     "size" is controlled by data (larger values mean more steps) in a---     non-specified way. If you want to control the step size you must---     experimentally tune the value of data. The function returns 1 if the step---     finished a garbage-collection cycle.------   * @'GCSETPAUSE@': sets data as the new value for the pause of the collector---     (see §2.10). The function returns the previous value of the pause.------   * @'GCSETSTEPMUL'@: sets data as the new value for the step multiplier of---     the collector (see §2.10). The function returns the previous value of the---     step multiplier.------ See <https://www.lua.org/manual/5.3/manual.html#lua_gc lua_gc>.-gc :: GCCONTROL -> Int -> Lua Int-gc what data' = liftLua $ \l ->-  fromIntegral <$> lua_gc l (toGCCode what) (fromIntegral data')---- | Pushes onto the stack the value @t[k]@, where @t@ is the value at the given--- stack index. As in Lua, this function may trigger a metamethod for the--- "index" event (see <https://www.lua.org/manual/5.3/manual.html#2.4 §2.4> of--- lua's manual).------ Errors on the Lua side are caught and rethrown as @'Exception'@.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_getfield lua_getfield>.-getfield :: StackIndex -> String -> Lua Type-getfield i s = do-  absidx <- absindex i-  pushstring (Utf8.fromString s)-  gettable absidx---- | Pushes onto the stack the value of the global @name@.------ Errors on the Lua side are caught and rethrown as @'Exception'@.------ Wrapper of--- <https://www.lua.org/manual/5.3/manual.html#lua_getglobal lua_getglobal>.-getglobal :: String -> Lua Type-getglobal name = liftLuaThrow $ \l status' ->-  C.withCStringLen name $ \(namePtr, len) ->-  toType <$> hslua_getglobal l namePtr (fromIntegral len) status'---- | If the value at the given index has a metatable, the function pushes that--- metatable onto the stack and returns @True@. Otherwise, the function returns--- @False@ and pushes nothing on the stack.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_getmetatable lua_getmetatable>.-getmetatable :: StackIndex -> Lua Bool-getmetatable n = liftLua $ \l ->-  fromLuaBool <$> lua_getmetatable l n---- | Pushes onto the stack the value @t[k]@, where @t@ is the value at the given--- index and @k@ is the value at the top of the stack.------ This function pops the key from the stack, pushing the resulting value in its--- place. As in Lua, this function may trigger a metamethod for the "index"--- event (see <https://www.lua.org/manual/5.3/manual.html#2.4 §2.4> of lua's--- manual).------ Errors on the Lua side are caught and rethrown as @'Exception'@.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_gettable lua_gettable>.-gettable :: StackIndex -> Lua Type-gettable n = liftLuaThrow (\l -> fmap toType . hslua_gettable l n)---- | Returns the index of the top element in the stack. Because indices start at--- 1, this result is equal to the number of elements in the stack (and so 0--- means an empty stack).------ See also: <https://www.lua.org/manual/5.3/manual.html#lua_gettop lua_gettop>.-gettop :: Lua StackIndex-gettop = liftLua lua_gettop---- | Moves the top element into the given valid index, shifting up the elements--- above this index to open space. This function cannot be called with a--- pseudo-index, because a pseudo-index is not an actual stack position.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_insert lua_insert>.-insert :: StackIndex -> Lua ()-insert index = liftLua $ \l -> lua_insert l index---- | Returns @True@ if the value at the given index is a boolean, and @False@--- otherwise.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_isboolean lua_isboolean>.-isboolean :: StackIndex -> Lua Bool-isboolean n = liftLua $ \l -> fromLuaBool <$> lua_isboolean l n---- | Returns @True@ if the value at the given index is a C function, and @False@--- otherwise.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_iscfunction lua_iscfunction>.-iscfunction :: StackIndex -> Lua Bool-iscfunction n = liftLua $ \l -> fromLuaBool <$> lua_iscfunction l n---- | Returns @True@ if the value at the given index is a function (either C or--- Lua), and @False@ otherwise.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_isfunction lua_isfunction>.-isfunction :: StackIndex -> Lua Bool-isfunction n = (== TypeFunction) <$> ltype n---- | Returns @True@ if the value at the given index is an integer (that is, the--- value is a number and is represented as an integer), and @False@ otherwise.-isinteger :: StackIndex -> Lua Bool-isinteger n = liftLua $ \l -> fromLuaBool <$> lua_isinteger l n---- | Returns @True@ if the value at the given index is a light userdata, and--- @False@ otherwise.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_islightuserdata \--- lua_islightuserdata>.-islightuserdata :: StackIndex -> Lua Bool-islightuserdata n = (== TypeLightUserdata) <$> ltype n---- | Returns @True@ if the value at the given index is @nil@, and @False@--- otherwise.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_isnil lua_isnil>.-isnil :: StackIndex -> Lua Bool-isnil n = (== TypeNil) <$> ltype n---- | Returns @True@ if the given index is not valid, and @False@ otherwise.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_isnone lua_isnone>.-isnone :: StackIndex -> Lua Bool-isnone n = (== TypeNone) <$> ltype n---- | Returns @True@ if the given index is not valid or if the value at the given--- index is @nil@, and @False@ otherwise.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_isnoneornil lua_isnoneornil>.-isnoneornil :: StackIndex -> Lua Bool-isnoneornil idx = (<= TypeNil) <$> ltype idx---- | Returns @True@ if the value at the given index is a number or a string--- convertible to a number, and @False@ otherwise.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_isnumber lua_isnumber>.-isnumber :: StackIndex -> Lua Bool-isnumber n = liftLua $ \l -> fromLuaBool <$> lua_isnumber l n---- | Returns @True@ if the value at the given index is a string or a number--- (which is always convertible to a string), and @False@ otherwise.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_isstring lua_isstring>.-isstring :: StackIndex -> Lua Bool-isstring n = liftLua $ \l -> fromLuaBool <$> lua_isstring l n---- | Returns @True@ if the value at the given index is a table, and @False@--- otherwise.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_istable lua_istable>.-istable :: StackIndex -> Lua Bool-istable n = (== TypeTable) <$> ltype n---- | Returns @True@ if the value at the given index is a thread, and @False@--- otherwise.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_isthread lua_isthread>.-isthread :: StackIndex -> Lua Bool-isthread n = (== TypeThread) <$> ltype n---- | Returns @True@ if the value at the given index is a userdata (either full--- or light), and @False@ otherwise.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_isuserdata lua_isuserdata>.-isuserdata :: StackIndex -> Lua Bool-isuserdata n = liftLua $ \l -> fromLuaBool <$> lua_isuserdata l n---- | Tests whether the object under the first index is smaller than that under--- the second. Uses @'compare'@ internally.-lessthan :: StackIndex -> StackIndex -> Lua Bool-lessthan index1 index2 = compare index1 index2 LT---- | Loads a Lua chunk (without running it). If there are no errors, @'load'@--- pushes the compiled chunk as a Lua function on top of the stack. Otherwise,--- it pushes an error message.------ The return values of @'load'@ are:------ - @'OK'@: no errors;--- - @'ErrSyntax'@: syntax error during pre-compilation;--- - @'ErrMem'@: memory allocation error;--- - @'ErrGcmm'@: error while running a @__gc@ metamethod. (This error has no---   relation with the chunk being loaded. It is generated by the garbage---   collector.)------ This function only loads a chunk; it does not run it.------ @load@ automatically detects whether the chunk is text or binary, and loads--- it accordingly (see program luac).------ The @'load'@ function uses a user-supplied reader function to read the chunk--- (see @'Lua.Reader'@). The data argument is an opaque value passed to the--- reader function.------ The @chunkname@ argument gives a name to the chunk, which is used for error--- messages and in debug information (see--- <https://www.lua.org/manual/5.3/manual.html#4.9 §4.9>). Note that the--- @chunkname@ is used as a C string, so it may not contain null-bytes.-load :: Lua.Reader -> Ptr () -> ByteString -> Lua Status-load reader data' chunkname = liftLua $ \l ->-  B.useAsCString chunkname $ \namePtr ->-  toStatus <$> lua_load l reader data' namePtr nullPtr---- | Returns the type of the value in the given valid index, or @'TypeNone'@ for--- a non-valid (but acceptable) index.------ See <https://www.lua.org/manual/5.3/manual.html#lua_type lua_type>.-ltype :: StackIndex -> Lua Type-ltype idx = toType <$> liftLua (`lua_type` idx)---- | Creates a new empty table and pushes it onto the stack. It is equivalent to--- @createtable 0 0@.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_newtable lua_newtable>.-newtable :: Lua ()-newtable = createtable 0 0---- | This function allocates a new block of memory with the given size, pushes--- onto the stack a new full userdata with the block address, and returns this--- address. The host program can freely use this memory.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_newuserdata lua_newuserdata>.-newuserdata :: Int -> Lua (Ptr ())-newuserdata = liftLua1 lua_newuserdata . fromIntegral---- | Pops a key from the stack, and pushes a key–value pair from the table at--- the given index (the "next" pair after the given key). If there are no more--- elements in the table, then @next@ returns @False@ (and pushes nothing).------ Errors on the Lua side are caught and rethrown as a @'Exception'@.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_next lua_next>.-next :: StackIndex -> Lua Bool-next idx = fromLuaBool <$> liftLuaThrow (\l -> hslua_next l idx)---- | Opens all standard Lua libraries into the current state and sets each--- library name as a global value.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#luaL_openlibs luaL_openlibs>.-openlibs :: Lua ()-openlibs = liftLua luaL_openlibs---- | Pushes Lua's /base/ library onto the stack.------ See <https://www.lua.org/manual/5.3/manual.html#pdf-luaopen_base luaopen_base>.-openbase :: Lua ()-openbase = pushcfunction luaopen_base *> call 0 multret---- | Pushes Lua's /debug/ library onto the stack.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#pdf-luaopen_debug luaopen_debug>.-opendebug :: Lua ()-opendebug = pushcfunction luaopen_debug *> call 0 multret---- | Pushes Lua's /io/ library onto the stack.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#pdf-luaopen_io luaopen_io>.-openio :: Lua ()-openio = pushcfunction luaopen_io *> call 0 multret---- | Pushes Lua's /math/ library onto the stack.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#pdf-luaopen_math luaopen_math>.-openmath :: Lua ()-openmath = pushcfunction luaopen_math *> call 0 multret---- | Pushes Lua's /os/ library onto the stack.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#pdf-luaopen_os luaopen_os>.-openos :: Lua ()-openos = pushcfunction luaopen_os *> call 0 multret---- | Pushes Lua's /package/ library onto the stack.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#pdf-luaopen_package luaopen_package>.-openpackage :: Lua ()-openpackage = pushcfunction luaopen_package *> call 0 multret---- | Pushes Lua's /string/ library onto the stack.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#pdf-luaopen_string luaopen_string>.-openstring :: Lua ()-openstring = pushcfunction luaopen_string *> call 0 multret---- | Pushes Lua's /table/ library onto the stack.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#pdf-luaopen_table luaopen_table>.-opentable :: Lua ()-opentable = pushcfunction luaopen_table *> call 0 multret---- | Calls a function in protected mode.------ Both @nargs@ and @nresults@ have the same meaning as in @'call'@. If there--- are no errors during the call, @pcall@ behaves exactly like @'call'@.--- However, if there is any error, @pcall@ catches it, pushes a single value on--- the stack (the error message), and returns the error code. Like @'call'@,--- @pcall@ always removes the function and its arguments from the stack.------ If @msgh@ is @Nothing@, then the error object returned on the stack is--- exactly the original error object. Otherwise, when @msgh@ is @Just idx@, the--- stack index @idx@ is the location of a message handler. (This index cannot be--- a pseudo-index.) In case of runtime errors, this function will be called with--- the error object and its return value will be the object returned on the--- stack by @'pcall'@.------ Typically, the message handler is used to add more debug information to the--- error object, such as a stack traceback. Such information cannot be gathered--- after the return of @'pcall'@, since by then the stack has unwound.------ See <https://www.lua.org/manual/5.3/manual.html#lua_pcall lua_pcall>.-pcall :: NumArgs -> NumResults -> Maybe StackIndex -> Lua Status-pcall nargs nresults msgh = liftLua $ \l ->-  toStatus <$> lua_pcall l nargs nresults (fromMaybe 0 msgh)---- | Pops @n@ elements from the stack.------ See also: <https://www.lua.org/manual/5.3/manual.html#lua_pop lua_pop>.-pop :: Int -> Lua ()-pop n = liftLua $ \l -> lua_pop l (fromIntegral n)---- | Pushes a boolean value with the given value onto the stack.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_pushboolean lua_pushboolean>.-pushboolean :: Bool -> Lua ()-pushboolean b = liftLua $ \l -> lua_pushboolean l (toLuaBool b)---- | Pushes a new C closure onto the stack.------ When a C function is created, it is possible to associate some values with--- it, thus creating a C closure (see--- <https://www.lua.org/manual/5.1/manual.html#3.4 §3.4>); these values are then--- accessible to the function whenever it is called. To associate values with a--- C function, first these values should be pushed onto the stack (when there--- are multiple values, the first value is pushed first). Then lua_pushcclosure--- is called to create and push the C function onto the stack, with the argument--- @n@ telling how many values should be associated with the function.--- lua_pushcclosure also pops these values from the stack.------ The maximum value for @n@ is 255.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_pushcclosure lua_pushcclosure>.-pushcclosure :: CFunction -> NumArgs -> Lua ()-pushcclosure f n = liftLua $ \l -> lua_pushcclosure l f n---- | Pushes a C function onto the stack. This function receives a pointer to a C--- function and pushes onto the stack a Lua value of type function that, when--- called, invokes the corresponding C function.------ Any function to be callable by Lua must follow the correct protocol to--- receive its parameters and return its results (see @'CFunction'@)------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_pushcfunction lua_pushcfunction>.-pushcfunction :: CFunction -> Lua ()-pushcfunction f = pushcclosure f 0---- | Pushes the global environment onto the stack.------ Wraps <https://www.lua.org/manual/5.3/manual.html#lua_pushglobaltable \--- lua_pushglobaltable>.-pushglobaltable :: Lua ()-pushglobaltable = liftLua lua_pushglobaltable---- | Pushes an integer with with the given value onto the stack.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_pushinteger lua_pushinteger>.-pushinteger :: Lua.Integer -> Lua ()-pushinteger = liftLua1 lua_pushinteger---- |  Pushes a light userdata onto the stack.------ Userdata represent C values in Lua. A light userdata represents a pointer, a--- @Ptr ()@ (i.e., @void*@ in C lingo). It is a value (like a number): you do--- not create it, it has no individual metatable, and it is not collected (as it--- was never created). A light userdata is equal to "any" light userdata with--- the same C address.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_pushlightuserdata lua_pushlightuserdata>.-pushlightuserdata :: Ptr a -> Lua ()-pushlightuserdata = liftLua1 lua_pushlightuserdata---- | Pushes a nil value onto the stack.------ See <https://www.lua.org/manual/5.3/manual.html#lua_pushnil lua_pushnil>.-pushnil :: Lua ()-pushnil = liftLua lua_pushnil---- | Pushes a float with the given value onto the stack.------ See <https://www.lua.org/manual/5.3/manual.html#lua_pushnumber lua_pushnumber>.-pushnumber :: Lua.Number -> Lua ()-pushnumber = liftLua1 lua_pushnumber---- | Pushes the zero-terminated string pointed to by s onto the stack. Lua makes--- (or reuses) an internal copy of the given string, so the memory at s can be--- freed or reused immediately after the function returns.------ See also: <https://www.lua.org/manual/5.3/manual.html#lua_pushstring \--- lua_pushstring>.-pushstring :: ByteString -> Lua ()-pushstring s = liftLua $ \l ->-  B.unsafeUseAsCStringLen s $ \(sPtr, z) -> lua_pushlstring l sPtr (fromIntegral z)---- | Pushes the current thread onto the stack. Returns @True@ if this thread is--- the main thread of its state, @False@ otherwise.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_pushthread lua_pushthread>.-pushthread :: Lua Bool-pushthread = (1 ==)  <$> liftLua lua_pushthread---- | Pushes a copy of the element at the given index onto the stack.------ See <https://www.lua.org/manual/5.3/manual.html#lua_pushvalue lua_pushvalue>.-pushvalue :: StackIndex -> Lua ()-pushvalue n = liftLua $ \l -> lua_pushvalue l n---- | Returns @True@ if the two values in indices @idx1@ and @idx2@ are--- primitively equal (that is, without calling the @__eq@ metamethod). Otherwise--- returns @False@. Also returns @False@ if any of the indices are not valid.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_rawequal lua_rawequal>.-rawequal :: StackIndex -> StackIndex -> Lua Bool-rawequal idx1 idx2 = liftLua $ \l ->-  fromLuaBool <$> lua_rawequal l idx1 idx2---- | Similar to @'gettable'@, but does a raw access (i.e., without metamethods).------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_rawget lua_rawget>.-rawget :: StackIndex -> Lua ()-rawget n = ensureTable n (\l -> lua_rawget l n)---- | Pushes onto the stack the value @t[n]@, where @t@ is the table at the given--- index. The access is raw, that is, it does not invoke the @__index@--- metamethod.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_rawgeti lua_rawgeti>.-rawgeti :: StackIndex -> Lua.Integer -> Lua ()-rawgeti k n = ensureTable k (\l -> lua_rawgeti l k n)---- | Returns the raw "length" of the value at the given index: for strings, this--- is the string length; for tables, this is the result of the length operator--- (@#@) with no metamethods; for userdata, this is the size of the block of--- memory allocated for the userdata; for other values, it is 0.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_rawlen lua_rawlen>.-rawlen :: StackIndex -> Lua Int-rawlen idx = liftLua $ \l -> fromIntegral <$> lua_rawlen l idx---- | Similar to @'settable'@, but does a raw assignment (i.e., without--- metamethods).------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_rawset lua_rawset>.-rawset :: StackIndex -> Lua ()-rawset n = ensureTable n (\l -> lua_rawset l n)---- | Does the equivalent of @t[i] = v@, where @t@ is the table at the given--- index and @v@ is the value at the top of the stack.------ This function pops the value from the stack. The assignment is raw, that is,--- it does not invoke the @__newindex@ metamethod.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_rawseti lua_rawseti>.-rawseti :: StackIndex -> Lua.Integer -> Lua ()-rawseti k m = ensureTable k (\l -> lua_rawseti l k m)---- | Sets the C function @f@ as the new value of global @name@.------ See <https://www.lua.org/manual/5.3/manual.html#lua_register lua_register>.-register :: String -> CFunction -> Lua ()-register name f = do-  pushcfunction f-  setglobal name---- | Removes the element at the given valid index, shifting down the elements--- above this index to fill the gap. This function cannot be called with a--- pseudo-index, because a pseudo-index is not an actual stack position.------ See <https://www.lua.org/manual/5.3/manual.html#lua_remove lua_remove>.-remove :: StackIndex -> Lua ()-remove n = liftLua $ \l -> lua_remove l n---- | Moves the top element into the given valid index without shifting any--- element (therefore replacing the value at that given index), and then pops--- the top element.------ See <https://www.lua.org/manual/5.3/manual.html#lua_replace lua_replace>.-replace :: StackIndex -> Lua ()-replace n = liftLua $ \l ->  lua_replace l n---- | Does the equivalent to @t[k] = v@, where @t@ is the value at the given--- index and @v@ is the value at the top of the stack.------ This function pops the value from the stack. As in Lua, this function may--- trigger a metamethod for the "newindex" event (see--- <https://www.lua.org/manual/5.3/manual.html#2.4 §2.4> of the Lua 5.3--- Reference Manual).------ Errors on the Lua side are caught and rethrown as a @'Exception'@.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_setfield lua_setfield>.-setfield :: StackIndex -> String -> Lua ()-setfield i s = do-  absidx <- absindex i-  pushstring (Utf8.fromString s)-  insert (nthTop 2)-  settable absidx---- | Pops a value from the stack and sets it as the new value of global @name@.------ Errors on the Lua side are caught and rethrown as a @'Exception'@.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_setglobal lua_setglobal>.-setglobal :: String -> Lua ()-setglobal name = liftLuaThrow $ \l status' ->-  C.withCStringLen name $ \(namePtr, nameLen) ->-  hslua_setglobal l namePtr (fromIntegral nameLen) status'---- | Pops a table from the stack and sets it as the new metatable for the value--- at the given index.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_setmetatable \--- lua_setmetatable>.-setmetatable :: StackIndex -> Lua ()-setmetatable idx = liftLua $ \l -> lua_setmetatable l idx---- | Does the equivalent to @t[k] = v@, where @t@ is the value at the given--- index, @v@ is the value at the top of the stack, and @k@ is the value just--- below the top.------ This function pops both the key and the value from the stack. As in Lua, this--- function may trigger a metamethod for the "newindex" event (see--- <https://www.lua.org/manual/5.3/manual.html#2.4 §2.4> of the Lua 5.3--- Reference Manual).------ Errors on the Lua side are caught and rethrown as a @'Exception'@.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_settable lua_settable>.-settable :: StackIndex -> Lua ()-settable index = liftLuaThrow $ \l -> hslua_settable l index---- | Accepts any index, or 0, and sets the stack top to this index. If the new--- top is larger than the old one, then the new elements are filled with nil. If--- index is 0, then all stack elements are removed.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_settop lua_settop>.-settop :: StackIndex -> Lua ()-settop = liftLua1 lua_settop---- |  Returns the status of this Lua thread.------ The status can be 'OK' for a normal thread, an error value if the--- thread finished the execution of a @lua_resume@ with an error, or--- 'Yield' if the thread is suspended.------ You can only call functions in threads with status 'OK'. You can--- resume threads with status 'OK' (to start a new coroutine) or 'Yield'--- (to resume a coroutine).------ See also: <https://www.lua.org/manual/5.3/manual.html#lua_status lua_status>.-status :: Lua Status-status = liftLua $ fmap toStatus . lua_status---- | Converts the Lua value at the given index to a haskell boolean value. Like--- all tests in Lua, @toboolean@ returns @True@ for any Lua value different from--- @false@ and @nil@; otherwise it returns @False@. (If you want to accept only--- actual boolean values, use @'isboolean'@ to test the value's type.)------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_toboolean lua_toboolean>.-toboolean :: StackIndex -> Lua Bool-toboolean n = liftLua $ \l -> fromLuaBool <$> lua_toboolean l n---- | Converts a value at the given index to a C function. That value must be a C--- function; otherwise, returns @Nothing@.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_tocfunction lua_tocfunction>.-tocfunction :: StackIndex -> Lua (Maybe CFunction)-tocfunction n = liftLua $ \l -> do-  fnPtr <- lua_tocfunction l n-  return (if fnPtr == nullFunPtr then Nothing else Just fnPtr)---- | Converts the Lua value at the given acceptable index to the signed integral--- type 'Lua.Integer'. The Lua value must be an integer, a number or a string--- convertible to an integer (see--- <https://www.lua.org/manual/5.3/manual.html#3.4.3 §3.4.3> of the Lua 5.3--- Reference Manual); otherwise, @tointeger@ returns @Nothing@.------ If the number is not an integer, it is truncated in some non-specified way.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_tointeger lua_tointeger>.-tointeger :: StackIndex -> Lua (Maybe Lua.Integer)-tointeger n = liftLua $ \l -> alloca $ \boolPtr -> do-  res <- lua_tointegerx l n boolPtr-  isNum <- fromLuaBool <$> F.peek boolPtr-  return (if isNum then Just res else Nothing)---- | Converts the Lua value at the given index to the C type lua_Number. The Lua--- value must be a number or a string convertible to a number; otherwise,--- @tonumber@ returns @'Nothing'@.------ See <https://www.lua.org/manual/5.3/manual.html#lua_tonumber lua_tonumber>.-tonumber :: StackIndex -> Lua (Maybe Lua.Number)-tonumber n = liftLua $ \l -> alloca $ \bptr -> do-  res <- lua_tonumberx l n bptr-  isNum <- fromLuaBool <$> F.peek bptr-  return (if isNum then Just res else Nothing)---- | Converts the value at the given index to a generic C pointer (void*). The--- value can be a userdata, a table, a thread, or a function; otherwise,--- lua_topointer returns @nullPtr@. Different objects will give different--- pointers. There is no way to convert the pointer back to its original value.------ Typically this function is used only for hashing and debug information.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_topointer lua_topointer>.-topointer :: StackIndex -> Lua (Ptr ())-topointer n = liftLua $ \l -> lua_topointer l n---- | Converts the Lua value at the given index to a @'ByteString'@. The Lua--- value must be a string or a number; otherwise, the function returns--- @'Nothing'@. If the value is a number, then @'tostring'@ also changes the--- actual value in the stack to a string. (This change confuses @'next'@ when--- @'tostring'@ is applied to keys during a table traversal.)------ See <https://www.lua.org/manual/5.3/manual.html#lua_tolstring lua_tolstring>.-tostring :: StackIndex -> Lua (Maybe ByteString)-tostring n = liftLua $ \l ->-  alloca $ \lenPtr -> do-    cstr <- lua_tolstring l n lenPtr-    if cstr == nullPtr-      then return Nothing-      else do-      cstrLen <- F.peek lenPtr-      Just <$> B.packCStringLen (cstr, fromIntegral cstrLen)---- | Converts the value at the given index to a Lua thread (represented as--- lua_State*). This value must be a thread; otherwise, the function returns--- @Nothing@.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_tothread lua_tothread>.-tothread :: StackIndex -> Lua (Maybe Lua.State)-tothread n = liftLua $ \l -> do-  thread@(Lua.State ptr) <- lua_tothread l n-  if ptr == nullPtr-    then return Nothing-    else return (Just thread)---- | If the value at the given index is a full userdata, returns its block--- address. If the value is a light userdata, returns its pointer. Otherwise,--- returns @Nothing@..------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_touserdata lua_touserdata>.-touserdata :: StackIndex -> Lua (Maybe (Ptr a))-touserdata n = liftLua $ \l -> do-  ptr <- lua_touserdata l n-  if ptr == nullPtr-    then return Nothing-    else return (Just ptr)---- | Returns the name of the type encoded by the value @tp@, which must be one--- the values returned by @'ltype'@.------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_typename lua_typename>.-typename :: Type -> Lua String-typename tp = liftLua $ \l ->-  lua_typename l (fromType tp) >>= C.peekCString---- | Returns the pseudo-index that represents the @i@-th upvalue of the running--- function (see <https://www.lua.org/manual/5.3/manual.html#4.4 §4.4> of the--- Lua 5.3 reference manual).------ See also:--- <https://www.lua.org/manual/5.3/manual.html#lua_upvalueindex lua_upvalueindex>.-upvalueindex :: StackIndex -> StackIndex-upvalueindex i = registryindex - i

@@ -0,0 +1,62 @@+{-|+Module      : HsLua.Core.Package+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.Core.Package+  ( requirehs+  , preloadhs+  )+where++import Control.Monad (void)+import HsLua.Core.Auxiliary+import HsLua.Core.Closures (pushHaskellFunction)+import HsLua.Core.Error (LuaError)+import HsLua.Core.Primary+import HsLua.Core.Types+-- import HsLua.Core.Utf8 (fromString)++-- | Load a module, defined by a Haskell action, under the given+-- name.+--+-- Similar to @luaL_required@: After checking "loaded" table,+-- calls @pushMod@ to push a module to the stack, and registers+-- the result in @package.loaded@ table.+--+-- The @pushMod@ function must push exactly one element to the top+-- of the stack. This is not checked, but failure to do so will+-- lead to problems. Lua's @package@ module must have been loaded+-- by the time this function is invoked.+--+-- Leaves a copy of the module on the stack.+requirehs :: LuaError e => Name -> LuaE e () -> LuaE e ()+requirehs modname pushMod = do+  -- get table of loaded modules+  void $ getfield registryindex loaded++  -- Check whether module has already been loaded.+  getfield top modname >>= \case -- LOADED[modname]+    TypeNil -> do    -- not loaded yet, load now+      pop 1          -- remove LOADED[modname], i.e., nil+      pushMod        -- push module+      pushvalue top  -- make copy of module+      -- add module under the given name (LOADED[modname] = module)+      setfield (nth 3) modname+    _ -> return ()++  remove (nth 2)  -- remove table of loaded modules++-- | Registers a preloading function. Takes an module name and the+-- Lua operation which produces the package.+preloadhs :: LuaError e => Name -> LuaE e NumResults -> LuaE e ()+preloadhs name pushMod = do+  void $ getfield registryindex preload+  pushHaskellFunction pushMod+  setfield (nth 2) name+  pop 1

@@ -0,0 +1,1001 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : HsLua.Core.Primary+Copyright   : © 2007–2012 Gracjan Polak;+              © 2012–2016 Ömer Sinan Ağacan;+              © 2017-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability   : beta+Portability : non-portable (depends on GHC)++Monadic functions which operate within the Lua type.++The functions in this module are mostly thin wrappers around the+respective C functions. However, C function which can throw an error are+wrapped such that the error is converted into an exception.+-}+module HsLua.Core.Primary where++import Prelude hiding (EQ, LT, compare, concat, error)++import Control.Monad+import Data.ByteString (ByteString)+import Data.Maybe (fromMaybe)+import HsLua.Core.Error+import HsLua.Core.Types as Lua+import Lua+import Foreign.Marshal.Alloc (alloca)+import Foreign.Ptr++import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B+import qualified Foreign.Storable as F++--+-- Helper functions+--++-- | Execute an action only if the given index is a table. Throw an+-- error otherwise.+ensureTable :: LuaError e => StackIndex -> (Lua.State -> IO ()) -> LuaE e ()+ensureTable idx ioOp = do+  isTbl <- istable idx+  if isTbl+    then liftLua ioOp+    else throwTypeMismatchError "table" idx+{-# INLINE ensureTable #-}++--+-- API functions+--++-- | Converts the acceptable index @idx@ into an equivalent absolute+-- index (that is, one that does not depend on the stack top).+--+-- Wraps 'lua_absindex'.+absindex :: StackIndex -> LuaE e StackIndex+absindex = liftLua1 lua_absindex+{-# INLINABLE absindex #-}++-- |  Calls a function.+--+-- To call a function you must use the following protocol: first, the+-- function to be called is pushed onto the stack; then, the arguments+-- to the function are pushed in direct order; that is, the first+-- argument is pushed first. Finally you call @call@; @nargs@ is the+-- number of arguments that you pushed onto the stack. All arguments and+-- the function value are popped from the stack when the function is+-- called. The function results are pushed onto the stack when the+-- function returns. The number of results is adjusted to @nresults@,+-- unless @nresults@ is @multret@. In this case, all results from the+-- function are pushed. Lua takes care that the returned values fit into+-- the stack space. The function results are pushed onto the stack in+-- direct order (the first result is pushed first), so that after the+-- call the last result is on the top of the stack.+--+-- Any error inside the called function is propagated as exception of+-- type @e@.+--+-- The following example shows how the host program can do the+-- equivalent to this Lua code:+--+-- > a = f("how", t.x, 14)+--+-- Here it is in Haskell (assuming the OverloadedStrings language+-- extension):+--+-- > getglobal "f"         -- function to be called+-- > pushstring  "how"     -- 1st argument+-- > getglobal "t"         -- table to be indexed+-- > getfield (-1) "x"     -- push result of t.x (2nd arg)+-- > remove (-2)           -- remove 't' from the stack+-- > pushinteger 14        -- 3rd argument+-- > call 3 1              -- call 'f' with 3 arguments and 1 result+-- > setglobal "a"         -- set global 'a'+--+-- Note that the code above is "balanced": at its end, the stack is back+-- to its original configuration. This is considered good programming+-- practice.+--+-- See <https://www.lua.org/manual/5.3/manual.html#lua_call lua_call>.+call :: LuaError e => NumArgs -> NumResults -> LuaE e ()+call nargs nresults = do+  res <- pcall nargs nresults Nothing+  when (res /= OK) throwErrorAsException+{-# INLINABLE call #-}++-- | Ensures that the stack has space for at least @n@ extra slots (that+-- is, that you can safely push up to @n@ values into it). It returns+-- false if it cannot fulfill the request, either because it would cause+-- the stack to be larger than a fixed maximum size (typically at least+-- several thousand elements) or because it cannot allocate memory for+-- the extra space. This function never shrinks the stack; if the stack+-- already has space for the extra slots, it is left unchanged.+--+-- Wraps 'lua_checkstack'.+checkstack :: Int -> LuaE e Bool+checkstack n = liftLua $ \l ->+  fromLuaBool <$!> lua_checkstack l (fromIntegral n)+{-# INLINABLE checkstack #-}++-- | Destroys all objects in the given Lua state (calling the+-- corresponding garbage-collection metamethods, if any) and frees all+-- dynamic memory used by this state. On several platforms, you may not+-- need to call this function, because all resources are naturally+-- released when the host program ends. On the other hand, long-running+-- programs that create multiple states, such as daemons or web servers,+-- will probably need to close states as soon as they are not needed.+--+-- Same as 'lua_close'.+close :: Lua.State -> IO ()+close = lua_close+{-# INLINABLE close #-}++-- | Compares two Lua values. Returns 'True' if the value at index+-- @idx1@ satisfies @op@ when compared with the value at index @idx2@,+-- following the semantics of the corresponding Lua operator (that is,+-- it may call metamethods). Otherwise returns @False@. Also returns+-- @False@ if any of the indices is not valid.+--+-- The value of op must be of type 'RelationalOperator':+--+--    EQ: compares for equality (==)+--    LT: compares for less than (<)+--    LE: compares for less or equal (<=)+--+-- Wraps 'hslua_compare'. See also+-- <https://www.lua.org/manual/5.3/manual.html#lua_compare lua_compare>.+compare :: LuaError e+        => StackIndex         -- ^ idx1+        -> StackIndex         -- ^ idx2+        -> RelationalOperator+        -> LuaE e Bool+compare idx1 idx2 relOp = fromLuaBool <$!> liftLuaThrow+  (\l -> hslua_compare l idx1 idx2 (fromRelationalOperator relOp))+{-# INLINABLE compare #-}++-- | Concatenates the @n@ values at the top of the stack, pops them, and+-- leaves the result at the top. If @n@ is 1, the result is the single+-- value on the stack (that is, the function does nothing); if @n@ is 0,+-- the result is the empty string. Concatenation is performed following+-- the usual semantics of Lua (see+-- <https://www.lua.org/manual/5.3/manual.html#3.4.6 §3.4.6> of the Lua+-- manual).+--+-- Wraps 'hslua_concat'. See also+-- <https://www.lua.org/manual/5.3/manual.html#lua_concat lua_concat>.+concat :: LuaError e => NumArgs -> LuaE e ()+concat n = liftLuaThrow (`hslua_concat` n)+{-# INLINABLE concat #-}++-- | Copies the element at index @fromidx@ into the valid index @toidx@,+-- replacing the value at that position. Values at other positions are+-- not affected.+--+-- Wraps 'lua_copy'.+copy :: StackIndex -> StackIndex -> LuaE e ()+copy fromidx toidx = liftLua $ \l -> lua_copy l fromidx toidx+{-# INLINABLE copy #-}++-- | Creates a new empty table and pushes it onto the stack. Parameter+-- narr is a hint for how many elements the table will have as a+-- sequence; parameter nrec is a hint for how many other elements the+-- table will have. Lua may use these hints to preallocate memory for+-- the new table. This preallocation is useful for performance when you+-- know in advance how many elements the table will have. Otherwise you+-- can use the function lua_newtable.+--+-- Wraps 'lua_createtable'.+createtable :: Int -> Int -> LuaE e ()+createtable narr nrec = liftLua $ \l ->+  lua_createtable l (fromIntegral narr) (fromIntegral nrec)+{-# INLINABLE createtable #-}++-- TODO: implement dump++-- | Returns @True@ if the two values in acceptable indices @index1@ and+-- @index2@ are equal, following the semantics of the Lua @==@ operator+-- (that is, may call metamethods). Otherwise returns @False@. Also+-- returns @False@ if any of the indices is non valid. Uses @'compare'@+-- internally.+equal :: LuaError e+      => StackIndex  -- ^ index1+      -> StackIndex  -- ^ index2+      -> LuaE e Bool+equal index1 index2 = compare index1 index2 EQ+{-# INLINABLE equal #-}++-- | Signals to Lua that an error has occurred and that the error object+-- is at the top of the stack.+error :: LuaE e NumResults+error = liftLua hslua_error+{-# INLINABLE error #-}++-- |  Controls the garbage collector.+--+-- This function performs several tasks, according to the given control+-- command. See the documentation for 'GCControl'.+--+-- Wraps 'lua_gc'.+gc :: GCControl -> LuaE e Int+gc what = liftLua $ \l ->+  fromIntegral <$!> lua_gc l (toGCcode what) (toGCdata what)+{-# INLINABLE gc #-}++-- | Pushes onto the stack the value @t[k]@, where @t@ is the value at+-- the given stack index. As in Lua, this function may trigger a+-- metamethod for the "index" event (see+-- <https://www.lua.org/manual/5.3/manual.html#2.4 §2.4> of Lua's+-- manual).+--+-- Errors on the Lua side are propagated.+--+-- See also+-- <https://www.lua.org/manual/5.3/manual.html#lua_getfield lua_getfield>.+getfield :: LuaError e => StackIndex -> Name -> LuaE e Type+getfield i (Name s) = do+  absidx <- absindex i+  pushstring s+  gettable absidx+{-# INLINABLE getfield #-}++-- | Pushes onto the stack the value of the global @name@.+--+-- Errors on the Lua side are propagated.+--+-- Wraps 'hslua_getglobal'.+getglobal :: LuaError e => Name -> LuaE e Type+getglobal (Name name) = liftLuaThrow $ \l status' ->+  B.unsafeUseAsCStringLen name $ \(namePtr, len) ->+  toType <$!> hslua_getglobal l namePtr (fromIntegral len) status'+{-# INLINABLE getglobal #-}++-- | If the value at the given index has a metatable, the function+-- pushes that metatable onto the stack and returns @True@. Otherwise,+-- the function returns @False@ and pushes nothing on the stack.+--+-- Wraps 'lua_getmetatable'.+getmetatable :: StackIndex -> LuaE e Bool+getmetatable n = liftLua $ \l ->+  fromLuaBool <$!> lua_getmetatable l n+{-# INLINABLE getmetatable #-}++-- | Pushes onto the stack the value @t[k]@, where @t@ is the value at+-- the given index and @k@ is the value at the top of the stack.+--+-- This function pops the key from the stack, pushing the resulting+-- value in its place. As in Lua, this function may trigger a metamethod+-- for the "index" event (see+-- <https://www.lua.org/manual/5.3/manual.html#2.4 §2.4> of Lua's+-- manual).+--+-- Errors on the Lua side are caught and rethrown.+--+-- Wraps 'hslua_gettable'. See also:+-- <https://www.lua.org/manual/5.3/manual.html#lua_gettable lua_gettable>.+gettable :: LuaError e => StackIndex -> LuaE e Type+gettable n = liftLuaThrow (\l -> fmap toType . hslua_gettable l n)+{-# INLINABLE gettable #-}++-- | Returns the index of the top element in the stack. Because indices+-- start at 1, this result is equal to the number of elements in the+-- stack (and so 0 means an empty stack).+--+-- Wraps 'lua_gettop'.+gettop :: LuaE e StackIndex+gettop = liftLua lua_gettop+{-# INLINABLE gettop #-}++-- | Pushes onto the stack the Lua value associated with the full+-- userdata at the given index.+--+-- Returns the type of the pushed value.+--+-- Wraps 'lua_getuservalue'.+getuservalue :: StackIndex -> LuaE e Type+getuservalue idx = toType <$> liftLua (`lua_getuservalue` idx)++-- | Moves the top element into the given valid index, shifting up the+-- elements above this index to open space. This function cannot be+-- called with a pseudo-index, because a pseudo-index is not an actual+-- stack position.+--+-- Wraps 'lua_insert'.+insert :: StackIndex -> LuaE e ()+insert index = liftLua $ \l -> lua_insert l index+{-# INLINABLE insert #-}++-- | Returns 'True' if the value at the given index is a boolean, and+-- 'False' otherwise.+--+-- Wraps 'lua_isboolean'.+isboolean :: StackIndex -> LuaE e Bool+isboolean n = liftLua $ \l -> fromLuaBool <$!> lua_isboolean l n+{-# INLINABLE isboolean #-}++-- | Returns 'True' if the value at the given index is a C function, and+-- 'False' otherwise.+--+-- Wraps 'lua_iscfunction'.+iscfunction :: StackIndex -> LuaE e Bool+iscfunction n = liftLua $ \l -> fromLuaBool <$!> lua_iscfunction l n+{-# INLINABLE iscfunction #-}++-- | Returns 'True' if the value at the given index is a function+-- (either C or Lua), and 'False' otherwise.+--+-- Wraps 'lua_isfunction'.+isfunction :: StackIndex -> LuaE e Bool+isfunction n = liftLua $ \l -> fromLuaBool <$!> lua_isfunction l n+{-# INLINABLE isfunction #-}++-- | Returns @True@ if the value at the given index is an integer (that+-- is, the value is a number and is represented as an integer), and+-- 'False' otherwise.+--+-- Wraps 'lua_isinteger'.+isinteger :: StackIndex -> LuaE e Bool+isinteger n = liftLua $ \l -> fromLuaBool <$!> lua_isinteger l n+{-# INLINABLE isinteger #-}++-- | Returns @True@ if the value at the given index is a light userdata,+-- and @False@ otherwise.+--+-- Wraps 'lua_islightuserdata'.+islightuserdata :: StackIndex -> LuaE e Bool+islightuserdata n = liftLua $ \l -> fromLuaBool <$!> lua_islightuserdata l n+{-# INLINABLE islightuserdata #-}++-- | Returns 'True' if the value at the given index is *nil*, and+-- 'False' otherwise.+--+-- Wraps 'lua_isnil'.+isnil :: StackIndex -> LuaE e Bool+isnil n = liftLua $ \l -> fromLuaBool <$!> lua_isnil l n+{-# INLINABLE isnil #-}++-- | Returns 'True' if the given index is not valid, and 'False'+-- otherwise.+--+-- Wraps 'lua_isnone'.+isnone :: StackIndex -> LuaE e Bool+isnone n = liftLua $ \l -> fromLuaBool <$!> lua_isnone l n+{-# INLINABLE isnone #-}++-- | Returns 'True' if the given index is not valid or if the value at+-- the given index is *nil*, and 'False' otherwise.+--+-- Wraps 'lua_isnoneornil'.+isnoneornil :: StackIndex -> LuaE e Bool+isnoneornil n = liftLua $ \l -> fromLuaBool <$!> lua_isnoneornil l n+{-# INLINABLE isnoneornil #-}++-- | Returns 'True' if the value at the given index is a number or a+-- string convertible to a number, and 'False' otherwise.+--+-- Wraps 'lua_isnumber'.+isnumber :: StackIndex -> LuaE e Bool+isnumber n = liftLua $ \l -> fromLuaBool <$!> lua_isnumber l n+{-# INLINABLE isnumber #-}++-- | Returns 'True' if the value at the given index is a string or a+-- number (which is always convertible to a string), and 'False'+-- otherwise.+--+-- Wraps 'lua_isstring'.+isstring :: StackIndex -> LuaE e Bool+isstring n = liftLua $ \l -> fromLuaBool <$!> lua_isstring l n+{-# INLINABLE isstring #-}++-- | Returns 'True' if the value at the given index is a table, and+-- 'False' otherwise.+--+-- Wraps 'lua_istable'.+istable :: StackIndex -> LuaE e Bool+istable n = liftLua $ \l -> fromLuaBool <$!> lua_istable l n+{-# INLINABLE istable #-}++-- | Returns 'True' if the value at the given index is a thread, and+-- 'False' otherwise.+--+-- Wraps 'lua_isthread'.+isthread :: StackIndex -> LuaE e Bool+isthread n = liftLua $ \l -> fromLuaBool <$!> lua_isthread l n+{-# INLINABLE isthread #-}++-- | Returns 'True' if the value at the given index is a userdata+-- (either full or light), and 'False' otherwise.+--+-- Wraps 'lua_isuserdata'.+isuserdata :: StackIndex -> LuaE e Bool+isuserdata n = liftLua $ \l -> fromLuaBool <$!> lua_isuserdata l n+{-# INLINABLE isuserdata #-}++-- | Tests whether the object under the first index is smaller than that+-- under the second. Uses @'compare'@ internally.+lessthan :: LuaError e =>  StackIndex -> StackIndex -> LuaE e Bool+lessthan index1 index2 = compare index1 index2 LT+{-# INLINABLE lessthan #-}++-- | Loads a Lua chunk (without running it). If there are no errors,+-- @'load'@ pushes the compiled chunk as a Lua function on top of the+-- stack. Otherwise, it pushes an error message.+--+-- The return values of @'load'@ are:+--+-- - @'OK'@: no errors;+-- - @'ErrSyntax'@: syntax error during pre-compilation;+-- - @'ErrMem'@: memory allocation error;+-- - @'ErrGcmm'@: error while running a @__gc@ metamethod. (This error+--   has no relation with the chunk being loaded. It is generated by the+--   garbage collector.)+--+-- This function only loads a chunk; it does not run it.+--+-- @load@ automatically detects whether the chunk is text or binary, and+-- loads it accordingly (see program luac).+--+-- The @'load'@ function uses a user-supplied reader function to read+-- the chunk (see @'Lua.Reader'@). The data argument is an opaque value+-- passed to the reader function.+--+-- The @chunkname@ argument gives a name to the chunk, which is used for+-- error messages and in debug information (see+-- <https://www.lua.org/manual/5.3/manual.html#4.9 §4.9>). Note that the+-- @chunkname@ is used as a C string, so it may not contain null-bytes.+--+-- This is a wrapper of 'lua_load'.+load :: Lua.Reader -> Ptr () -> Name -> LuaE e Status+load reader data' (Name chunkname) = liftLua $ \l ->+  B.useAsCString chunkname $ \namePtr ->+  toStatus <$!> lua_load l reader data' namePtr nullPtr+{-# INLINABLE load #-}++-- | Returns the type of the value in the given valid index, or+-- @'TypeNone'@ for a non-valid (but acceptable) index.+--+-- This function wraps 'lua_type'.+ltype :: StackIndex -> LuaE e Type+ltype idx = toType <$!> liftLua (`lua_type` idx)+{-# INLINABLE ltype #-}++-- | Creates a new empty table and pushes it onto the stack. It is+-- equivalent to @createtable 0 0@.+--+-- See also:+-- <https://www.lua.org/manual/5.3/manual.html#lua_newtable lua_newtable>.+newtable :: LuaE e ()+newtable = createtable 0 0+{-# INLINABLE newtable #-}++-- | This function allocates a new block of memory with the given size,+-- pushes onto the stack a new full userdata with the block address, and+-- returns this address. The host program can freely use this memory.+--+-- This function wraps 'lua_newuserdata'.+newuserdata :: Int -> LuaE e (Ptr ())+newuserdata = liftLua1 lua_newuserdata . fromIntegral+{-# INLINABLE newuserdata #-}++-- | Pops a key from the stack, and pushes a key–value pair from the+-- table at the given index (the "next" pair after the given key). If+-- there are no more elements in the table, then @next@ returns @False@+-- (and pushes nothing).+--+-- Errors on the Lua side are caught and rethrown as a @'Exception'@.+--+-- This function wraps 'hslua_next'.+-- See also:+-- <https://www.lua.org/manual/5.3/manual.html#lua_next lua_next>.+next :: LuaError e => StackIndex -> LuaE e Bool+next idx = fromLuaBool <$!> liftLuaThrow (\l -> hslua_next l idx)+{-# INLINABLE next #-}++-- | Opens all standard Lua libraries into the current state and sets+-- each library name as a global value.+--+-- This function wraps 'luaL_openlibs'.+openlibs :: LuaE e ()+openlibs = liftLua luaL_openlibs+{-# INLINABLE openlibs #-}++-- | Pushes Lua's /base/ library onto the stack.+--+-- This function pushes and and calls 'luaopen_base'.+openbase :: LuaError e => LuaE e ()+openbase = pushcfunction luaopen_base *> call 0 multret+{-# INLINABLE openbase #-}++-- | Pushes Lua's /debug/ library onto the stack.+--+-- This function pushes and and calls 'luaopen_io'.+opendebug :: LuaError e => LuaE e ()+opendebug = pushcfunction luaopen_debug *> call 0 multret+{-# INLINABLE opendebug #-}++-- | Pushes Lua's /io/ library onto the stack.+--+-- This function pushes and and calls 'luaopen_io'.+openio :: LuaError e => LuaE e ()+openio = pushcfunction luaopen_io *> call 0 multret+{-# INLINABLE openio #-}++-- | Pushes Lua's /math/ library onto the stack.+--+-- This function pushes and and calls 'luaopen_math'.+openmath :: LuaError e => LuaE e ()+openmath = pushcfunction luaopen_math *> call 0 multret+{-# INLINABLE openmath #-}++-- | Pushes Lua's /os/ library onto the stack.+--+-- This function pushes and and calls 'luaopen_os'.+openos :: LuaError e => LuaE e ()+openos = pushcfunction luaopen_os *> call 0 multret+{-# INLINABLE openos #-}++-- | Pushes Lua's /package/ library onto the stack.+--+-- This function pushes and and calls 'luaopen_package'.+openpackage :: LuaError e => LuaE e ()+openpackage = pushcfunction luaopen_package *> call 0 multret+{-# INLINABLE openpackage #-}++-- | Pushes Lua's /string/ library onto the stack.+--+-- This function pushes and and calls 'luaopen_string'.+openstring :: LuaError e => LuaE e ()+openstring = pushcfunction luaopen_string *> call 0 multret+{-# INLINABLE openstring #-}++-- | Pushes Lua's /table/ library onto the stack.+--+-- This function pushes and and calls 'luaopen_table'.+opentable :: LuaError e => LuaE e ()+opentable = pushcfunction luaopen_table *> call 0 multret+{-# INLINABLE opentable #-}++-- | Calls a function in protected mode.+--+-- Both @nargs@ and @nresults@ have the same meaning as in @'call'@. If+-- there are no errors during the call, @pcall@ behaves exactly like+-- @'call'@. However, if there is any error, @pcall@ catches it, pushes+-- a single value on the stack (the error message), and returns the+-- error code. Like @'call'@, @pcall@ always removes the function and+-- its arguments from the stack.+--+-- If @msgh@ is @Nothing@, then the error object returned on the stack+-- is exactly the original error object. Otherwise, when @msgh@ is @Just+-- idx@, the stack index @idx@ is the location of a message handler.+-- (This index cannot be a pseudo-index.) In case of runtime errors,+-- this function will be called with the error object and its return+-- value will be the object returned on the stack by @'pcall'@.+--+-- Typically, the message handler is used to add more debug information+-- to the error object, such as a stack traceback. Such information+-- cannot be gathered after the return of @'pcall'@, since by then the+-- stack has unwound.+--+-- This function wraps 'lua_pcall'.+pcall :: NumArgs -> NumResults -> Maybe StackIndex -> LuaE e Status+pcall nargs nresults msgh = liftLua $ \l ->+  toStatus <$!> lua_pcall l nargs nresults (fromMaybe 0 msgh)+{-# INLINABLE pcall #-}++-- | Pops @n@ elements from the stack.+--+-- See also: <https://www.lua.org/manual/5.3/manual.html#lua_pop lua_pop>.+pop :: Int -> LuaE e ()+pop n = liftLua $ \l -> lua_pop l (fromIntegral n)+{-# INLINABLE pop #-}++-- | Pushes a boolean value with the given value onto the stack.+--+-- This functions wraps 'lua_pushboolean'.+pushboolean :: Bool -> LuaE e ()+pushboolean b = liftLua $ \l -> lua_pushboolean l (toLuaBool b)+{-# INLINABLE pushboolean #-}++-- | Pushes a new C closure onto the stack.+--+-- When a C function is created, it is possible to associate some values+-- with it, thus creating a C closure (see+-- <https://www.lua.org/manual/5.1/manual.html#3.4 §3.4>); these values+-- are then accessible to the function whenever it is called. To+-- associate values with a C function, first these values should be+-- pushed onto the stack (when there are multiple values, the first+-- value is pushed first). Then pushcclosure is called to create and+-- push the C function onto the stack, with the argument @n@ telling how+-- many values should be associated with the function. pushcclosure also+-- pops these values from the stack.+--+-- The maximum value for @n@ is 255.+--+-- Wraps 'lua_pushcclosure'.+pushcclosure :: CFunction -> NumArgs {- ^ n -} -> LuaE e ()+pushcclosure f n = liftLua $ \l -> lua_pushcclosure l f n+{-# INLINABLE pushcclosure #-}++-- | Pushes a C function onto the stack. This function receives a+-- pointer to a C function and pushes onto the stack a Lua value of type+-- function that, when called, invokes the corresponding C function.+--+-- Any function to be callable by Lua must follow the correct protocol+-- to receive its parameters and return its results (see @'CFunction'@)+--+-- Same as @flip 'pushcclosure' 0@.+-- <https://www.lua.org/manual/5.3/manual.html#lua_pushcfunction lua_pushcfunction>.+pushcfunction :: CFunction -> LuaE e ()+pushcfunction f = pushcclosure f 0+{-# INLINABLE pushcfunction #-}++-- | Pushes the global environment onto the stack.+--+-- Wraps 'lua_pushglobaltable'.+pushglobaltable :: LuaE e ()+pushglobaltable = liftLua lua_pushglobaltable+{-# INLINABLE pushglobaltable #-}++-- | Pushes an integer with with the given value onto the stack.+--+-- Wraps 'lua_pushinteger'.+pushinteger :: Lua.Integer -> LuaE e ()+pushinteger = liftLua1 lua_pushinteger+{-# INLINABLE pushinteger #-}++-- |  Pushes a light userdata onto the stack.+--+-- Userdata represent C values in Lua. A light userdata represents a+-- pointer, a @Ptr a@ (i.e., @void*@ in C). It is a value (like a+-- number): you do not create it, it has no individual metatable, and it+-- is not collected (as it was never created). A light userdata is equal+-- to "any" light userdata with the same C address.+--+-- Wraps 'lua_pushlightuserdata'.+pushlightuserdata :: Ptr a -> LuaE e ()+pushlightuserdata = liftLua1 lua_pushlightuserdata+{-# INLINABLE pushlightuserdata #-}++-- | Pushes a nil value onto the stack.+--+-- Wraps 'lua_pushnil'.+pushnil :: LuaE e ()+pushnil = liftLua lua_pushnil+{-# INLINABLE pushnil #-}++-- | Pushes a float with the given value onto the stack.+--+-- Wraps 'lua_pushnumber'.+pushnumber :: Lua.Number -> LuaE e ()+pushnumber = liftLua1 lua_pushnumber+{-# INLINABLE pushnumber #-}++-- | Pushes the string pointed to by s onto the stack. Lua makes (or+-- reuses) an internal copy of the given string, so the memory at s can+-- be freed or reused immediately after the function returns.+--+-- Wraps 'lua_pushlstring'.+pushstring :: ByteString -> LuaE e ()+pushstring s = liftLua $ \l ->+  B.unsafeUseAsCStringLen s $ \(sPtr, z) -> lua_pushlstring l sPtr (fromIntegral z)+{-# INLINABLE pushstring #-}++-- | Pushes the current thread onto the stack. Returns @True@ if this thread is+-- the main thread of its state, @False@ otherwise.+--+-- Wraps 'lua_pushthread'.+pushthread :: LuaE e Bool+pushthread = (1 ==)  <$!> liftLua lua_pushthread+{-# INLINABLE pushthread #-}++-- | Pushes a copy of the element at the given index onto the stack.+--+-- Wraps 'lua_pushvalue'.+pushvalue :: StackIndex -> LuaE e ()+pushvalue n = liftLua $ \l -> lua_pushvalue l n+{-# INLINABLE pushvalue #-}++-- | Returns @True@ if the two values in indices @idx1@ and @idx2@ are+-- primitively equal (that is, without calling the @__eq@ metamethod).+-- Otherwise returns @False@. Also returns @False@ if any of the indices+-- are not valid.+--+-- Wraps 'lua_rawequal'.+rawequal :: StackIndex -> StackIndex -> LuaE e Bool+rawequal idx1 idx2 = liftLua $ \l ->+  fromLuaBool <$!> lua_rawequal l idx1 idx2+{-# INLINABLE rawequal #-}++-- | Similar to @'gettable'@, but does a raw access (i.e., without+-- metamethods).+--+-- Wraps 'lua_rawget'.+rawget :: LuaError e => StackIndex -> LuaE e ()+rawget n = ensureTable n (\l -> lua_rawget l n)+{-# INLINABLE rawget #-}++-- | Pushes onto the stack the value @t[n]@, where @t@ is the table at+-- the given index. The access is raw, that is, it does not invoke the+-- @__index@ metamethod.+--+-- Wraps 'lua_rawgeti'.+rawgeti :: LuaError e => StackIndex -> Lua.Integer -> LuaE e ()+rawgeti k n = ensureTable k (\l -> lua_rawgeti l k n)+{-# INLINABLE rawgeti #-}++-- | Returns the raw "length" of the value at the given index: for+-- strings, this is the string length; for tables, this is the result of+-- the length operator (@#@) with no metamethods; for userdata, this is+-- the size of the block of memory allocated for the userdata; for other+-- values, it is 0.+--+-- Wraps 'lua_rawlen'.+rawlen :: StackIndex -> LuaE e Int+rawlen idx = liftLua $ \l -> fromIntegral <$!> lua_rawlen l idx+{-# INLINABLE rawlen #-}++-- | Similar to @'settable'@, but does a raw assignment (i.e., without+-- metamethods).+--+-- Wraps 'lua_rawset'.+rawset :: LuaError e => StackIndex -> LuaE e ()+rawset n = ensureTable n (\l -> lua_rawset l n)+{-# INLINABLE rawset #-}++-- | Does the equivalent of @t[i] = v@, where @t@ is the table at the given+-- index and @v@ is the value at the top of the stack.+--+-- This function pops the value from the stack. The assignment is raw, that is,+-- it does not invoke the @__newindex@ metamethod.+--+-- Wraps 'lua_rawseti'.+rawseti :: LuaError e => StackIndex -> Lua.Integer -> LuaE e ()+rawseti k m = ensureTable k (\l -> lua_rawseti l k m)+{-# INLINABLE rawseti #-}++-- | Sets the C function @f@ as the new value of global @name@.+--+-- Wraps 'lua_register'.+register :: LuaError e => Name -> CFunction -> LuaE e ()+register name f = do+  pushcfunction f+  setglobal name+{-# INLINABLE register #-}++-- | Removes the element at the given valid index, shifting down the+-- elements above this index to fill the gap. This function cannot be+-- called with a pseudo-index, because a pseudo-index is not an actual+-- stack position.+--+-- Wraps 'lua_remove'.+remove :: StackIndex -> LuaE e ()+remove n = liftLua $ \l -> lua_remove l n+{-# INLINABLE remove #-}++-- | Moves the top element into the given valid index without shifting+-- any element (therefore replacing the value at that given index), and+-- then pops the top element.+--+-- Wraps 'lua_replace'.+replace :: StackIndex -> LuaE e ()+replace n = liftLua $ \l ->  lua_replace l n+{-# INLINABLE replace #-}++-- | Does the equivalent to @t[k] = v@, where @t@ is the value at the+-- given index and @v@ is the value at the top of the stack.+--+-- This function pops the value from the stack. As in Lua, this function+-- may trigger a metamethod for the "newindex" event (see+-- <https://www.lua.org/manual/5.3/manual.html#2.4 §2.4> of the Lua 5.3+-- Reference Manual).+--+-- Errors on the Lua side are caught and rethrown as a @'Exception'@.+--+-- See also:+-- <https://www.lua.org/manual/5.3/manual.html#lua_setfield lua_setfield>.+setfield :: LuaError e => StackIndex -> Name -> LuaE e ()+setfield i (Name s) = do+  absidx <- absindex i+  pushstring s+  insert (nthTop 2)+  settable absidx+{-# INLINABLE setfield #-}++-- | Pops a value from the stack and sets it as the new value of global+-- @name@.+--+-- Errors on the Lua side are caught and rethrown as 'Exception'.+--+-- Wraps 'hslua_setglobal'. See also:+-- <https://www.lua.org/manual/5.3/manual.html#lua_setglobal lua_setglobal>.+setglobal :: LuaError e => Name {- ^ name -} -> LuaE e ()+setglobal (Name name) = liftLuaThrow $ \l status' ->+  B.unsafeUseAsCStringLen name $ \(namePtr, nameLen) ->+    hslua_setglobal l namePtr (fromIntegral nameLen) status'+{-# INLINABLE setglobal #-}++-- | Pops a table from the stack and sets it as the new metatable for+-- the value at the given index.+--+-- Wraps 'lua_setmetatable'.+setmetatable :: StackIndex -> LuaE e ()+setmetatable idx = liftLua $ \l -> lua_setmetatable l idx+{-# INLINABLE setmetatable #-}++-- | Does the equivalent to @t[k] = v@, where @t@ is the value at the+-- given index, @v@ is the value at the top of the stack, and @k@ is the+-- value just below the top.+--+-- This function pops both the key and the value from the stack. As in+-- Lua, this function may trigger a metamethod for the "newindex" event+-- (see <https://www.lua.org/manual/5.3/manual.html#2.4 §2.4> of the Lua+-- 5.3 Reference Manual).+--+-- Errors on the Lua side are caught and rethrown.+--+-- Wraps 'hslua_settable'.+settable :: LuaError e => StackIndex -> LuaE e ()+settable index = liftLuaThrow $ \l -> hslua_settable l index+{-# INLINABLE settable #-}++-- | Accepts any index, or 0, and sets the stack top to this index. If+-- the new top is larger than the old one, then the new elements are+-- filled with nil. If index is 0, then all stack elements are removed.+--+-- Wraps 'lua_settop'.+settop :: StackIndex -> LuaE e ()+settop = liftLua1 lua_settop+{-# INLINABLE settop #-}++-- | Pops a value from the stack and sets it as the new value associated+-- to the full userdata at the given index.+--+-- <https://www.lua.org/manual/5.3/manual.html#lua_setuservalue>+setuservalue :: StackIndex -> LuaE e ()+setuservalue idx = liftLua (`lua_setuservalue` idx)++-- |  Returns the status of this Lua thread.+--+-- The status can be 'OK' for a normal thread, an error value if the+-- thread finished the execution of a @lua_resume@ with an error, or+-- 'Yield' if the thread is suspended.+--+-- You can only call functions in threads with status 'OK'. You can+-- resume threads with status 'OK' (to start a new coroutine) or 'Yield'+-- (to resume a coroutine).+--+-- Wraps 'lua_status'.+status :: LuaE e Status+status = liftLua $ fmap toStatus . lua_status+{-# INLINABLE status #-}++-- | Converts the Lua value at the given index to a haskell boolean+-- value. Like all tests in Lua, @toboolean@ returns @True@ for any Lua+-- value different from @false@ and @nil@; otherwise it returns @False@.+-- (If you want to accept only actual boolean values, use @'isboolean'@+-- to test the value's type.)+--+-- Wraps 'lua_toboolean'.+toboolean :: StackIndex -> LuaE e Bool+toboolean n = liftLua $ \l -> fromLuaBool <$!> lua_toboolean l n+{-# INLINABLE toboolean #-}++-- | Converts a value at the given index to a C function. That value+-- must be a C function; otherwise, returns @Nothing@.+--+-- Wraps 'lua_tocfunction'.+tocfunction :: StackIndex -> LuaE e (Maybe CFunction)+tocfunction n = liftLua $ \l -> do+  fnPtr <- lua_tocfunction l n+  return (if fnPtr == nullFunPtr then Nothing else Just fnPtr)+{-# INLINABLE tocfunction #-}++-- | Converts the Lua value at the given acceptable index to the signed+-- integral type 'Lua.Integer'. The Lua value must be an integer, a+-- number or a string convertible to an integer (see+-- <https://www.lua.org/manual/5.3/manual.html#3.4.3 §3.4.3> of the Lua+-- 5.3 Reference Manual); otherwise, @tointeger@ returns @Nothing@.+--+-- If the number is not an integer, it is truncated in some+-- non-specified way.+--+-- Wraps 'lua_tointegerx'. See also:+-- <https://www.lua.org/manual/5.3/manual.html#lua_tointeger lua_tointeger>.+tointeger :: StackIndex -> LuaE e (Maybe Lua.Integer)+tointeger n = liftLua $ \l -> alloca $ \boolPtr -> do+  res <- lua_tointegerx l n boolPtr+  isNum <- fromLuaBool <$!> F.peek boolPtr+  return (if isNum then Just res else Nothing)+{-# INLINABLE tointeger #-}++-- | Converts the Lua value at the given index to a 'Lua.Number'. The+-- Lua value must be a number or a string convertible to a number;+-- otherwise, @tonumber@ returns @'Nothing'@.+--+-- Wraps 'lua_tonumberx'. See also+-- <https://www.lua.org/manual/5.3/manual.html#lua_tonumber lua_tonumber>.+tonumber :: StackIndex -> LuaE e (Maybe Lua.Number)+tonumber n = liftLua $ \l -> alloca $ \bptr -> do+  res <- lua_tonumberx l n bptr+  isNum <- fromLuaBool <$!> F.peek bptr+  return (if isNum then Just res else Nothing)+{-# INLINABLE tonumber #-}++-- | Converts the value at the given index to a generic C pointer+-- (void*). The value can be a userdata, a table, a thread, or a+-- function; otherwise, lua_topointer returns @nullPtr@. Different+-- objects will give different pointers. There is no way to convert the+-- pointer back to its original value.+--+-- Typically this function is used only for hashing and debug+-- information.+--+-- Wraps 'lua_topointer'.+topointer :: StackIndex -> LuaE e (Ptr ())+topointer n = liftLua $ \l -> lua_topointer l n+{-# INLINABLE topointer #-}++-- | Converts the Lua value at the given index to a 'ByteString'. The+-- Lua value must be a string or a number; otherwise, the function+-- returns 'Nothing'. If the value is a number, then 'tostring' also+-- changes the actual value in the stack to a string. (This change+-- confuses 'next' when 'tostring' is applied to keys during a table+-- traversal.)+--+-- Wraps 'lua_tolstring'.+tostring :: StackIndex -> LuaE e (Maybe ByteString)+tostring n = liftLua $ \l ->+  alloca $ \lenPtr -> do+    cstr <- lua_tolstring l n lenPtr+    if cstr == nullPtr+      then return Nothing+      else do+      cstrLen <- F.peek lenPtr+      Just <$!> B.packCStringLen (cstr, fromIntegral cstrLen)+{-# INLINABLE tostring #-}++-- | Converts the value at the given index to a Lua thread (represented+-- as 'Lua.State'). This value must be a thread; otherwise, the function+-- returns @Nothing@.+--+-- Wraps 'lua_tothread'.+tothread :: StackIndex -> LuaE e (Maybe Lua.State)+tothread n = liftLua $ \l -> do+  thread@(Lua.State ptr) <- lua_tothread l n+  if ptr == nullPtr+    then return Nothing+    else return (Just thread)+{-# INLINABLE tothread #-}++-- | If the value at the given index is a full userdata, returns its+-- block address. If the value is a light userdata, returns its pointer.+-- Otherwise, returns @Nothing@..+--+-- Wraps 'lua_touserdata'.+touserdata :: StackIndex -> LuaE e (Maybe (Ptr a))+touserdata n = liftLua $ \l -> do+  ptr <- lua_touserdata l n+  if ptr == nullPtr+    then return Nothing+    else return (Just ptr)+{-# INLINABLE touserdata #-}++-- | Returns the name of the type encoded by the value @tp@, which must+-- be one the values returned by @'ltype'@.+--+-- Wraps 'lua_typename'.+typename :: Type -> LuaE e ByteString+typename tp = liftLua $ \l ->+  lua_typename l (fromType tp) >>= B.packCString+{-# INLINABLE typename #-}++-- | Returns the pseudo-index that represents the @i@-th upvalue of the+-- running function (see <https://www.lua.org/manual/5.3/manual.html#4.4+-- §4.4> of the Lua 5.3 reference manual).+--+-- See also:+-- <https://www.lua.org/manual/5.3/manual.html#lua_upvalueindex lua_upvalueindex>.+upvalueindex :: StackIndex -> StackIndex+upvalueindex i = registryindex - i+{-# INLINABLE upvalueindex #-}

@@ -12,59 +12,28 @@ -} module HsLua.Core.Run   ( run-  , run'   , runEither   , runWith-  , defaultErrorConversion   ) where  import Control.Exception (bracket, try)-import HsLua.Core.Types (Lua)+import HsLua.Core.Types (LuaE, runWith)  import qualified Control.Monad.Catch as Catch import qualified HsLua.Core.Auxiliary as Lua-import qualified HsLua.Core.Error as Lua-import qualified HsLua.Core.Functions as Lua-import qualified HsLua.Core.Types as Lua-import qualified HsLua.Core.Utf8 as Utf8+import qualified HsLua.Core.Primary as Lua  -- | Run Lua computation using the default HsLua state as starting -- point. Exceptions are masked, thus avoiding some issues when using -- multiple threads. All exceptions are passed through; error handling -- is the responsibility of the caller.-run :: Lua a -> IO a+run :: LuaE e a -> IO a run = (Lua.newstate `bracket` Lua.close) . flip runWith . Catch.mask_---- | Run Lua computation using the default HsLua state as starting point.--- Conversion from Lua errors to Haskell exceptions can be controlled through--- @'Lua.ErrorConversion'@.-run' :: Lua.ErrorConversion -> Lua a -> IO a-run' ec = (Lua.newstate `bracket` Lua.close) .-  flip (Lua.runWithConverter ec) . Catch.mask_+{-# INLINABLE run #-} --- | Run the given Lua computation; exceptions raised in haskell code are--- caught, but other exceptions (user exceptions raised in haskell, unchecked+-- | Run the given Lua computation; exceptions raised in Haskell code are+-- caught, but other exceptions (user exceptions raised in Haskell, unchecked -- type errors, etc.) are passed through.-runEither :: Catch.Exception e => Lua a -> IO (Either e a)+runEither :: Catch.Exception e => LuaE e a -> IO (Either e a) runEither = try . run---- | Run Lua computation with the given Lua state and the default--- error-to-exception converter. Exception handling is left to--- the caller.-runWith :: Lua.State -> Lua a -> IO a-runWith = Lua.runWithConverter defaultErrorConversion---- | Conversions between Lua errors and Haskell exceptions; only deals with--- @'Lua.Exception'@s.-defaultErrorConversion :: Lua.ErrorConversion-defaultErrorConversion = Lua.ErrorConversion-  { Lua.errorToException = Lua.throwTopMessageWithState-  , Lua.addContextToException = Lua.withExceptionMessage . (++)-  , Lua.alternative = \x y -> Lua.try x >>= \case-      Left _   -> y-      Right x' -> return x'-  , Lua.exceptionToError = (`Lua.catchException`-                             \(Lua.Exception msg) -> do-                               Lua.pushstring $ Utf8.fromString msg-                               Lua.error)-  }+{-# INLINABLE runEither #-}

@@ -1,6 +1,5 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase                 #-}-{-# LANGUAGE RankNTypes                 #-} {-| Module      : HsLua.Core.Types Copyright   : © 2007–2012 Gracjan Polak;@@ -18,26 +17,25 @@ the future. -} module HsLua.Core.Types-  ( Lua (..)+  ( LuaE (..)   , LuaEnvironment (..)-  , ErrorConversion (..)-  , errorConversion   , State (..)   , Reader   , liftLua   , liftLua1   , state-  , runWithConverter+  , runWith   , unsafeRunWith-  , unsafeErrorConversion-  , GCCONTROL (..)-  , toGCCode+  , GCControl (..)+  , toGCcode+  , toGCdata   , Type (..)-  , TypeCode (..)   , fromType   , toType   , liftIO   , CFunction+  , PreCFunction+  , HaskellFunction   , LuaBool (..)   , fromLuaBool   , toLuaBool@@ -51,7 +49,6 @@   , RelationalOperator (..)   , fromRelationalOperator   , Status (..)-  , StatusCode (..)   , toStatus     -- * References   , Reference (..)@@ -64,12 +61,17 @@   , nthBottom   , nth   , top+    -- * Table field names+  , Name (..)   ) where  import Prelude hiding (Integer, EQ, LT)  import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) import Control.Monad.Reader (ReaderT (..), MonadReader, MonadIO, asks, liftIO)+import Data.ByteString (ByteString)+import Data.String (IsString (..))+import Foreign.C (CInt) import Lua (nth, nthBottom, nthTop, top) import Lua.Constants import Lua.Types@@ -78,32 +80,20 @@   , fromReference   , toReference   )---- | Define the ways in which exceptions and errors are handled.-data ErrorConversion = ErrorConversion-  { errorToException :: forall a . State -> IO a-    -- ^ Translate Lua errors to Haskell exceptions-  , addContextToException :: forall a . String -> Lua a -> Lua a-    -- ^ Add information on the current context to an exception.-  , alternative :: forall a . Lua a -> Lua a -> Lua a-    -- ^ Runs the second computation only if the first fails; returns-    -- the result of the first successful computation, if any.-  , exceptionToError :: Lua NumResults -> Lua NumResults-    -- ^ Translate Haskell exceptions to Lua errors-  }+import qualified HsLua.Core.Utf8 as Utf8+#if !MIN_VERSION_base(4,12,0)+import Data.Semigroup (Semigroup)+#endif  -- | Environment in which Lua computations are evaluated.-data LuaEnvironment = LuaEnvironment-  { luaEnvErrorConversion :: ErrorConversion-    -- ^ Functions for error and exception handling and conversion-  , luaEnvState :: State-    -- ^ Lua interpreter state+newtype LuaEnvironment = LuaEnvironment+  { luaEnvState :: State -- ^ Lua interpreter state   } --- | A Lua computation. This is the base type used to run Lua programs of any--- kind. The Lua state is handled automatically, but can be retrieved via--- @'state'@.-newtype Lua a = Lua { unLua :: ReaderT LuaEnvironment IO a }+-- | A Lua computation. This is the base type used to run Lua programs+-- of any kind. The Lua state is handled automatically, but can be+-- retrieved via @'state'@.+newtype LuaE e a = Lua { unLua :: ReaderT LuaEnvironment IO a }   deriving     ( Applicative     , Functor@@ -115,42 +105,36 @@     , MonadThrow     ) --- | Turn a function of typ @Lua.State -> IO a@ into a monadic Lua operation.-liftLua :: (State -> IO a) -> Lua a+-- | Turn a function of typ @Lua.State -> IO a@ into a monadic Lua+-- operation.+liftLua :: (State -> IO a) -> LuaE e a liftLua f = state >>= liftIO . f+{-# INLINABLE liftLua #-} --- | Turn a function of typ @Lua.State -> a -> IO b@ into a monadic Lua operation.-liftLua1 :: (State -> a -> IO b) -> a -> Lua b+-- | Turn a function of typ @Lua.State -> a -> IO b@ into a monadic Lua+-- operation.+liftLua1 :: (State -> a -> IO b) -> a -> LuaE e b liftLua1 f x = liftLua $ \l -> f l x+{-# INLINABLE liftLua1 #-}  -- | Get the Lua state of this Lua computation.-state :: Lua State+state :: LuaE e State state = asks luaEnvState---- | Get the error-to-exception function.-errorConversion :: Lua ErrorConversion-errorConversion = asks luaEnvErrorConversion+{-# INLINABLE state #-} --- | Run Lua computation with the given Lua state and error-to-exception--- converter. Any resulting exceptions are left unhandled.-runWithConverter :: ErrorConversion -> State -> Lua a -> IO a-runWithConverter e2e l s =-  runReaderT (unLua s) (LuaEnvironment e2e l)+-- | Run Lua computation with the given Lua state. Exception handling is+-- left to the caller; resulting exceptions are left unhandled.+runWith :: State -> LuaE e a -> IO a+runWith l s = runReaderT (unLua s) (LuaEnvironment l)+{-# INLINABLE runWith #-}  -- | Run the given operation, but crash if any Haskell exceptions occur.-unsafeRunWith :: State -> Lua a -> IO a-unsafeRunWith = runWithConverter unsafeErrorConversion---- | Unsafe @'ErrorConversion'@; no proper error handling is attempted,--- any error leads to a crash.-unsafeErrorConversion :: ErrorConversion-unsafeErrorConversion = ErrorConversion-  { errorToException = const (error "An unrecoverable Lua error occured.")-  , addContextToException = const id-  , alternative = const-  , exceptionToError = id-  }+unsafeRunWith :: State -> LuaE e a -> IO a+unsafeRunWith = runWith +-- | Haskell function that can be called from Lua.+-- The HsLua equivallent of a 'PreCFunction'.+type HaskellFunction e = LuaE e NumResults  -- -- Type of Lua values@@ -189,6 +173,7 @@   TypeFunction      -> LUA_TFUNCTION   TypeUserdata      -> LUA_TUSERDATA   TypeThread        -> LUA_TTHREAD+{-# INLINABLE fromType #-}  -- | Convert numerical code to Lua 'Type'. toType :: TypeCode -> Type@@ -204,6 +189,7 @@   LUA_TUSERDATA      -> TypeUserdata   LUA_TTHREAD        -> TypeThread   TypeCode c         -> error ("No Type corresponding to " ++ show c)+{-# INLINABLE toType #-}   --@@ -275,31 +261,53 @@ -- Garbage collection -- --- | Enumeration used by @gc@ function.-data GCCONTROL-  = GCSTOP-  | GCRESTART-  | GCCOLLECT-  | GCCOUNT-  | GCCOUNTB-  | GCSTEP-  | GCSETPAUSE-  | GCSETSTEPMUL-  | GCISRUNNING-  deriving (Enum, Eq, Ord, Show)+-- | Commands to control the garbage collector.+data GCControl+  = GCStop            -- ^ stops the garbage collector.+  | GCRestart         -- ^ restarts the garbage collector+  | GCCollect         -- ^ performs a full garbage-collection cycle.+  | GCCount           -- ^ returns the current amount of memory (in+                      -- Kbytes) in use by Lua.+  | GCCountb          -- ^ returns the remainder of dividing the current+                      -- amount of bytes of memory in use by Lua by 1024.+  | GCStep            -- ^ performs an incremental step of garbage+                      -- collection.+  | GCSetPause CInt   -- ^ sets data as the new value for the pause of+                      -- the collector (see+                      -- <https://www.lua.org/manual/5.3/manual.html#2.5+                      -- §2.5> of the Lua reference manual) and returns+                      -- the previous value of the pause.+  | GCSetStepMul CInt -- ^ sets data as the new value for the step+                      -- multiplier of the collector (see+                      -- <https://www.lua.org/manual/5.3/manual.html#2.5+                      -- §2.5> of the Lua reference manual) and returns+                      -- the previous value of the step multiplier.+  | GCIsRunning       -- ^ returns a boolean that tells whether the+                      -- collector is running (i.e., not stopped).+  deriving (Eq, Ord, Show) -toGCCode :: GCCONTROL -> GCCode-toGCCode = \case-  GCSTOP       -> LUA_GCSTOP-  GCRESTART    -> LUA_GCRESTART-  GCCOLLECT    -> LUA_GCCOLLECT-  GCCOUNT      -> LUA_GCCOUNT-  GCCOUNTB     -> LUA_GCCOUNTB-  GCSTEP       -> LUA_GCSTEP-  GCSETPAUSE   -> LUA_GCSETPAUSE-  GCSETSTEPMUL -> LUA_GCSETSTEPMUL-  GCISRUNNING  -> LUA_GCISRUNNING+-- | Converts a GCControl command to its corresponding code.+toGCcode :: GCControl -> GCCode+toGCcode = \case+  GCStop          -> LUA_GCSTOP+  GCRestart       -> LUA_GCRESTART+  GCCollect       -> LUA_GCCOLLECT+  GCCount         -> LUA_GCCOUNT+  GCCountb        -> LUA_GCCOUNTB+  GCStep          -> LUA_GCSTEP+  GCSetPause {}   -> LUA_GCSETPAUSE+  GCSetStepMul {} -> LUA_GCSETSTEPMUL+  GCIsRunning     -> LUA_GCISRUNNING+{-# INLINABLE toGCcode #-} +-- | Returns the data value associated with a GCControl command.+toGCdata :: GCControl -> CInt+toGCdata = \case+  GCSetPause p   -> p+  GCSetStepMul m -> m+  _              -> 0+{-# INLINABLE toGCdata #-}+ -- -- Special values --@@ -319,3 +327,20 @@ -- | Value signaling that no reference was found. noref :: Int noref = fromIntegral LUA_NOREF++--+-- Field names+--++-- | Name of a function, table field, or chunk; the name must be valid+-- UTF-8 and may not contain any nul characters.+--+-- Implementation note: this is a @newtype@ instead of a simple @type+-- Name = ByteString@ alias so we can define a UTF-8 based 'IsString'+-- instance. Non-ASCII users would have a bad time otherwise.+newtype Name = Name { fromName :: ByteString }+  deriving (Eq, Ord, Semigroup, Show)++instance IsString Name where+  fromString = Name . Utf8.fromString+  {-# INLINABLE fromString #-}

@@ -0,0 +1,30 @@+{-# OPTIONS_GHC -Wno-warnings-deprecations #-}+{-|+Module      : HsLua.Core.Unsafe+Copyright   : © 2019-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>++Unsafe Lua functions.++This module exports functions which conflict with those in 'HsLua.Core'.+It is intended to be imported qualified.+-}+module HsLua.Core.Unsafe+  ( next+  )+where++import Control.Monad ((<$!>))+import HsLua.Core.Types (LuaE, StackIndex, liftLua, fromLuaBool)+import Lua.Primary (lua_next)++-- | Wrapper for 'lua_next'.+--+-- __WARNING__: @lua_next@ is unsafe in Haskell: This function will+-- cause an unrecoverable crash an error if the given key is neither+-- @nil@ nor present in the table. Consider using the safe+-- @'HsLua.Core.Primary.next'@ function in HsLua.Core instead.+next :: StackIndex -> LuaE e Bool+next idx = liftLua $ \l -> fromLuaBool <$!> lua_next l idx+{-# INLINABLE next #-}

@@ -0,0 +1,71 @@+{-# LANGUAGE RankNTypes #-}+{-|+Module      : HsLua.Core.Userdata+Copyright   : © 2007–2012 Gracjan Polak;+              © 2012–2016 Ömer Sinan Ağacan;+              © 2017-2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability   : beta+Portability : non-portable (depends on GHC)++Convenience functions to convert Haskell values into Lua userdata.+-}+module HsLua.Core.Userdata+  ( newhsuserdata+  , newudmetatable+  , fromuserdata+  , putuserdata+  ) where++import HsLua.Core.Types (LuaE, Name (..), StackIndex, liftLua, fromLuaBool)+import Lua.Userdata+  ( hslua_fromuserdata+  , hslua_newhsuserdata+  , hslua_newudmetatable+  , hslua_putuserdata+  )+import qualified Data.ByteString as B++-- | Creates a new userdata wrapping the given Haskell object. The+-- userdata is pushed to the top of the stack.+newhsuserdata :: forall a e. a -> LuaE e ()+newhsuserdata = liftLua . flip hslua_newhsuserdata+{-# INLINABLE newhsuserdata #-}++-- | Creates and registers a new metatable for a userdata-wrapped+-- Haskell value; checks whether a metatable of that name has been+-- registered yet and uses the registered table if possible.+--+-- Using a metatable created by this functions ensures that the pointer+-- to the Haskell value will be freed when the userdata object is+-- garbage collected in Lua.+--+-- The name may not contain a nul character.+newudmetatable :: Name -> LuaE e Bool+newudmetatable (Name name) = liftLua $ \l ->+  B.useAsCString name (fmap fromLuaBool . hslua_newudmetatable l)+{-# INLINABLE newudmetatable #-}++-- | Retrieves a Haskell object from userdata at the given index. The+-- userdata /must/ have the given name.+fromuserdata :: forall a e.+                StackIndex  -- ^ stack index of userdata+             -> Name        -- ^ expected name of userdata object+             -> LuaE e (Maybe a)+fromuserdata idx (Name name) = liftLua $ \l ->+  B.useAsCString name (hslua_fromuserdata l idx)+{-# INLINABLE fromuserdata #-}++-- | Replaces the Haskell value contained in the userdata value at+-- @index@. Checks that the userdata is of type @name@ and returns+-- 'True' on success, or 'False' otherwise.+putuserdata :: forall a e.+               StackIndex   -- ^ index+            -> Name         -- ^ name+            -> a            -- ^ new value+            -> LuaE e Bool+putuserdata idx (Name name) x = liftLua $ \l ->+  B.useAsCString name $ \namePtr ->+  hslua_putuserdata l idx namePtr x+{-# INLINABLE putuserdata #-}

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-} {-| Tests for the auxiliary library. -} module HsLua.Core.AuxiliaryTests (tests) where@@ -18,7 +19,7 @@   [ testGroup "getsubtable"     [ "gets a subtable from field" =:       [5, 8] `shouldBeResultOf` do-        pushLuaExpr "{foo = {5, 8}}"+        pushLuaExpr @Lua.Exception "{foo = {5, 8}}"         _ <- Lua.getsubtable Lua.top "foo"         Lua.rawgeti (nth 1) 1         Lua.rawgeti (nth 2) 2@@ -34,11 +35,11 @@         Lua.ltype Lua.top      , "returns True if a table exists" ?: do-        pushLuaExpr "{yep = {}}"+        pushLuaExpr @Lua.Exception "{yep = {}}"         Lua.getsubtable Lua.top "yep"      , "returns False if field does not contain a table" ?: do-        pushLuaExpr "{nope = 5}"+        pushLuaExpr @Lua.Exception "{nope = 5}"         not <$> Lua.getsubtable Lua.top "nope"      ]@@ -80,6 +81,26 @@         Lua.getmetatable' "yep"     ] -  , "loadedTable" =: ("_LOADED" @=? Lua.loadedTableRegistryField)-  , "preloadTable" =: ("_PRELOAD" @=? Lua.preloadTableRegistryField)+  , testGroup "where'"+    [ "return location in chunk" =:+      "test:1: nope, not yet" `shouldBeResultOf` do+        Lua.openlibs+        Lua.pushHaskellFunction $ 1 <$ do+          Lua.settop 1+          Lua.where' 2+          Lua.pushstring "nope, "+          Lua.pushvalue 1+          Lua.concat 3+        Lua.setglobal "frob"+        Lua.OK <- Lua.loadbuffer+          "return frob('not yet')"+          "@test"+        result <- Lua.pcall 0 1 Nothing+        if result /= Lua.OK+          then Lua.throwErrorAsException+          else Lua.tostring' Lua.top+    ]++  , "loaded" =: ("_LOADED" @=? Lua.loaded)+  , "preload" =: ("_PRELOAD" @=? Lua.preload)   ]

@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-|+Module      :  HsLua.Core.ClosuresTests+Copyright   :  © 2017-2021 Albert Krewinkel+License     :  MIT++Maintainer  :  Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability   :  stable+Portability :  portable++Test exposing Haskell functions to Lua.+-}+module HsLua.Core.ClosuresTests (tests) where++import Control.Monad (forM_, void)+import Data.Maybe (fromMaybe)+import HsLua.Core as Lua+import Test.Tasty.HsLua ((=:), (?:), shouldBeResultOf)+import Test.Tasty (TestTree, testGroup)++-- | Specifications for Attributes parsing functions.+tests :: TestTree+tests = testGroup "Closures"+  [ "Haskell functions are callable from Lua" =:+    Just (113 :: Lua.Integer) `shouldBeResultOf` do+      -- add 23+      pushHaskellFunction $ do+        i <- tointeger (nthBottom 1)+        pushinteger (fromMaybe 0 i + 42)+        return (NumResults 1)+      pushinteger 71+      call 1 1+      tointeger top++  , "Haskell functions have the Lua type C function" ?: do+      pushHaskellFunction (return 0 :: Lua NumResults)+      iscfunction top++  -- The following test case will hang if there are issues with the way+  -- functions are garbage collection.+  , "function garbage collection" =:+    () `shouldBeResultOf` do+      let pushAndPopAdder n = do+            let fn :: Lua NumResults+                fn = do+                  x <- fromMaybe 0 <$> tointeger (nthBottom 1)+                  pushinteger (x + n)+                  return (NumResults 1)+            pushHaskellFunction fn+            pop 1+      forM_ [1..5000::Lua.Integer] pushAndPopAdder+      void $ gc Lua.GCCollect+  ]

@@ -1,25 +1,55 @@+{-# LANGUAGE DeriveDataTypeable   #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications     #-} {-| Tests for error handling. -} module HsLua.Core.ErrorTests (tests) where  import Control.Applicative ((<|>), empty)+import Control.Exception+import Data.ByteString (ByteString)+import Data.Typeable (Typeable) import Data.Either (isLeft)-import HsLua.Core (Lua)-import Test.Tasty.HsLua ( (=:), shouldBeResultOf, shouldHoldForResultOf)+import HsLua.Core (Lua, failLua)+import HsLua.Core.Error (LuaError, changeErrorType, popErrorMessage)+import HsLua.Core.Types (liftLua)+import Test.Tasty.HsLua ( (=:), (?:), shouldBeResultOf, shouldHoldForResultOf) import Test.Tasty (TestTree, testGroup)  import qualified HsLua.Core as Lua+import qualified HsLua.Core.Utf8 as Utf8  -- | Specifications for Attributes parsing functions. tests :: TestTree tests = testGroup "Error"   [ "try catches errors" =:-    isLeft `shouldHoldForResultOf` Lua.try (Lua.throwException "test" :: Lua ())+    isLeft `shouldHoldForResultOf` Lua.try+      (failLua "test" :: Lua ()) -  , "second alternative is used when first fails" =:-    True `shouldBeResultOf` (Lua.throwException "test" <|> return True)+  , "second alternative is used when first fails" ?:+    ((failLua "test" :: Lua Bool) <|> return True)    , "Applicative.empty implementation throws an exception" =:     isLeft `shouldHoldForResultOf` Lua.try (empty :: Lua ())++  , testGroup "changeErrorType"+    [ "catches error as different type in argument operation" =:+      Left (SampleException "message") `shouldBeResultOf`+      changeErrorType (Lua.try @SampleException @() $ failLua "message")++    , "passes value through on success" =:+      Just "plant" `shouldBeResultOf` do+        Lua.pushstring "plant"+        changeErrorType (Lua.tostring Lua.top)+    ]   ]++newtype SampleException = SampleException ByteString+  deriving (Eq, Typeable, Show)++instance Exception SampleException++instance LuaError SampleException where+  popException = SampleException <$> liftLua popErrorMessage+  pushException (SampleException msg) = Lua.pushstring msg+  luaException = SampleException . Utf8.fromString

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} {-| Module      :  HsLua.Core.RunTests@@ -24,13 +25,10 @@   [ testGroup "runEither"     [ "Lua errors are caught" =:       isLeft `shouldHoldForResultOf`-        liftIO (runEither' (throwMessage "failing" :: Lua Bool))+      liftIO (runEither (failLua "failing" :: Lua Bool))      , "error-less code gives 'Right'" =:       isRight `shouldHoldForResultOf`-        liftIO (runEither' (pushboolean True *> toboolean top))+        liftIO (runEither @Lua.Exception (pushboolean True *> toboolean top))     ]   ]--runEither' :: Lua a -> IO (Either Lua.Exception a)-runEither' = runEither

@@ -0,0 +1,36 @@+{-# OPTIONS_GHC -Wno-warnings-deprecations #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : HsLua.Core.UnsafeTests+Copyright   : © 2021 Albert Krewinkel+License     : MIT+Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>+Stability   : beta++Tests for bindings to unsafe functions.+-}+module HsLua.Core.UnsafeTests (tests) where++import HsLua.Core+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HsLua ((=:), pushLuaExpr, shouldBeResultOf)+import qualified HsLua.Core.Unsafe as Unsafe++-- | Tests for unsafe methods.+tests :: TestTree+tests = testGroup "Unsafe"+  [ testGroup "next"+    [ "get next key from table" =:+      Just 43 `shouldBeResultOf` do+        pushLuaExpr "{43}"+        pushnil -- first key+        True <- Unsafe.next (nth 2)+        tonumber top++    , "returns FALSE if table is empty" =:+      False `shouldBeResultOf` do+        newtable+        pushnil+        Unsafe.next (nth 2)+    ]+  ]

@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      :  HsLua.Core.UserdataTests+Copyright   :  © 2017-2021 Albert Krewinkel+License     :  MIT++Maintainer  :  Albert Krewinkel <tarleb+hslua@zeitkraut.de>++Tests that any data type can be pushed to Lua.+-}+module HsLua.Core.UserdataTests (tests) where++import HsLua.Core (getfield, pushboolean, setmetatable, tostring)+import HsLua.Core.Userdata+  (fromuserdata, newhsuserdata, newudmetatable, putuserdata)+import HsLua.Core.Types (nth, top)+import Test.Tasty.HsLua ((=:), shouldBeResultOf)+import Test.Tasty (TestTree, testGroup)++-- | Specifications for Attributes parsing functions.+tests :: TestTree+tests = testGroup "Userdata"+  [ "Name is kept in __name" =:+    Just "Sample" `shouldBeResultOf` do+      newudmetatable "Sample"+      getfield top "__name"+      tostring top++  , "get back pushed value" =:+    Just (Sample 0 "zero") `shouldBeResultOf` do+      newhsuserdata (Sample 0 "zero")+      newudmetatable "Sample"+      setmetatable (nth 2)+      fromuserdata top "Sample"++  , "fail on boolean" =:+    (Nothing :: Maybe Sample) `shouldBeResultOf` do+      pushboolean False+      fromuserdata top "Sample"++  , "fail on wrong userdata" =:+    (Nothing :: Maybe Sample) `shouldBeResultOf` do+      newhsuserdata (5 :: Integer)+      newudmetatable "Integer"+      setmetatable (nth 2)+      fromuserdata top "Sample"++  , "change wrapped value" =:+    Just (Sample 1 "a") `shouldBeResultOf` do+      newhsuserdata (Sample 5 "five")+      newudmetatable "Sample"+      setmetatable (nth 2)+      True <- putuserdata top "Sample" (Sample 1 "a")+      fromuserdata top "Sample"++  , "change fails on wrong name" =:+    Just (Sample 2 "b") `shouldBeResultOf` do+      newhsuserdata (Sample 2 "b")+      newudmetatable "Sample"+      setmetatable (nth 2)+      False <- putuserdata top "WRONG" (Sample 3 "c")+      fromuserdata top "Sample"+  ]++-- | Sample data type.+data Sample = Sample Int String+  deriving (Eq, Show)

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} {-| Module      :  HsLua.CoreTests@@ -15,14 +16,14 @@  import Prelude hiding (compare) -import Control.Monad (forM_) import Data.ByteString (append) import Data.Maybe (fromMaybe) import Lua.Lib (luaopen_debug) import HsLua.Core as Lua+import HsLua.Core.Types (toType) import Lua.Arbitrary () import Test.Tasty.HsLua ( (?:), (=:), shouldBeErrorMessageOf, shouldBeResultOf-                       , shouldHoldForResultOf, pushLuaExpr )+                        , shouldHoldForResultOf, pushLuaExpr ) import Test.QuickCheck (Property, (.&&.)) import Test.QuickCheck.Monadic (assert, monadicIO) import Test.Tasty (TestTree, testGroup)@@ -33,6 +34,9 @@ import qualified Data.ByteString as B import qualified HsLua.Core.AuxiliaryTests import qualified HsLua.Core.ErrorTests+import qualified HsLua.Core.RunTests+import qualified HsLua.Core.UnsafeTests+import qualified HsLua.Core.UserdataTests import qualified Foreign.Marshal as Foreign import qualified Foreign.Ptr as Foreign import qualified Test.QuickCheck.Monadic as QCMonadic@@ -45,33 +49,33 @@   , HsLua.Core.AuxiliaryTests.tests   , testGroup "copy"     [ "copies stack elements using positive indices" ?: do-        pushLuaExpr "5, 4, 3, 2, 1"+        pushLuaExpr @Lua.Exception "5, 4, 3, 2, 1"         copy 4 3         rawequal (nthBottom 4) (nthBottom 3)      , "copies stack elements using negative indices" ?: do-        pushLuaExpr "5, 4, 3, 2, 1"+        pushLuaExpr @Lua.Exception "5, 4, 3, 2, 1"         copy (-1) (-3)         rawequal (-1) (-3)     ]    , testGroup "insert"     [ "inserts stack elements using positive indices" ?: do-        pushLuaExpr "1, 2, 3, 4, 5, 6, 7, 8, 9"+        pushLuaExpr @Lua.Exception "1, 2, 3, 4, 5, 6, 7, 8, 9"         insert 4         movedEl <- tointeger (nthBottom 4)         newTop <- tointeger (nth 1)         return (movedEl == Just 9 && newTop == Just 8)      , "inserts stack elements using negative indices" ?: do-        pushLuaExpr "1, 2, 3, 4, 5, 6, 7, 8, 9"+        pushLuaExpr @Lua.Exception "1, 2, 3, 4, 5, 6, 7, 8, 9"         insert (-6)         movedEl <- tointeger (nth 6)         newTop <- tointeger (nth 1)         return (movedEl == Just 9 && newTop == Just 8)     ] -  , testCase "absindex" . run $ do+  , testCase "absindex" . run @Lua.Exception $ do       pushLuaExpr "1, 2, 3, 4"       liftIO . assertEqual "index from bottom doesn't change" (nthBottom 3)         =<< absindex (nthBottom 3)@@ -82,27 +86,27 @@    , "gettable gets a table value" =:     Just 13.37 `shouldBeResultOf` do-      pushLuaExpr "{sum = 13.37}"+      pushLuaExpr @Lua.Exception "{sum = 13.37}"       pushstring "sum"       gettable (nth 2)       tonumber top    , "rawlen gives the length of a list" =:     7 `shouldBeResultOf` do-      pushLuaExpr "{1, 1, 2, 3, 5, 8, 13}"+      pushLuaExpr @Lua.Exception "{1, 1, 2, 3, 5, 8, 13}"       rawlen top    , testGroup "Type checking"     [ "isfunction" ?: do-        pushLuaExpr "function () print \"hi!\" end"+        pushLuaExpr @Lua.Exception "function () print \"hi!\" end"         isfunction (-1) -    , "isnil" ?: pushLuaExpr "nil" *> isnil (-1)+    , "isnil" ?: pushLuaExpr @Lua.Exception "nil" *> isnil (-1)      , "isnone" ?: isnone 5 -- stack index 5 does not exist      , "isnoneornil" ?: do-        pushLuaExpr "nil"+        pushLuaExpr @Lua.Exception "nil"         (&&) <$> isnoneornil 5 <*> isnoneornil (-1)     ] @@ -116,41 +120,41 @@     [ testGroup "tointeger"       [ "tointeger returns numbers verbatim" =:         Just 149 `shouldBeResultOf` do-          pushLuaExpr "149"+          pushLuaExpr @Lua.Exception "149"           tointeger (-1)        , "tointeger accepts strings coercible to integers" =:         Just 451 `shouldBeResultOf` do-          pushLuaExpr "'451'"+          pushLuaExpr @Lua.Exception "'451'"           tointeger (-1)        , "tointeger returns Nothing when given a boolean" =:         Nothing `shouldBeResultOf` do-          pushLuaExpr "true"+          pushLuaExpr @Lua.Exception "true"           tointeger (-1)       ]      , testGroup "tonumber"       [ "tonumber returns numbers verbatim" =:         Just 14.9 `shouldBeResultOf` do-          pushLuaExpr "14.9"+          pushLuaExpr @Lua.Exception "14.9"           tonumber (-1)        , "tonumber accepts strings as numbers" =:         Just 42.23 `shouldBeResultOf` do-          pushLuaExpr "'42.23'"+          pushLuaExpr @Lua.Exception "'42.23'"           tonumber (-1)        , "tonumber returns Nothing when given a boolean" =:         Nothing `shouldBeResultOf` do-          pushLuaExpr "true"+          pushLuaExpr @Lua.Exception "true"           tonumber (-1)       ]      , testGroup "tostring"       [ "get a string" =:         Just "a string" `shouldBeResultOf` do-          pushLuaExpr "'a string'"+          pushLuaExpr @Lua.Exception "'a string'"           tostring top        , "get a number as string" =:@@ -167,7 +171,7 @@    , "setting and getting a global works" =:     Just "Moin" `shouldBeResultOf` do-      pushLuaExpr "{'Moin', Hello = 'World'}"+      pushLuaExpr @Lua.Exception "{'Moin', Hello = 'World'}"       setglobal "hamburg"        -- get first field@@ -178,11 +182,21 @@   , testGroup "get functions (Lua to stack)"     [ "unicode characters in field name are ok" =:       True `shouldBeResultOf` do-        pushLuaExpr "{['\xE2\x9A\x94'] = true}"+        pushLuaExpr @Lua.Exception "{['\xE2\x9A\x94'] = true}"         getfield top "⚔"         toboolean top     ] +  , "setting and getting a global works" =:+    Just "Fisch" `shouldBeResultOf` do+      newhsuserdata ()+      pushstring "Fisch"+      setuservalue (nth 2)++      -- get uservalue again+      TypeString <- getuservalue top+      tostring top+   , "can push and receive a thread" ?: do       luaSt <- state       isMain <- pushthread@@ -208,7 +222,7 @@         openlibs         getglobal "coroutine"         getfield top "resume"-        pushLuaExpr "coroutine.create(function() coroutine.yield(9) end)"+        pushLuaExpr @Lua.Exception "coroutine.create(function() coroutine.yield(9) end)"         contThread <- fromMaybe (Prelude.error "not a thread at top of stack")                       <$> tothread top         call 1 0@@ -375,14 +389,15 @@      , "raising an error in the error handler should give a 'double error'" =:       ErrErr `shouldBeResultOf` do-        pushLuaExpr "function () error 'error in error handler' end"+        pushLuaExpr @Lua.Exception "function () error 'error in error handler' end"         _ <- loadstring "error \"this fails\""         pcall 0 0 (Just (nth 2))     ]    , testCase "garbage collection" . run $-      -- test that gc can be called with all constructors of type GCCONTROL.-      forM_ [GCSTOP .. GCSETSTEPMUL] $ \what -> gc what 23+      -- test that gc can be called with all constructors of type GCControl.+      mapM_ gc [ GCStop, GCRestart, GCCollect, GCCollect, GCCountb+               , GCStep, GCSetPause 23, GCSetStepMul 5, GCIsRunning ]    , testGroup "compare"     [ testProperty "identifies strictly smaller values" $ compareWith (<) Lua.LT@@ -391,7 +406,7 @@     ]    , testProperty "lessthan works" $ \n1 n2 -> monadicIO $ do-      luaCmp <- QCMonadic.run . run $ do+      luaCmp <- QCMonadic.run . run @Lua.Exception $ do         pushnumber n2         pushnumber n1         lessthan (-1) (-2) <* pop 2@@ -425,8 +440,12 @@             _ <- try $ loadstring err *> call 0 0             newtop <- gettop             return (newtop - oldtop)-      res <- run luaOp+      res <- run @Lua.Exception luaOp       assertEqual "error handling leaks values to the stack" 0 res++  , HsLua.Core.RunTests.tests+  , HsLua.Core.UnsafeTests.tests+  , HsLua.Core.UserdataTests.tests   ]  compareWith :: (Lua.Integer -> Lua.Integer -> Bool)@@ -438,7 +457,7 @@     luaCmp <- QCMonadic.run . run $ do       pushinteger $ n - 1       pushinteger n-      compare (-2) (-1) luaOp+      compare @Lua.Exception (-2) (-1) luaOp     assert $ luaCmp == op (n - 1) n    compareEQ :: Property@@ -446,7 +465,7 @@     luaCmp <- QCMonadic.run . run $ do       pushinteger n       pushinteger n-      compare (-2) (-1) luaOp+      compare @Lua.Exception (-2) (-1) luaOp     assert $ luaCmp == op n n    compareGT :: Property@@ -454,5 +473,5 @@     luaRes <- QCMonadic.run . run $ do       pushinteger $ n + 1       pushinteger n-      compare (-2) (-1) luaOp+      compare @Lua.Exception (-2) (-1) luaOp     assert $ luaRes == op (n + 1) n

@@ -20,7 +20,8 @@   ) where  import Data.ByteString (ByteString, append)-import HsLua.Core (Lua, run, runEither, loadstring, call, multret)+import HsLua.Core+  (Lua, LuaE, LuaError, run, runEither, loadstring, call, multret) import Test.Tasty (TestTree) import Test.Tasty.HUnit   (Assertion, HasCallStack, assertBool, assertFailure, testCase, (@?=))@@ -34,12 +35,13 @@ -- > run $ do -- >   pushLuaExpr "7 + 5" -- >   tointeger top-pushLuaExpr :: ByteString -> Lua ()+pushLuaExpr :: LuaError e => ByteString -> LuaE e () pushLuaExpr expr = loadstring ("return " `append` expr) *> call 0 multret  -- | Takes a value and a 'Lua' operation and turns them into an -- 'Assertion' which checks that the operation produces the given value.-shouldBeResultOf :: (HasCallStack, Eq a, Show a) => a -> Lua a -> Assertion+shouldBeResultOf :: (HasCallStack, Eq a, Show a)+                 => a -> Lua a -> Assertion shouldBeResultOf expected luaOp = do   errOrRes <- runEither luaOp   case errOrRes of@@ -72,12 +74,12 @@                             (predicate res)  -- | Checks whether the operation returns 'True'.-assertLuaBool :: HasCallStack => Lua Bool -> Assertion+assertLuaBool :: HasCallStack => LuaE e Bool -> Assertion assertLuaBool luaOp = assertBool "" =<< run luaOp  -- | Creates a new test case with the given name, checking whether the -- operation returns 'True'.-luaTestBool :: HasCallStack => String -> Lua Bool -> TestTree+luaTestBool :: HasCallStack => String -> LuaE e Bool -> TestTree luaTestBool msg luaOp = testCase msg $   assertBool "Lua operation returned false" =<< run luaOp @@ -87,6 +89,6 @@ infix  3 =:  -- | Infix alias for 'luaTestBool'.-(?:) :: HasCallStack => String -> Lua Bool -> TestTree+(?:) :: HasCallStack => String -> LuaE e Bool -> TestTree (?:) = luaTestBool infixr 3 ?: