hslua 0.9.4 → 0.9.5

raw patch · 9 files changed

+143/−17 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−1
• hslua.cabal +2/−1
• src/Foreign/Lua.hs +5/−1
• src/Foreign/Lua/Types/Error.hs +6/−0
• src/Foreign/Lua/Types/FromLuaStack.hs +13/−5
• src/Foreign/Lua/Util.hs +28/−7
• test/Foreign/Lua/Types/FromLuaStackTest.hs +16/−2
• test/Foreign/Lua/UtilTest.hs +54/−0
• test/test-hslua.hs +2/−0

@@ -1,6 +1,22 @@ ## Changelog -### 0.9.4 (unpublished)+### 0.9.5 (unpublished)++- Provide Optional as a replacement for OrNil. Exports of the latter+  have been fixed.+- Provide utility function `raiseError`: Its argument will be thrown as+  an error in Lua.+- Add `modifyLuaError`: The function lives in Foreign.Lua.Error and+  allows to alter error messages. This is most useful for amending+  errors with additional information.+- Fixed a bug in `toList` which left a element on the stack if+  deserializing that element lead to an error. This also affected the+  FromLuaStack instance for lists.+- Fixed a bug in `pairsFromTable` which left a key-value pair on the+  stack if either of them could not be read into the expected type. This+  also affected the FromLuaStack instance for Map.++### 0.9.4  - Make Lua an instance of MonadMask: MonadMask from Control.Monad.Catch   allows to mask asynchronous exceptions. This allows to define a

@@ -1,5 +1,5 @@ name:                   hslua-version:                0.9.4+version:                0.9.5 stability:              beta cabal-version:          >= 1.8 license:                MIT@@ -201,6 +201,7 @@                       , Foreign.Lua.TypesTest                       , Foreign.Lua.Types.FromLuaStackTest                       , Foreign.Lua.Types.ToLuaStackTest+                      , Foreign.Lua.UtilTest                       , Test.HsLua.Arbitrary                       , Test.HsLua.Util   build-depends:        base

@@ -57,11 +57,14 @@   , freeCFunction   , pushHaskellFunction   , registerHaskellFunction-  -- * Utility functions+  -- * Utility functions and types   , runLua   , runLuaEither   , getglobal'   , setglobal'+  , raiseError+  , Optional (Optional, fromOptional)+  , OrNil (OrNil, toMaybe)   -- * API   , module Foreign.Lua.Api   , module Foreign.Lua.Api.Types@@ -150,6 +153,7 @@   , catchLuaError   , throwLuaError   , tryLua+  , modifyLuaError   ) where  import Prelude hiding (compare, concat)

@@ -35,6 +35,7 @@   ( LuaException (..)   , catchLuaError   , throwLuaError+  , modifyLuaError   , tryLua   ) where @@ -60,6 +61,11 @@ -- | Catch a @'LuaException'@. catchLuaError :: Lua a -> (LuaException -> Lua a) -> Lua a catchLuaError = catch++-- | Catch @'LuaException'@, alter the error message and rethrow.+modifyLuaError :: Lua a -> (String -> String) -> Lua a+modifyLuaError luaOp modifier =+  luaOp `catchLuaError` \(LuaException msg) -> throwLuaError (modifier msg)  -- | Return either the result of a Lua computation or, if an exception was -- thrown, the error.

@@ -135,19 +135,20 @@  -- | Read a table into a list toList :: FromLuaStack a => StackIndex -> Lua [a]-toList n = (go . enumFromTo 1 =<< rawlen n) `catchLuaError` amendError+toList n = resetStackOnError ("Could not read list: " ++) $+  go . enumFromTo 1 =<< rawlen n  where   go [] = return []   go (i : is) = do     ret <- rawgeti n i *> peek (-1) <* pop 1     (ret:) <$> go is-  amendError err = throwLuaError ("Could not read list: " ++ show err)  -- | Read a table into a list of pairs. pairsFromTable :: (FromLuaStack a, FromLuaStack b) => StackIndex -> Lua [(a, b)]-pairsFromTable idx = do-  pushnil-  remainingPairs+pairsFromTable idx =+  resetStackOnError ("Could not read key-value pairs: " ++) $ do+    pushnil+    remainingPairs  where   remainingPairs = do     res <- nextPair (if idx < 0 then idx - 1 else idx)@@ -167,6 +168,13 @@       pop 1 -- removes the value, keeps the key       return (Just (k, v))     else return Nothing++resetStackOnError :: (String -> String) -> Lua a -> Lua a+resetStackOnError modifier op = do+  oldTop <- gettop+  op `catchLuaError` \(LuaException msg) -> do+    settop oldTop+    throwLuaError (modifier msg)  -- -- Tuples

@@ -36,7 +36,9 @@   , setglobal'   , runLua   , runLuaEither-  , OrNil (toMaybe)+  , raiseError+  , OrNil (OrNil, toMaybe)+  , Optional (Optional, fromOptional)   ) where  import Control.Exception (bracket, try)@@ -96,19 +98,38 @@   getglobal x   mapM_ (\a -> getfield (-1) a *> remove (-2)) xs +-- | Raise a Lua error, using the given value as the error object. This must be+-- the return value of a function which has been wrapped with+-- @'wrapHaskellFunction'@.+raiseError :: ToLuaStack a => a -> Lua NumResults+raiseError e = do+  push e+  fromIntegral <$> lerror+{-# INLINABLE raiseError #-}+ -- | Newtype wrapper intended to be used for optional Lua values. Nesting this -- type is strongly discouraged as missing values on inner levels are -- indistinguishable from missing values on an outer level; wrong values -- would be the likely result.-newtype OrNil a = OrNil { toMaybe :: Maybe a }+newtype Optional a = Optional { fromOptional :: Maybe a } -instance FromLuaStack a => FromLuaStack (OrNil a) where+instance FromLuaStack a => FromLuaStack (Optional a) where   peek idx = do     noValue <- isnoneornil idx     if noValue-      then return (OrNil Nothing)-      else OrNil . Just <$> peek idx+      then return (Optional Nothing)+      else Optional . Just <$> peek idx +instance ToLuaStack a => ToLuaStack (Optional a) where+  push (Optional Nothing)  = pushnil+  push (Optional (Just x)) = push x++-- | Like @'Optional'@, but deprecated. Will be removed in the next major+-- release.+newtype OrNil a = OrNil { toMaybe :: Maybe a }++instance FromLuaStack a => FromLuaStack (OrNil a) where+  peek idx = fmap (OrNil . fromOptional) (peek idx)+ instance ToLuaStack a => ToLuaStack (OrNil a) where-  push (OrNil Nothing)  = pushnil-  push (OrNil (Just x)) = push x+  push (OrNil x)  = push (Optional x)

@@ -32,12 +32,12 @@ -} module Foreign.Lua.Types.FromLuaStackTest (tests) where -import Foreign.Lua (Lua, LuaInteger, LuaException (LuaException), call,-                    dostring, loadstring, runLua, tryLua)+import Foreign.Lua import Foreign.Lua.Types.FromLuaStack  import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertEqual, testCase)+import Test.HsLua.Util (pushLuaExpr)  -- | Specifications for Attributes parsing functions. tests :: TestTree@@ -61,4 +61,18 @@       assertEqual "error message mismatched" (Left err) =<< runLua         (loadstring "return {1, 5, 23, true, 42}" *> call 0 1          *> peekEither (-1) :: Lua (Result [LuaInteger]))++  , testCase "stack is unchanged if getting a list fails" . runLua $ do+      liftIO . assertEqual "there should be no element on the stack" 0+        =<< gettop+      pushLuaExpr "{1, 1, 2, 3, 5, 8}"+      _ <- tryLua (toList stackTop :: Lua [Bool])+      liftIO . assertEqual "there should be exactly one element on the stack" 1+        =<< gettop++  , testCase "stack is unchanged if getting key-value pairs fails" . runLua $ do+      pushLuaExpr "{{foo = 'bar', baz = 5}}"+      _ <- tryLua (pairsFromTable stackTop :: Lua [(String, String)])+      liftIO . assertEqual "there should be no element on the stack" 1+        =<< gettop   ]

@@ -0,0 +1,54 @@+{-+Copyright © 2018 Albert Krewinkel++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.+-}+{-| Tests for utility types and functions+-}+module Foreign.Lua.UtilTest (tests) where++import Foreign.Lua+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertEqual, testCase)++-- | Specifications for Attributes parsing functions.+tests :: TestTree+tests = testGroup "Utilities"+  [ testCase "Optional return the value if it exists" . runLua $ do+      push "Moin"+      liftIO . assertEqual "Optional value should equal pushed value" (Just "Moin")+        =<< fmap fromOptional (peek stackTop)++  , testCase "Optional can deal with missing values" . runLua $ do+      pushnil+      liftIO . assertEqual "Peeking nil should return Nothing" Nothing+        =<< fmap fromOptional (peek stackTop :: Lua (Optional String))+      liftIO . assertEqual "Inexistant indices should be accepted" Nothing+        =<< fmap fromOptional (peek (nthFromBottom 9) :: Lua (Optional String))++  , testCase "raiseError causes a Lua error" $ do+      let msg = "error message"+      let luaOp = do+            pushHaskellFunction (raiseError msg)+            wrapHaskellFunction+            call 0 0+            return ()+      assertEqual "An error should be raised" (Left (LuaException msg))+        =<< runLuaEither luaOp+  ]

@@ -27,6 +27,7 @@ import qualified Foreign.Lua.TypesTest import qualified Foreign.Lua.Types.FromLuaStackTest import qualified Foreign.Lua.Types.ToLuaStackTest+import qualified Foreign.Lua.UtilTest  main :: IO () main = defaultMain $ testGroup "hslua" tests@@ -36,6 +37,7 @@ tests =   [ Foreign.Lua.ApiTest.tests   , Foreign.Lua.FunctionCallingTest.tests+  , Foreign.Lua.UtilTest.tests   , testGroup "Sendings and receiving values from the stack"     [ Foreign.Lua.TypesTest.tests     , Foreign.Lua.Types.FromLuaStackTest.tests