hslua-aeson (empty) → 0.1.0.0
raw patch · 6 files changed
+384/−0 lines, 6 filesdep +HUnitdep +QuickCheckdep +aesonsetup-changed
Dependencies added: HUnit, QuickCheck, aeson, base, hashable, hslua, hslua-aeson, hspec, ieee754, quickcheck-instances, scientific, text, unordered-containers, vector
Files
- LICENSE +19/−0
- README.md +24/−0
- Setup.hs +2/−0
- hslua-aeson.cabal +53/−0
- src/Scripting/Lua/Aeson.hs +169/−0
- test/AesonSpec.hs +117/−0
+ LICENSE view
@@ -0,0 +1,19 @@+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.
+ README.md view
@@ -0,0 +1,24 @@+hslua-aeson+===========++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.+++License+-------++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hslua-aeson.cabal view
@@ -0,0 +1,53 @@+name: hslua-aeson+version: 0.1.0.0+synopsis: Glue between aeson and hslua+description: Please see README.md+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+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Scripting.Lua.Aeson+ build-depends: base >= 4.7 && < 5+ , aeson >= 0.11 && < 1.2+ , hashable >= 1.2 && < 1.3+ , hslua >= 0.4 && < 0.5+ , scientific >= 0.3 && < 0.4+ , text >= 1.1.1.0 && < 1.3+ , unordered-containers >= 0.2 && < 0.3+ , vector >= 0.7+ default-language: Haskell2010+ ghc-options: -Wall -fno-warn-unused-do-bind++test-suite hslua-aeson-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: AesonSpec.hs+ build-depends: base+ , hspec >= 2.2+ , HUnit+ , QuickCheck+ , quickcheck-instances+ , aeson+ , hashable+ , hslua+ , hslua-aeson+ , ieee754+ , scientific+ , text+ , unordered-containers+ , vector+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/tarleb/hslua-aeson
+ src/Scripting/Lua/Aeson.hs view
@@ -0,0 +1,169 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# 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++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
+ test/AesonSpec.hs view
@@ -0,0 +1,117 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+Copyright : © 2017 Albert Krewinkel+License : MIT++Tests for Aeson–Lua glue.+-}+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 Scripting.Lua.Aeson (StackValue, newstate)+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 ()+main = hspec spec++-- | Specifications for Attributes parsing functions.+spec :: Spec+spec = do+ 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 x)+ it "can be round-tripped through the stack and stays approximately equal" $+ property $ \x -> assertRoundtripApprox (x :: Scientific)+ describe "Text" $ do+ it "can be converted to a lua string" $ property $+ \x -> assert =<< luaTest "type(x) == 'string'" [("x", x::Text)]+ it "can be round-tripped through the stack" $ property $+ \x -> assertRoundtripEqual (x::Text)+ describe "Vector" $ do+ it "is converted to a lua table" $ property $+ \x -> assert =<< luaTest "type(x) == 'table'" [("x", x::Vector Bool)]+ it "can contain Bools and be round-tripped through the stack" $ property $+ \x -> assertRoundtripEqual (x::Vector Bool)+ it "can contain Texts and be round-tripped through the stack" $ property $+ \x -> assertRoundtripEqual (x::Vector Text)+ it "can contain Vector of Bools and be round-tripped through the stack" $ property $+ \x -> assertRoundtripEqual (x::(Vector (Vector Bool)))+ describe "HashMap" $ do+ it "is converted to a lua table" $ property $+ \x -> assert =<< luaTest "type(x) == 'table'" [("x", x::HashMap Text Bool)]+ it "can be round-tripped through the stack with Text keys and Bool values" $+ 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 $+ \x -> assertRoundtripEqual (x::Aeson.Value)++assertRoundtripApprox :: Scientific -> IO ()+assertRoundtripApprox x = do+ y <- roundtrip x+ let xdouble = toRealFloat x :: Double+ let ydouble = toRealFloat y :: Double+ assert (xdouble ~== ydouble)++assertRoundtripEqual :: (Show a, Eq a, StackValue 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+ 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++luaTest :: StackValue a => String -> [(String, a)] -> IO Bool+luaTest luaTestCode xs = do+ lua <- Lua.newstate+ forM_ xs $ \(var, value) ->+ Lua.push lua value *> Lua.setglobal lua var+ let luaScript = "function run() return (" ++ luaTestCode ++ ") end"+ Lua.openlibs lua+ _ <- Lua.loadstring lua luaScript "test script"+ Lua.call lua 0 0+ retval <- Lua.callfunc lua "run"+ Lua.close lua+ return retval++luaNumberToScientific :: Lua.LuaNumber -> Scientific+luaNumberToScientific = fromFloatDigits++instance Arbitrary Aeson.Value where+ arbitrary = arbitraryValue 7++arbitraryValue :: Int -> Gen Aeson.Value+arbitraryValue size = frequency $+ [ (1, return Aeson.Null)+ , (4, Aeson.Bool <$> arbitrary)+ , (4, Aeson.Number . luaNumberToScientific <$> arbitrary)+ , (4, Aeson.String <$> arbitrary)+ , (2, resize (size - 1) $ Aeson.Array <$> arbitrary)+ , (2, resize (size - 1) $ Aeson.Object <$> arbitrary)+ ]