diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,22 @@ ## Changelog +### 1.0.1 + +- Exposed more functions from Lua's `lauxlib` library: + + + `getmetafield`, + + `getmetatable'`, + + `getsubtable`, and + + `traceback`. + + The function `getsubtable` is a reimplementation instead of a wrapper + to the C function for simplicity (thereby avoiding additional C + wrappers). + +- Fixed tests for GHC 8.6 by no longer depending on failable pattern + matching. + + ### 1.0.0 #### New features diff --git a/hslua.cabal b/hslua.cabal --- a/hslua.cabal +++ b/hslua.cabal @@ -1,5 +1,5 @@ name: hslua -version: 1.0.0 +version: 1.0.1 synopsis: Bindings to Lua, an embeddable scripting language description: HsLua provides bindings, wrappers, types, and helper functions to bridge Haskell and . @@ -27,7 +27,8 @@ CHANGELOG.md test/lua/*.lua cabal-version: >=1.10 -tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.2 +tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3 + , GHC == 8.6.1 source-repository head type: git @@ -88,7 +89,7 @@ , Foreign.Lua.Core.Functions build-depends: base >= 4.8 && < 5 , bytestring >= 0.10.2 && < 0.11 - , containers >= 0.5 && < 0.6 + , containers >= 0.5 && < 0.7 , exceptions >= 0.8 && < 0.11 , fail >= 4.9 && < 5 , mtl >= 2.2 && < 2.3 @@ -194,7 +195,7 @@ , Test.HsLua.Util build-depends: base >= 4.8 && < 5 , bytestring >= 0.10.2 && < 0.11 - , containers >= 0.5 && < 0.6 + , containers >= 0.5 && < 0.7 , exceptions >= 0.8 && < 0.11 , fail >= 4.9 && < 5 , mtl >= 2.2 && < 2.3 @@ -215,7 +216,7 @@ build-depends: hslua , base >= 4.8 , bytestring >= 0.10.2 && < 0.11 - , criterion >= 1.0 && < 1.5 + , criterion >= 1.0 && < 1.6 , deepseq >= 1.4.1 && < 1.5 c-sources: benchmark/benchmark-functions.c include-dirs: benchmark diff --git a/src/Foreign/Lua/Core.hs b/src/Foreign/Lua/Core.hs --- a/src/Foreign/Lua/Core.hs +++ b/src/Foreign/Lua/Core.hs @@ -149,8 +149,12 @@ -- * Auxiliary library , dostring , dofile + , getmetafield + , getmetatable' + , getsubtable , newmetatable , tostring' + , traceback -- ** References , Reference (..) , ref diff --git a/src/Foreign/Lua/Core/Auxiliary.hsc b/src/Foreign/Lua/Core/Auxiliary.hsc --- a/src/Foreign/Lua/Core/Auxiliary.hsc +++ b/src/Foreign/Lua/Core/Auxiliary.hsc @@ -14,12 +14,16 @@ module Foreign.Lua.Core.Auxiliary ( dostring , dofile + , getmetafield + , getmetatable' + , getsubtable , loadbuffer , loadfile , loadstring , newmetatable , newstate , tostring' + , traceback -- * References , getref , ref @@ -93,10 +97,53 @@ then Lua.pcall 0 multret Nothing else return loadRes +-- | 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. +getmetafield :: StackIndex -- ^ obj + -> String -- ^ e + -> Lua Lua.Type +getmetafield obj e = liftLua $ \l -> + withCString e $ fmap Lua.toType . luaL_getmetafield l obj + +foreign import capi SAFTY "lauxlib.h luaL_getmetafield" + luaL_getmetafield :: Lua.State -> StackIndex -> CString -> IO Lua.TypeCode + +-- | 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 + +foreign import capi SAFTY "lauxlib.h luaL_getmetatable" + luaL_getmetatable :: Lua.State -> CString -> IO Lua.TypeCode + -- | Push referenced value from the table at the given index. getref :: StackIndex -> Reference -> Lua () getref idx ref' = Lua.rawgeti idx (fromIntegral (Lua.fromReference ref')) +-- | 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 + -- This is a reimplementation of luaL_getsubtable from lauxlib.c. + idx' <- Lua.absindex idx + Lua.pushstring (Utf8.fromString fname) + Lua.gettable idx' + isTbl <- Lua.istable Lua.stackTop + if isTbl + then return True + else do + Lua.pop 1 + Lua.newtable + Lua.pushvalue Lua.stackTop -- copy to be left at top + Lua.setfield idx' fname + return False + -- | Loads a ByteString as a Lua chunk. -- -- This function returns the same results as @'load'@. @name@ is the chunk name, @@ -238,6 +285,20 @@ foreign import ccall safe "error-conversion.h hsluaL_tolstring" hsluaL_tolstring :: Lua.State -> StackIndex -> Ptr CSize -> IO (Ptr CChar) + + +-- | 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 () +traceback l1 msg level = liftLua $ \l -> + case msg of + Nothing -> luaL_traceback l l1 nullPtr (fromIntegral level) + Just msg' -> withCString msg' $ \cstr -> + luaL_traceback l l1 cstr (fromIntegral level) + +foreign import capi unsafe "lauxlib.h luaL_traceback" + luaL_traceback :: Lua.State -> Lua.State -> CString -> CInt -> IO () -- | Releases reference @'ref'@ from the table at index @idx@ (see @'ref'@). The diff --git a/test/Foreign/Lua/Core/AuxiliaryTests.hs b/test/Foreign/Lua/Core/AuxiliaryTests.hs --- a/test/Foreign/Lua/Core/AuxiliaryTests.hs +++ b/test/Foreign/Lua/Core/AuxiliaryTests.hs @@ -1,8 +1,9 @@ +{-# LANGUAGE OverloadedStrings #-} {-| Tests for the auxiliary library. -} module Foreign.Lua.Core.AuxiliaryTests (tests) where -import Test.HsLua.Util ( (=:)) +import Test.HsLua.Util ((?:), (=:), pushLuaExpr, shouldBeResultOf) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit ((@=?)) @@ -11,6 +12,63 @@ -- | Specifications for Attributes parsing functions. tests :: TestTree tests = testGroup "Auxiliary" - [ "loadedTable" =: ("_LOADED" @=? Lua.loadedTableRegistryField) + [ testGroup "getsubtable" + [ "gets a subtable from field" =: + [1, 2, 3, 5, 8] `shouldBeResultOf` do + pushLuaExpr "{foo = {1, 2, 3, 5, 8}}" + _ <- Lua.getsubtable Lua.stackTop "foo" + Lua.peek Lua.stackTop :: Lua.Lua [Int] + + , "creates new table at field if necessary" =: + Lua.TypeTable `shouldBeResultOf` do + Lua.newtable + _ <- Lua.getsubtable Lua.stackTop "new" + Lua.getfield (Lua.nthFromTop 2) "new" + Lua.ltype Lua.stackTop + + , "returns True if a table exists" ?: do + pushLuaExpr "{yep = {}}" + Lua.getsubtable Lua.stackTop "yep" + + , "returns False if field does not contain a table" ?: do + pushLuaExpr "{nope = 5}" + not <$> Lua.getsubtable Lua.stackTop "nope" + + ] + + , testGroup "getmetafield'" + [ "gets field from the object's metatable" =: + ("testing" :: String) `shouldBeResultOf` do + Lua.newtable + pushLuaExpr "{foo = 'testing'}" + Lua.setmetatable (Lua.nthFromTop 2) + _ <- Lua.getmetafield Lua.stackTop "foo" + Lua.peek Lua.stackTop + + , "returns TypeNil if the object doesn't have a metatable" =: + Lua.TypeNil `shouldBeResultOf` do + Lua.newtable + Lua.getmetafield Lua.stackTop "foo" + ] + + , testGroup "getmetatable'" + [ "gets table created with newmetatable" =: + [("__name" :: String, "testing" :: String)] `shouldBeResultOf` do + Lua.newmetatable "testing" *> Lua.pop 1 + _ <- Lua.getmetatable' "testing" + Lua.peekKeyValuePairs Lua.stackTop + + , "returns nil if there is no such metatable" =: + Lua.TypeNil `shouldBeResultOf` do + _ <- Lua.getmetatable' "nope" + Lua.ltype Lua.stackTop + + , "returns TypeTable if metatable exists" =: + Lua.TypeTable `shouldBeResultOf` do + _ <- Lua.newmetatable "yep" + Lua.getmetatable' "yep" + ] + + , "loadedTable" =: ("_LOADED" @=? Lua.loadedTableRegistryField) , "preloadTable" =: ("_PRELOAD" @=? Lua.preloadTableRegistryField) ] diff --git a/test/Foreign/Lua/CoreTests.hs b/test/Foreign/Lua/CoreTests.hs --- a/test/Foreign/Lua/CoreTests.hs +++ b/test/Foreign/Lua/CoreTests.hs @@ -37,6 +37,7 @@ import Prelude hiding (compare) import Control.Monad (forM_) +import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Foreign.Lua as Lua import Test.HsLua.Arbitrary () @@ -225,7 +226,8 @@ getglobal "coroutine" getfield stackTop "resume" pushLuaExpr "coroutine.create(function() coroutine.yield(9) end)" - (Just contThread) <- tothread stackTop + contThread <- fromMaybe (Prelude.error "not a thread at top of stack") + <$> tothread stackTop call 1 0 liftIO $ runWith contThread status ]