diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,13 @@ ## Changelog +### 0.8.0 + +- Use newtype definitions instead of type aliases for LuaNumber and LuaInteger. + This makes it easier to ensure the correct numeric instances in situations + where Lua might have been compiled with 32-bit numbers. +- Instances of `FromLuaStack` and `ToLuaStack` for `Int` are removed. The + correctness of these instances cannot be guaranteed if Lua was compiled with a + non-standard integer type. + ### 0.7.1 - The flag `lua_32bits` was added to allow users to compile Lua for 32-bit diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -37,3 +37,11 @@ the C API functions are still provided in `Foreign.Lua.RawBindings`. If you get coroutines to work, or just believe that there should be wrapper functions for other reasons, we'd love to hear from you. + +**Why are there no predefined stack instances for default numerical types?** +HsLua defines instances for the `FromLuaStack` and `ToLuaStack` type-classes +only if the following law holds: `return x == push x *> peek x`. Lua can be +compiled with customized number types, making it impossible to verify the +correctness of the above equation. Furthermore, instances for numerical types +can be based on those of LuaInteger and LuaNumber and are easy to write. +Therefor hslua doesn't provide any such instances. diff --git a/hslua.cabal b/hslua.cabal --- a/hslua.cabal +++ b/hslua.cabal @@ -1,5 +1,5 @@ name: hslua -version: 0.7.1 +version: 0.8.0 stability: beta cabal-version: >= 1.8 license: MIT @@ -186,6 +186,7 @@ , Foreign.Lua.TypesTest , Foreign.Lua.Types.FromLuaStackTest , Foreign.Lua.Types.ToLuaStackTest + , Test.HsLua.Arbitrary , Test.HsLua.Util build-depends: base , QuickCheck >= 2.7 diff --git a/src/Foreign/Lua/Api/Types.hsc b/src/Foreign/Lua/Api/Types.hsc --- a/src/Foreign/Lua/Api/Types.hsc +++ b/src/Foreign/Lua/Api/Types.hsc @@ -80,7 +80,8 @@ -- values in lua. (See @LUA_INT_TYPE@ in @luaconf.h@.) -- -- See . -type LuaInteger = #{type LUA_INTEGER} +newtype LuaInteger = LuaInteger #{type LUA_INTEGER} + deriving (Enum, Eq, Integral, Num, Ord, Real, Show) -- | The type of floats in Lua. -- @@ -88,7 +89,8 @@ -- single float or a long double. (See @LUA_FLOAT_TYPE@ in @luaconf.h@.) -- -- See . -type LuaNumber = #{type LUA_NUMBER} +newtype LuaNumber = LuaNumber #{type LUA_NUMBER} + deriving (Eq, Floating, Fractional, Num, Ord, Real, RealFloat, RealFrac, Show) -- diff --git a/src/Foreign/Lua/Types/FromLuaStack.hs b/src/Foreign/Lua/Types/FromLuaStack.hs --- a/src/Foreign/Lua/Types/FromLuaStack.hs +++ b/src/Foreign/Lua/Types/FromLuaStack.hs @@ -98,9 +98,6 @@ instance FromLuaStack LuaNumber where peek = typeChecked "number" isnumber tonumber -instance FromLuaStack Int where - peek = typeChecked "number" isnumber (fmap fromIntegral . tointeger) - instance FromLuaStack ByteString where peek = typeChecked "string" isstring tostring diff --git a/src/Foreign/Lua/Types/ToLuaStack.hs b/src/Foreign/Lua/Types/ToLuaStack.hs --- a/src/Foreign/Lua/Types/ToLuaStack.hs +++ b/src/Foreign/Lua/Types/ToLuaStack.hs @@ -69,9 +69,6 @@ instance ToLuaStack LuaNumber where push = pushnumber -instance ToLuaStack Int where - push = pushinteger . fromIntegral - instance ToLuaStack ByteString where push = pushstring diff --git a/test/Foreign/Lua/ApiTest.hs b/test/Foreign/Lua/ApiTest.hs --- a/test/Foreign/Lua/ApiTest.hs +++ b/test/Foreign/Lua/ApiTest.hs @@ -21,7 +21,6 @@ -} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module : Foreign.Lua.ApiTest Copyright : © 2017 Albert Krewinkel @@ -39,9 +38,9 @@ import Control.Monad (forM_) import Foreign.Lua as Lua +import Test.HsLua.Arbitrary () import Test.HsLua.Util (luaTestCase, pushLuaExpr) import Test.QuickCheck (Property, (.&&.)) -import Test.QuickCheck.Arbitrary (Arbitrary (..), arbitraryBoundedEnum) import Test.QuickCheck.Monadic (assert, monadicIO, run) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, assertEqual, testCase) @@ -250,7 +249,8 @@ in Prelude.compare n1 n2 == Prelude.compare lt1 lt2 ] -compareWith :: (Int -> Int -> Bool) -> RelationalOperator -> Int -> Property +compareWith :: (LuaInteger -> LuaInteger -> Bool) + -> RelationalOperator -> LuaInteger -> Property compareWith op luaOp n = compareLT .&&. compareEQ .&&. compareGT where compareLT :: Property @@ -276,6 +276,3 @@ push n compare (-2) (-1) luaOp assert $ luaRes == op (n + 1) n - -instance Arbitrary Type where - arbitrary = arbitraryBoundedEnum diff --git a/test/Foreign/Lua/FunctionCallingTest.hs b/test/Foreign/Lua/FunctionCallingTest.hs --- a/test/Foreign/Lua/FunctionCallingTest.hs +++ b/test/Foreign/Lua/FunctionCallingTest.hs @@ -35,19 +35,19 @@ tests :: TestTree tests = testGroup "Interoperability" [ testGroup "call haskell functions from lua" $ - let integerOperation :: Int -> Int -> Lua Int + let integerOperation :: LuaInteger -> LuaInteger -> Lua LuaInteger integerOperation i1 i2 = let (j1, j2) = (fromIntegral i1, fromIntegral i2) in return $ fromIntegral (product [1..j1] `mod` j2 :: Integer) in [ testCase "push haskell function to lua" $ - let add :: Lua Int + let add :: Lua LuaInteger add = do i1 <- peek (-1) i2 <- peek (-2) return (i1 + i2) - luaOp :: Lua Int + luaOp :: Lua LuaInteger luaOp = do registerHaskellFunction "add" add loadstring "return add(23, 5)" *> call 0 1 @@ -56,7 +56,7 @@ in assertEqual "Unexpected result" 28 =<< runLua luaOp , testCase "push multi-argument haskell function to lua" $ - let luaOp :: Lua Int + let luaOp :: Lua LuaInteger luaOp = do registerHaskellFunction "integerOp" integerOperation loadstring "return integerOp(23, 42)" *> call 0 1 @@ -79,7 +79,7 @@ , testGroup "call lua function from haskell" [ testCase "test equality within lua" $ assertEqual "raw equality test failed" True =<< - runLua (openlibs *> callFunc "rawequal" (5 :: Int) (5.0 :: LuaNumber)) + runLua (openlibs *> callFunc "rawequal" (5 :: LuaInteger) (5.0 :: LuaNumber)) , testCase "failing lua function call" $ assertEqual "unexpected result" "foo" =<< diff --git a/test/Foreign/Lua/Types/FromLuaStackTest.hs b/test/Foreign/Lua/Types/FromLuaStackTest.hs --- a/test/Foreign/Lua/Types/FromLuaStackTest.hs +++ b/test/Foreign/Lua/Types/FromLuaStackTest.hs @@ -32,7 +32,8 @@ -} module Foreign.Lua.Types.FromLuaStackTest (tests) where -import Foreign.Lua (Lua, LuaInteger, call, loadstring, runLua) +import Foreign.Lua (Lua, LuaInteger, LuaException (LuaException), call, + dostring, loadstring, runLua, tryLua) import Foreign.Lua.Types.FromLuaStack import Test.Tasty (TestTree, testGroup) @@ -51,13 +52,13 @@ let boolNum = "Expected a boolean but got a number" assertEqual "error messsage mismatched" (Left boolNum) =<< runLua (loadstring "return 5" *> call 0 1 *> peekEither (-1) :: Lua (Result Bool)) - let numBool = "Expected a number but got a boolean" - assertEqual "error message mismatched" (Left numBool) =<< runLua - (loadstring "return true" *> call 0 1 *> peekEither (-1) :: Lua (Result Int)) + let numBoolExcept = LuaException "Expected a number but got a boolean" + assertEqual "error message mismatched" (Left numBoolExcept) =<< runLua + (tryLua $ dostring "return true" *> (peek (-1) :: Lua LuaInteger)) , testCase "list cannot be read if a list element fails" $ do let err = "Could not read list: Expected a number but got a boolean" assertEqual "error message mismatched" (Left err) =<< runLua (loadstring "return {1, 5, 23, true, 42}" *> call 0 1 - *> peekEither (-1) :: Lua (Result [Int])) + *> peekEither (-1) :: Lua (Result [LuaInteger])) ] diff --git a/test/Foreign/Lua/Types/ToLuaStackTest.hs b/test/Foreign/Lua/Types/ToLuaStackTest.hs --- a/test/Foreign/Lua/Types/ToLuaStackTest.hs +++ b/test/Foreign/Lua/Types/ToLuaStackTest.hs @@ -38,6 +38,7 @@ import Foreign.Lua import Foreign.StablePtr (castStablePtrToPtr, freeStablePtr, newStablePtr) +import Test.HsLua.Arbitrary () import Test.QuickCheck (Property) import Test.QuickCheck.Instances () import Test.QuickCheck.Monadic (monadicIO, run, assert) @@ -54,9 +55,9 @@ True "true" - , testCase "Ints can be pushed correctly" $ - assertLuaEqual "5::Int was not pushed" - (5 :: Int) + , testCase "LuaNumbers can be pushed correctly" $ + assertLuaEqual "5::LuaNumber was not pushed" + (5 :: LuaNumber) "5" , testCase "LuaIntegers can be pushed correctly" $ diff --git a/test/Foreign/Lua/TypesTest.hs b/test/Foreign/Lua/TypesTest.hs --- a/test/Foreign/Lua/TypesTest.hs +++ b/test/Foreign/Lua/TypesTest.hs @@ -27,6 +27,7 @@ import Data.ByteString (ByteString) import Data.Map (Map) import Foreign.Lua +import Test.HsLua.Arbitrary () import Test.QuickCheck import Test.QuickCheck.Instances () import Test.QuickCheck.Monadic @@ -101,16 +102,16 @@ , testGroup "Random stack values" [ testProperty "can push/pop booleans" (prop_stackPushingPulling :: Bool -> Property) - , testProperty "can push/pop ints" - (prop_stackPushingPulling :: Int -> Property) + , testProperty "can push/pop lua integers" + (prop_stackPushingPulling :: LuaInteger -> Property) , testProperty "can push/pop lua numbers" (prop_stackPushingPulling :: LuaNumber -> Property) , testProperty "can push/pop bytestrings" (prop_stackPushingPulling :: ByteString -> Property) , testProperty "can push/pop lists of booleans" (prop_stackPushingPulling :: [Bool] -> Property) - , testProperty "can push/pop lists of ints" - (prop_stackPushingPulling :: [Int] -> Property) + , testProperty "can push/pop lists of LuaIntegers" + (prop_stackPushingPulling :: [LuaInteger] -> Property) , testProperty "can push/pop lists of bytestrings" (prop_stackPushingPulling :: [ByteString] -> Property) ] @@ -137,9 +138,9 @@ -- Note that duplicate values don't matter so we don't need to guard against that Ordered indices' <- pick arbitrary let indices = map getPositive indices' - let nItems = if null indices then 0 else last indices + let nItems = (if null indices then 0 else last indices) :: LuaInteger -- Make sure there's enough room in the stack - assert =<< run (runLuaWith l $ checkstack nItems) + assert =<< run (runLuaWith l $ checkstack (fromIntegral nItems)) -- Push elements run $ forM_ [1..nItems] $ \n -> runLuaWith l $ diff --git a/test/Test/HsLua/Arbitrary.hs b/test/Test/HsLua/Arbitrary.hs new file mode 100644 --- /dev/null +++ b/test/Test/HsLua/Arbitrary.hs @@ -0,0 +1,38 @@ +{- +Copyright © 2017 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. +-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| Instances for QuickCheck's Arbitrary. -} +module Test.HsLua.Arbitrary () where + +import Foreign.Lua (LuaInteger, LuaNumber(LuaNumber), Type) +import Test.QuickCheck (Arbitrary(arbitrary)) +import qualified Test.QuickCheck as QC + +instance Arbitrary LuaInteger where + arbitrary = QC.arbitrarySizedIntegral + +instance Arbitrary LuaNumber where + arbitrary = LuaNumber <$> arbitrary + +instance Arbitrary Type where + arbitrary = QC.arbitraryBoundedEnum