hslua-aeson 0.1.0.4 → 0.3.0

raw patch · 6 files changed

+192/−222 lines, 6 filesdep ~hsluaPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hslua

API changes (from Hackage documentation)

Files

• README.md +5/−2
• changelog.md +13/−0
• hslua-aeson.cabal +12/−10
• src/Foreign/Lua/Aeson.hs +137/−0
• src/Scripting/Lua/Aeson.hs +0/−174
• test/AesonSpec.hs +25/−36

@@ -1,8 +1,8 @@ hslua-aeson =========== -[![travis build status](https://img.shields.io/travis/tarleb/hslua-aeson/master.svg?style=flat-square)](https://travis-ci.org/tarleb/hslua-aeson)-[![MIT License](https://img.shields.io/github/license/tarleb/hslua-aeson.svg?style=flat-square)](./LICENSE)+[![travis build status]](https://travis-ci.org/hslua/hslua-aeson)+[![MIT License]](./LICENSE)   Glue to hslua for aeson values.@@ -26,3 +26,6 @@ This project is licensed under the liberal MIT license, the same license under which hslua and lua itself are published. See the [LICENSE](./LICENSE) file for details.++[travis build status]: https://img.shields.io/travis/hslua/hslua-aeson/master.svg?style=flat-square+[MIT License]: https://img.shields.io/github/license/hslua/hslua-aeson.svg?style=flat-square

@@ -0,0 +1,13 @@+# hslua-aeson++## v0.3.0++- Update to hslua 0.8.0.++## v0.2.0++- Update to hslua 0.6.0.++## v0.1.0.4++- Ensure compatibility with hslua 0.5.0.

@@ -1,25 +1,31 @@ name:                hslua-aeson-version:             0.1.0.4-synopsis:            Glue between aeson and hslua-description:         Please see README.md+version:             0.3.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. homepage:            https://github.com/tarleb/hslua-aeson#readme license:             MIT license-file:        LICENSE author:              Albert Krewinkel maintainer:          tarleb+hslua@zeitkraut.de copyright:           © 2017 Albert Krewinkel-category:            Scripting+category:            Foreign build-type:          Simple extra-source-files:  README.md+                     changelog.md cabal-version:       >=1.10 +source-repository head+  type:     git+  location: https://github.com/hslua/hslua-aeson+ library   hs-source-dirs:      src-  exposed-modules:     Scripting.Lua.Aeson+  exposed-modules:     Foreign.Lua.Aeson   build-depends:       base                 >= 4.7     && < 5                      , aeson                >= 0.11    && < 1.3                      , hashable             >= 1.2     && < 1.3-                     , hslua                >= 0.4     && < 0.6+                     , hslua                >= 0.8     && < 0.9                      , scientific           >= 0.3     && < 0.4                      , text                 >= 1.1.1.0 && < 1.3                      , unordered-containers >= 0.2     && < 0.3@@ -47,7 +53,3 @@                      , vector   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall   default-language:    Haskell2010--source-repository head-  type:     git-  location: https://github.com/tarleb/hslua-aeson

@@ -0,0 +1,137 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-|+Module      :  Foreign.Lua.Aeson+Copyright   :  © 2017 Albert Krewinkel+License     :  MIT++Maintainer  :  Albert Krewinkel <tarleb@zeitkraut.de>+Stability   :  experimental+Portability :  portable++Glue to hslua for aeson values.++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.++- 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.+-}+module Foreign.Lua.Aeson+  ( registerNull+  ) where++#if MIN_VERSION_base(4,8,0)+#else+import Control.Applicative ((<$>), (<*>), (*>), (<*))+#endif+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 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 FromLuaStack Scientific where+  peek n = fromFloatDigits <$> (peek n :: Lua LuaNumber)++-- Vector+instance (ToLuaStack a) => ToLuaStack (Vector a) where+  push v = pushvector v++instance (FromLuaStack a) => FromLuaStack (Vector a) where+  peek i = tovector i++-- HashMap+instance (Eq a, Hashable a, ToLuaStack a, ToLuaStack b)+      => ToLuaStack (HashMap a b) where+  push h = pushTextHashMap h++instance (Eq a, Hashable a, FromLuaStack a, FromLuaStack b)+      => FromLuaStack (HashMap a b) where+  peek i = HashMap.fromList <$> pairsFromTable i++-- | Hslua StackValue instance for the Aeson Value data type.+instance ToLuaStack 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"++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+      TypeTable -> do+        rawgeti i 0+        isInt <- isnumber (-1)+        pop 1+        if isInt+          then Aeson.Array <$> peek i+          else do+            rawlen' <- rawlen i+            if rawlen' > 0+              then Aeson.Array <$> peek i+              else do+                isNull <- isLuaNull i+                if isNull+                  then return Aeson.Null+                  else Aeson.Object <$> peek i+      TypeNil -> return Aeson.Null+      _    -> error $ "Unexpected type: " ++ (show ltype')++-- | 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"++-- | 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 a vector unto the stack.+pushvector :: ToLuaStack a => Vector a -> Lua ()+pushvector v = do+  pushList . toList $ v+  push (fromIntegral (Vector.length v) :: LuaInteger)+  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++-- | Push a hashmap unto the stack.+pushTextHashMap :: (ToLuaStack a, ToLuaStack 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

@@ -1,174 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}-{-|-Module      :  Scripting.Lua.Aeson-Copyright   :  © 2017 Albert Krewinkel-License     :  MIT--Maintainer  :  Albert Krewinkel <tarleb@zeitkraut.de>-Stability   :  experimental-Portability :  portable--Glue to hslua for aeson values.--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.--- 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.--}-module Scripting.Lua.Aeson-  ( module Scripting.Lua-  , newstate-  ) where--#if MIN_VERSION_base(4,8,0)-#else-import Control.Applicative ((<$>), (<*>), (*>))-#endif-import Data.HashMap.Lazy (HashMap)-import Data.Hashable (Hashable)-import Data.Scientific (Scientific, toRealFloat, fromFloatDigits)-import Data.Text (Text)-import Data.Text.Encoding (decodeUtf8, encodeUtf8)-import Data.Vector (Vector, fromList, toList)-import Scripting.Lua (LuaState, StackValue)--import qualified Data.Aeson as Aeson-import qualified Data.HashMap.Lazy as HashMap-import qualified Data.Vector as Vector-import qualified Scripting.Lua as Lua--instance StackValue Scientific where-  push lua n = Lua.pushnumber lua (toRealFloat n)-  peek lua n = fmap fromFloatDigits <$>-               (Lua.peek lua n :: IO (Maybe Lua.LuaNumber))-  valuetype _ = Lua.TNUMBER--instance StackValue Text where-  push lua t = Lua.push lua (encodeUtf8 t)-  peek lua i = fmap decodeUtf8 <$> Lua.peek lua i-  valuetype _ = Lua.TSTRING--instance (StackValue a) => StackValue (Vector a) where-  push lua v = pushvector lua v-  peek lua i = tovector lua i-  valuetype _ = Lua.TTABLE--instance (Eq a, Hashable a, StackValue a, StackValue b)-      => StackValue (HashMap a b) where-  push lua h = pushTextHashMap lua h-  peek lua i = fmap HashMap.fromList <$> getPairs lua i-  valuetype _ = Lua.TTABLE---- | Hslua StackValue instance for the Aeson Value data type.-instance StackValue Aeson.Value where-  push lua = \case-    Aeson.Object o -> Lua.push lua o-    Aeson.Number n -> Lua.push lua n-    Aeson.String s -> Lua.push lua s-    Aeson.Array a -> Lua.push lua a-    Aeson.Bool b -> Lua.push lua b-    Aeson.Null -> Lua.getglobal lua "_NULL"-  peek lua i = do-    ltype <- Lua.ltype lua i-    case ltype of-      Lua.TBOOLEAN -> fmap Aeson.Bool  <$> Lua.peek lua i-      Lua.TNUMBER -> fmap Aeson.Number <$> Lua.peek lua i-      Lua.TSTRING -> fmap Aeson.String <$> Lua.peek lua i-      Lua.TTABLE -> do-        Lua.rawgeti lua i 0-        len <- Lua.peek lua (-1)-        Lua.pop lua 1-        case (len :: Maybe Int) of-          Just _  -> fmap Aeson.Array <$> Lua.peek lua i-          Nothing -> do-            objlen <- Lua.objlen lua i-            if objlen > 0-              then fmap Aeson.Array <$> Lua.peek lua i-              else do-                isNull <- isLuaNull lua i-                if isNull-                  then return $ Just Aeson.Null-                  else fmap Aeson.Object <$> Lua.peek lua i-      Lua.TNIL -> return $ Just Aeson.Null-      _        -> error $ "Unexpected type: " ++ (show ltype)-  valuetype = \case-    Aeson.Object _ -> Lua.TTABLE-    Aeson.Number _ -> Lua.TNUMBER-    Aeson.String _ -> Lua.TSTRING-    Aeson.Array _ -> Lua.TTABLE-    Aeson.Bool _ -> Lua.TBOOLEAN-    Aeson.Null -> Lua.TTABLE---- | 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.-newstate :: IO LuaState-newstate = do-  lua <- Lua.newstate-  Lua.createtable lua 0 0-  Lua.setglobal lua "_NULL"-  return lua---- | Check if the value under the given index is lua-equal to @_NULL@.-isLuaNull :: LuaState -> Int -> IO Bool-isLuaNull lua i = do-  let i' = if i < 0 then i - 1 else i-  Lua.getglobal lua "_NULL"-  res <- Lua.equal lua i' (-1)-  Lua.pop lua 1-  return res---- | Push a vector unto the stack.-pushvector :: StackValue a => LuaState -> Vector a -> IO ()-pushvector lua v = do-  Lua.pushlist lua . toList $ v-  Lua.push lua (Vector.length v)-  Lua.rawseti lua (-2) 0---- | Try reading the value under the given index as a vector.-tovector :: StackValue a => LuaState -> Int -> IO (Maybe (Vector a))-tovector = fmap (fmap (fmap fromList)) . Lua.tolist---- | Try reading the value under the given index as a list of key-value pairs.-getPairs :: (StackValue a, StackValue b)-         => LuaState -> Int -> IO (Maybe [(a, b)])-getPairs lua t = do-  Lua.pushnil lua-  pairs <- sequence <$> remainingPairs-  return pairs- where-  t' = if t < 0 then t - 1 else t-  remainingPairs = do-    res <- nextPair-    case res of-      Nothing -> return []-      Just a  -> (a:) <$> remainingPairs-  nextPair = do-    hasNext <- Lua.next lua t'-    if hasNext-      then do-        val <- Lua.peek lua (-1)-        key <- Lua.peek lua (-2)-        Lua.pop lua 1 -- removes the value, keeps the key-        return $ Just <$> ((,) <$> key <*> val)-      else do-        return Nothing---- | Push a hashmap unto the stack.-pushTextHashMap :: (StackValue a, StackValue b) => LuaState -> HashMap a b -> IO ()-pushTextHashMap lua hm = do-    let xs = HashMap.toList hm-    Lua.createtable lua (length xs + 1) 0-    let addValue (k, v) = Lua.push lua k *> Lua.push lua v *>-                          Lua.rawset lua (-3)-    mapM_ addValue xs

@@ -17,14 +17,14 @@ import Data.Scientific (Scientific, toRealFloat, fromFloatDigits) import Data.Text (Text) import Data.Vector (Vector)-import Scripting.Lua.Aeson (StackValue, newstate)+import Foreign.Lua+import Foreign.Lua.Aeson (registerNull) import Test.Hspec import Test.HUnit import Test.QuickCheck import Test.QuickCheck.Instances ()  import qualified Data.Aeson as Aeson-import qualified Scripting.Lua as Lua  -- | Run this spec. main :: IO ()@@ -38,7 +38,7 @@       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 x)+        property $ \x -> assertRoundtripEqual (luaNumberToScientific (LuaNumber x))       it "can be round-tripped through the stack and stays approximately equal" $         property $ \x -> assertRoundtripApprox (x :: Scientific)     describe "Text" $ do@@ -73,40 +73,33 @@   let ydouble = toRealFloat y :: Double   assert (xdouble ~== ydouble) -assertRoundtripEqual :: (Show a, Eq a, StackValue a) => a -> IO ()+assertRoundtripEqual :: (Show a, Eq a, ToLuaStack a, FromLuaStack a) => a -> IO () assertRoundtripEqual x = do   y <- roundtrip x   assert (x == y) -roundtrip :: (StackValue a) => a -> IO a-roundtrip x = do-  lua <- newstate-  Lua.push lua x-  size <- Lua.gettop lua+roundtrip :: (ToLuaStack a, FromLuaStack a) => a -> IO a+roundtrip x = runLua $ do+  registerNull+  push x+  size <- gettop   when (size /= 1) $     error ("not the right amount of elements on the stack: " ++ show size)-  res <- Lua.peek lua (-1)-  retval <- case res of-        Nothing -> error "could not read from stack"-        Just y  -> return y-  Lua.close lua-  return retval+  peek (-1) -luaTest :: StackValue a => String -> [(String, a)] -> IO Bool-luaTest luaTestCode xs = do-  lua <- Lua.newstate+luaTest :: ToLuaStack a => String -> [(String, a)] -> IO Bool+luaTest luaTestCode xs = runLua $ do+  openlibs+  registerNull   forM_ xs $ \(var, value) ->-    Lua.push lua value *> Lua.setglobal lua var+    push value *> setglobal var   let luaScript = "function run() return (" ++ luaTestCode ++ ") end"-  Lua.openlibs lua-  _ <- loadstring lua luaScript "test script"-  Lua.call lua 0 0-  retval <- Lua.callfunc lua "run"-  Lua.close lua-  return retval+  _ <- loadstring luaScript+  call 0 0+  callFunc "run" -luaNumberToScientific :: Lua.LuaNumber -> Scientific-luaNumberToScientific = fromFloatDigits+luaNumberToScientific :: LuaNumber -> Scientific+luaNumberToScientific = fromFloatDigits . (realToFrac :: LuaNumber -> Double)  instance Arbitrary Aeson.Value where   arbitrary = arbitraryValue 7@@ -115,16 +108,12 @@ arbitraryValue size = frequency $     [ (1, return Aeson.Null)     , (4, Aeson.Bool <$> arbitrary)-    , (4, Aeson.Number . luaNumberToScientific <$> 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.String <$> arbitrary)     , (2, resize (size - 1) $ Aeson.Array <$> arbitrary)     , (2, resize (size - 1) $ Aeson.Object <$> arbitrary)     ]---- | Interpret string as lua code and load into the lua environment.-loadstring :: Lua.LuaState -> String -> String -> IO Int-#if MIN_VERSION_hslua(0,5,0)-loadstring lua script _ = Lua.loadstring lua script-#else-loadstring lua script cn = Lua.loadstring lua script cn-#endif