hslua-aeson 0.3.0.2 → 1.0.0

raw patch · 5 files changed

+135/−96 lines, 5 filesdep +bytestringdep ~hashabledep ~hsluaPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring

Dependency ranges changed: hashable, hslua

API changes (from Hackage documentation)

Files

• README.md +6/−3
• changelog.md +16/−0
• hslua-aeson.cabal +4/−3
• src/Foreign/Lua/Aeson.hs +72/−65
• test/AesonSpec.hs +37/−25

@@ -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 -------

@@ -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 

@@ -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

@@ -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)

@@ -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)