diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -10,15 +10,18 @@ This provides a `StackValue` instance for aeson's `Value` type. The following conventions are used: -- `Null` values are encoded as the special global `_NULL`. Using `Nil` would - cause problems with null-containing arrays. +- `Null` values are encoded as a special value (stored in the registry field + `HSLUA_AESON_NULL`). Using `nil` would cause problems with null-containing + arrays. - Objects are converted to tables in a straight-forward way. -- Arrays are converted to lua tables. Array-length is included as the value at +- Arrays are converted to Lua tables. Array-length is included as the value at index 0. This makes it possible to distinguish between empty arrays and empty objects. +- JSON numbers are converted to Lua numbers (usually doubles), which can cause + a loss of precision. License ------- diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,12 +1,28 @@ # hslua-aeson +## v1.0.0 + +- Update to hslua 1.0.0 + +- Function `registerNull` has been replaced by `pushNull`. + + Using `pushNull` has the advantage that users won't have to remember + to register a special variable. Users who need a global variable can + set it by running + + pushNull + setglobal "HSLUA_AESON_NULL" + + ## v0.3.0 - Update to hslua 0.8.0. + ## v0.2.0 - Update to hslua 0.6.0. + ## v0.1.0.4 diff --git a/hslua-aeson.cabal b/hslua-aeson.cabal --- a/hslua-aeson.cabal +++ b/hslua-aeson.cabal @@ -1,5 +1,5 @@ name: hslua-aeson -version: 0.3.0.2 +version: 1.0.0 synopsis: Allow aeson data types to be used with lua. description: This package provides instances to push and receive any datatype encodable as JSON to and from the Lua stack. @@ -25,7 +25,7 @@ build-depends: base >= 4.7 && < 5 , aeson >= 0.11 && < 1.5 , hashable >= 1.2 && < 1.3 - , hslua >= 0.8 && < 0.10 + , hslua >= 1.0 && < 1.1 , scientific >= 0.3 && < 0.4 , text >= 1.1.1.0 && < 1.3 , unordered-containers >= 0.2 && < 0.3 @@ -38,11 +38,12 @@ hs-source-dirs: test main-is: AesonSpec.hs build-depends: base + , aeson + , bytestring >= 0.10.2 && < 0.11 , hspec >= 2.2 , HUnit , QuickCheck , quickcheck-instances - , aeson , hashable , hslua , hslua-aeson diff --git a/src/Foreign/Lua/Aeson.hs b/src/Foreign/Lua/Aeson.hs --- a/src/Foreign/Lua/Aeson.hs +++ b/src/Foreign/Lua/Aeson.hs @@ -1,6 +1,4 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-| Module : Foreign.Lua.Aeson @@ -16,122 +14,131 @@ This provides a @StackValue@ instance for aeson's @Value@ type. The following conventions are used: -- @Null@ values are encoded as the special global @_NULL@. Using @Nil@ would - cause problems with null-containing arrays. +- @Null@ values are encoded as a special value (stored in the registry field + @HSLUA_AESON_NULL@). Using @nil@ would cause problems with null-containing + arrays. - Objects are converted to tables in a straight-forward way. - Arrays are converted to lua tables. Array-length is included as the value at index 0. This makes it possible to distinguish between empty arrays and empty objects. + +- JSON numbers are converted to Lua numbers (usually doubles), which can cause + a loss of precision. -} module Foreign.Lua.Aeson - ( registerNull + ( pushNull ) where -#if MIN_VERSION_base(4,8,0) -#else -import Control.Applicative ((<$>), (<*>), (*>), (<*)) -#endif +import Control.Monad (when) import Data.HashMap.Lazy (HashMap) import Data.Hashable (Hashable) import Data.Scientific (Scientific, toRealFloat, fromFloatDigits) import Data.Vector (Vector, fromList, toList) -import Foreign.Lua hiding (newstate, toList) +import Foreign.Lua as Lua -import qualified Foreign.Lua as Lua import qualified Data.Aeson as Aeson import qualified Data.HashMap.Lazy as HashMap import qualified Data.Vector as Vector -- Scientific -instance ToLuaStack Scientific where - push n = pushnumber (toRealFloat n) +instance Pushable Scientific where + push = pushnumber . toRealFloat -instance FromLuaStack Scientific where - peek n = fromFloatDigits <$> (peek n :: Lua LuaNumber) +instance Peekable Scientific where + peek = fmap (fromFloatDigits :: Lua.Number -> Scientific) . peek -- Vector -instance (ToLuaStack a) => ToLuaStack (Vector a) where - push v = pushvector v +instance (Pushable a) => Pushable (Vector a) where + push = pushvector -instance (FromLuaStack a) => FromLuaStack (Vector a) where - peek i = tovector i +instance (Peekable a) => Peekable (Vector a) where + peek = tovector -- HashMap -instance (Eq a, Hashable a, ToLuaStack a, ToLuaStack b) - => ToLuaStack (HashMap a b) where - push h = pushTextHashMap h +instance (Eq a, Hashable a, Pushable a, Pushable b) + => Pushable (HashMap a b) where + push = pushTextHashMap -instance (Eq a, Hashable a, FromLuaStack a, FromLuaStack b) - => FromLuaStack (HashMap a b) where - peek i = HashMap.fromList <$> pairsFromTable i +instance (Eq a, Hashable a, Peekable a, Peekable b) + => Peekable (HashMap a b) where + peek = fmap HashMap.fromList . peekKeyValuePairs -- | Hslua StackValue instance for the Aeson Value data type. -instance ToLuaStack Aeson.Value where +instance Pushable Aeson.Value where push = \case Aeson.Object o -> push o Aeson.Number n -> push n Aeson.String s -> push s Aeson.Array a -> push a Aeson.Bool b -> push b - Aeson.Null -> getglobal "_NULL" + Aeson.Null -> pushNull -instance FromLuaStack Aeson.Value where - peek i = do - ltype' <- ltype i - case ltype' of - TypeBoolean -> Aeson.Bool <$> peek i - TypeNumber -> Aeson.Number <$> peek i - TypeString -> Aeson.String <$> peek i +instance Peekable Aeson.Value where + peek idx = + ltype idx >>= \case + TypeBoolean -> Aeson.Bool <$> peek idx + TypeNumber -> Aeson.Number <$> peek idx + TypeString -> Aeson.String <$> peek idx TypeTable -> do - rawgeti i 0 - isInt <- isnumber (-1) + rawgeti idx 0 + isInt <- isinteger stackTop pop 1 if isInt - then Aeson.Array <$> peek i + then Aeson.Array <$> peek idx else do - rawlen' <- rawlen i + rawlen' <- rawlen idx if rawlen' > 0 - then Aeson.Array <$> peek i + then Aeson.Array <$> peek idx else do - isNull <- isLuaNull i - if isNull + isNull' <- isNull idx + if isNull' then return Aeson.Null - else Aeson.Object <$> peek i + else Aeson.Object <$> peek idx TypeNil -> return Aeson.Null - _ -> error $ "Unexpected type: " ++ (show ltype') + luaType -> Lua.throwException ("Unexpected type: " ++ show luaType) --- | Create a new lua state suitable for use with aeson values. This behaves --- like @newstate@ in hslua, but initializes the @_NULL@ global. That variable --- is used to encode null values. -registerNull :: Lua () -registerNull = do - createtable 0 0 - setglobal "_NULL" +-- | Registry key containing the representation for JSON null values. +nullRegistryField :: String +nullRegistryField = "HSLUA_AESON_NULL" --- | Check if the value under the given index is rawequal to @_NULL@. -isLuaNull :: StackIndex -> Lua Bool -isLuaNull i = do - let i' = if i < 0 then i - 1 else i - getglobal "_NULL" - rawequal i' (-1) <* pop 1 +-- | Push the value which represents JSON null values to the stack (a specific +-- empty table by default). Internally, this uses the contents of the +-- @HSLUA_AESON_NULL@ registry field; modifying this field is possible, but it +-- must always be non-nil. +pushNull :: Lua () +pushNull = do + push nullRegistryField + rawget registryindex + uninitialized <- isnil stackTop + when uninitialized $ do + pop 1 -- remove nil + newtable + pushvalue stackTop + setfield registryindex nullRegistryField +-- | Check if the value under the given index represents a @null@ value. +isNull :: StackIndex -> Lua Bool +isNull idx = do + idx' <- absindex idx + pushNull + rawequal idx' stackTop <* pop 1 + -- | Push a vector unto the stack. -pushvector :: ToLuaStack a => Vector a -> Lua () +pushvector :: Pushable a => Vector a -> Lua () pushvector v = do pushList . toList $ v - push (fromIntegral (Vector.length v) :: LuaInteger) + push (fromIntegral (Vector.length v) :: Lua.Integer) rawseti (-2) 0 -- | Try reading the value under the given index as a vector. -tovector :: FromLuaStack a => StackIndex -> Lua (Vector a) -tovector = fmap fromList . Lua.toList +tovector :: Peekable a => StackIndex -> Lua (Vector a) +tovector = fmap fromList . Lua.peekList -- | Push a hashmap unto the stack. -pushTextHashMap :: (ToLuaStack a, ToLuaStack b) => HashMap a b -> Lua () +pushTextHashMap :: (Pushable a, Pushable b) => HashMap a b -> Lua () pushTextHashMap hm = do - let xs = HashMap.toList hm - let addValue (k, v) = push k *> push v *> rawset (-3) - newtable - mapM_ addValue xs + let addValue (k, v) = push k *> push v *> rawset (-3) + newtable + mapM_ addValue (HashMap.toList hm) diff --git a/test/AesonSpec.hs b/test/AesonSpec.hs --- a/test/AesonSpec.hs +++ b/test/AesonSpec.hs @@ -1,30 +1,25 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} {-| Copyright : © 2017–2018 Albert Krewinkel License : MIT Tests for Aeson–Lua glue. -} -#if MIN_VERSION_base(4,8,0) -#else -import Control.Applicative ((<$>), (*>)) -#endif import Control.Monad (forM_, when) import Data.AEq ((~==)) import Data.HashMap.Lazy (HashMap) import Data.Scientific (Scientific, toRealFloat, fromFloatDigits) import Data.Text (Text) import Data.Vector (Vector) -import Foreign.Lua -import Foreign.Lua.Aeson (registerNull) +import Foreign.Lua as Lua +import Foreign.Lua.Aeson (pushNull) import Test.Hspec import Test.HUnit import Test.QuickCheck import Test.QuickCheck.Instances () import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Char8 as Char8 -- | Run this spec. main :: IO () @@ -33,12 +28,25 @@ -- | Specifications for Attributes parsing functions. spec :: Spec spec = do + describe "pushNull" $ do + it "pushes a value that is recognized as null when peeked" $ do + val <- run (pushNull *> peek stackTop) + assert (val == Aeson.Null) + it "pushes a non-nil value" $ do + nil <- run (pushNull *> isnil stackTop) + assert (not nil) + it "pushes a single value" $ do + diff <- run $ stackDiff pushNull + assert (diff == 1) + it "pushes two values when called twice" $ do + diff <- run $ stackDiff (pushNull *> pushNull) + assert (diff == 2) describe "Value component" $ do describe "Scientific" $ do it "can be converted to a lua number" $ property $ \x -> assert =<< luaTest "type(x) == 'number'" [("x", x::Scientific)] it "can be round-tripped through the stack with numbers of double precision" $ - property $ \x -> assertRoundtripEqual (luaNumberToScientific (LuaNumber x)) + property $ \x -> assertRoundtripEqual (luaNumberToScientific (Lua.Number x)) it "can be round-tripped through the stack and stays approximately equal" $ property $ \x -> assertRoundtripApprox (x :: Scientific) describe "Text" $ do @@ -62,8 +70,8 @@ property $ \x -> assertRoundtripEqual (x::HashMap Text Bool) it "can be round-tripped through the stack with Text keys and Vector Bool values" $ property $ \x -> assertRoundtripEqual (x::HashMap Text (Vector Bool)) - describe "Value" $ do - it "can be round-tripped through the stack" $ property $ + describe "Value" $ + it "can be round-tripped through the stack" . property $ \x -> assertRoundtripEqual (x::Aeson.Value) assertRoundtripApprox :: Scientific -> IO () @@ -73,46 +81,50 @@ let ydouble = toRealFloat y :: Double assert (xdouble ~== ydouble) -assertRoundtripEqual :: (Show a, Eq a, ToLuaStack a, FromLuaStack a) => a -> IO () +assertRoundtripEqual :: (Show a, Eq a, Pushable a, Peekable a) => a -> IO () assertRoundtripEqual x = do y <- roundtrip x assert (x == y) -roundtrip :: (ToLuaStack a, FromLuaStack a) => a -> IO a -roundtrip x = runLua $ do - registerNull +roundtrip :: (Pushable a, Peekable a) => a -> IO a +roundtrip x = run $ do push x size <- gettop when (size /= 1) $ - error ("not the right amount of elements on the stack: " ++ show size) + Prelude.error ("not the right amount of elements on the stack: " ++ show size) peek (-1) -luaTest :: ToLuaStack a => String -> [(String, a)] -> IO Bool -luaTest luaTestCode xs = runLua $ do +stackDiff :: Lua a -> Lua StackIndex +stackDiff op = do + topBefore <- gettop + _ <- op + topAfter <- gettop + return (topAfter - topBefore) + +luaTest :: Pushable a => String -> [(String, a)] -> IO Bool +luaTest luaTestCode xs = run $ do openlibs - registerNull forM_ xs $ \(var, value) -> push value *> setglobal var let luaScript = "function run() return (" ++ luaTestCode ++ ") end" - _ <- loadstring luaScript - call 0 0 + _ <- dostring (Char8.pack luaScript) callFunc "run" -luaNumberToScientific :: LuaNumber -> Scientific -luaNumberToScientific = fromFloatDigits . (realToFrac :: LuaNumber -> Double) +luaNumberToScientific :: Lua.Number -> Scientific +luaNumberToScientific = fromFloatDigits . (realToFrac :: Lua.Number -> Double) instance Arbitrary Aeson.Value where arbitrary = arbitraryValue 7 arbitraryValue :: Int -> Gen Aeson.Value -arbitraryValue size = frequency $ +arbitraryValue size = frequency [ (1, return Aeson.Null) , (4, Aeson.Bool <$> arbitrary) -- FIXME: this is cheating: we don't draw numbers from the whole possible -- range, but only fro the range of nubers that can pass through the lua -- stack without rounding errors. Good enough for now, but we still might -- want to do better in the future. - , (4, Aeson.Number . luaNumberToScientific . LuaNumber <$> arbitrary) + , (4, Aeson.Number . luaNumberToScientific . Lua.Number <$> arbitrary) , (4, Aeson.String <$> arbitrary) , (2, resize (size - 1) $ Aeson.Array <$> arbitrary) , (2, resize (size - 1) $ Aeson.Object <$> arbitrary)