diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,15 @@ `hslua-core` uses [PVP Versioning][]. +## hslua-core-2.3.1 + +Released 2023-03-17. + +- New module *HsLua.Core.Debug*: the module provides bindings to + a subset of functions of the Lua debug interface. Currently + the module only exports `getupvalue` and `setupvalue`, both of + which are also re-exported from *HsLua.Core*. + ## hslua-core-2.3.0 Released 2023-03-13. diff --git a/hslua-core.cabal b/hslua-core.cabal --- a/hslua-core.cabal +++ b/hslua-core.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: hslua-core -version: 2.3.0 +version: 2.3.1 synopsis: Bindings to Lua, an embeddable scripting language description: Wrappers and helpers to bridge Haskell and . @@ -38,7 +38,7 @@ build-depends: base >= 4.11 && < 5 , bytestring >= 0.10.2 && < 0.12 , exceptions >= 0.8 && < 0.11 - , lua >= 2.3 && < 2.4 + , lua >= 2.3.1 && < 2.4 , mtl >= 2.2 && < 2.4 , text >= 1.2 && < 2.1 ghc-options: -Wall @@ -58,6 +58,7 @@ import: common-options exposed-modules: HsLua.Core , HsLua.Core.Closures + , HsLua.Core.Debug , HsLua.Core.Error , HsLua.Core.Package , HsLua.Core.Run @@ -89,6 +90,7 @@ other-modules: HsLua.CoreTests , HsLua.Core.AuxiliaryTests , HsLua.Core.ClosuresTests + , HsLua.Core.DebugTests , HsLua.Core.ErrorTests , HsLua.Core.PackageTests , HsLua.Core.PrimaryTests diff --git a/src/HsLua/Core.hs b/src/HsLua/Core.hs --- a/src/HsLua/Core.hs +++ b/src/HsLua/Core.hs @@ -190,6 +190,11 @@ , dostringTrace -- ** Warnings , setwarnf' + + -- * Debug interface + , getupvalue + , setupvalue + -- * Haskell userdata values -- -- | Push arbitrary Haskell values to the Lua stack. @@ -221,6 +226,7 @@ import HsLua.Core.Auxiliary import HsLua.Core.Closures +import HsLua.Core.Debug import HsLua.Core.Error import HsLua.Core.Package import HsLua.Core.Primary diff --git a/src/HsLua/Core/Debug.hs b/src/HsLua/Core/Debug.hs new file mode 100644 --- /dev/null +++ b/src/HsLua/Core/Debug.hs @@ -0,0 +1,62 @@ +{-| +Module : HsLua.Core.Debug +Copyright : © 2023 Albert Krewinkel +License : MIT +Maintainer : Albert Krewinkel + +Bindings to Lua's debug interface. +-} +module HsLua.Core.Debug + ( getupvalue + , setupvalue + ) where + +import Control.Monad ((<$!>)) +import Foreign.C (CString) +import Foreign.Ptr (nullPtr) +import HsLua.Core.Types (LuaE, Name (Name), StackIndex, liftLua) +import Lua.Debug (lua_getupvalue, lua_setupvalue) +import qualified Data.ByteString as B + +-- | Gets information about the @n@-th upvalue of the closure at index +-- @funcindex@. It pushes the upvalue's value onto the stack and returns +-- its name. Returns 'Nothing' (and pushes nothing) when the index @n@ +-- is greater than the number of upvalues. +-- +-- See +-- +-- for more information about upvalues. +-- +-- @[0, +(0|1), -]@ +-- +-- Wraps 'lua_getupvalue'. +getupvalue :: StackIndex -- ^ funcindex + -> Int -- ^ n + -> LuaE e (Maybe Name) +getupvalue idx n = liftLua $ \l -> + lua_getupvalue l idx (fromIntegral n) >>= toMaybeName + +-- | Sets the value of a closure’s upvalue. It assigns the value on the +-- top of the stack to the upvalue and returns its name. It also pops +-- the value from the stack. +-- +-- Returns 'Nothing' (and pops nothing) when the index @n@ is greater +-- than the number of upvalues. +-- +-- Parameters @funcindex@ and @n@ are as in the function 'getupvalue'. +-- +-- @[-(0|1), +0, -]@ +-- +-- Wraps 'lua_setupvalue'. +setupvalue :: StackIndex -- ^ funcindex + -> Int -- ^ n + -> LuaE e (Maybe Name) +setupvalue idx n = liftLua $ \l -> + lua_setupvalue l idx (fromIntegral n) >>= toMaybeName + +-- | Convert a (possibly @NULL@) null-terminated C string to a name. +toMaybeName :: CString -> IO (Maybe Name) +toMaybeName cstr = + if cstr == nullPtr + then return Nothing + else Just . Name <$!> B.packCString cstr diff --git a/test/HsLua/Core/DebugTests.hs b/test/HsLua/Core/DebugTests.hs new file mode 100644 --- /dev/null +++ b/test/HsLua/Core/DebugTests.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} +{-| +Module : HsLua.Core.DebugTests +Copyright : © 2023 Albert Krewinkel +License : MIT +Maintainer : Albert Krewinkel + +Test the debug interface. +-} +module HsLua.Core.DebugTests (tests) where + +import HsLua.Core as Lua +import Test.Tasty.HsLua ((=:), shouldBeResultOf) +import Test.Tasty (TestTree, testGroup) + +-- | Specifications for Attributes parsing functions. +tests :: TestTree +tests = testGroup "Debug" + [ "getupvalue" =: + Just "x" `shouldBeResultOf` do + loadstring "local x = 0; return function () return x + 23 end" + call 0 1 + getupvalue top 1 + + , "setupvalue" =: + (Just "i", Just 28) `shouldBeResultOf` do + loadstring "local i = 0; return function () return i + 23 end" + call 0 1 + -- set 'x' to 5 + pushinteger 5 + name <- setupvalue (nth 2) 1 + -- call function and check the returned value + call 0 1 + i <- tointeger top + return (name, i) + ] diff --git a/test/HsLua/CoreTests.hs b/test/HsLua/CoreTests.hs --- a/test/HsLua/CoreTests.hs +++ b/test/HsLua/CoreTests.hs @@ -34,6 +34,7 @@ import qualified Data.ByteString as B import qualified HsLua.Core.AuxiliaryTests import qualified HsLua.Core.ClosuresTests +import qualified HsLua.Core.DebugTests import qualified HsLua.Core.ErrorTests import qualified HsLua.Core.PackageTests import qualified HsLua.Core.PrimaryTests @@ -456,6 +457,7 @@ , HsLua.Core.UnsafeTests.tests , HsLua.Core.UserdataTests.tests , HsLua.Core.WarnTests.tests + , HsLua.Core.DebugTests.tests ] compareWith :: (Lua.Integer -> Lua.Integer -> Bool)