hslua-aeson-2.3.0.1/0000755000000000000000000000000007346545000012263 5ustar0000000000000000hslua-aeson-2.3.0.1/CHANGELOG.md0000644000000000000000000001004107346545000014070 0ustar0000000000000000# Changelog `hslua-aeson` uses [PVP Versioning][]. ## hslua-aeson-2.3.0.1 Released 2023-03-13. - Relax upper bound for hslua-marshalling, allow version 2.3. ## hslua-aeson-2.3.0 Released 2023-02-21. - The `peekValue` peeker now checks for a `__toaeson` metafield or `__tojson` metamethod and uses them to compute the `Value` of an object: The `__toaeson` metafield, if set, must be a function pushed via `pushToAeson`. That function is called on a given object, and the returned *Value* becomes the result of calling `peekValue`. Likewise, the `__tojson` metamethod must be a function that returns a valid JSON string. The result in that case is the decoded string. If both, `__toaeson` and `__tojson` are set, then `__toaeson` takes precedent. - The test suite now has *tasty-hunit* as an additional dependency. ## hslua-aeson-2.2.1 Released 2022-06-23. - Export `jsonarray`, which is the name of the registry slot holding the metatable given to array tables. Setting the corresponding registry value will affect all newly created array values. ## hslua-aeson-2.2.0.1 Released 2022-06-16. - Relaxed upper bound for mtl, allowing mtl-2.3. - Relaxed upper bound for aeson, allowing aeson-2.1. ## hslua-aeson-2.2.0 Released 2022-02-19. - Relaxed upper bound for hslua-core and hslua-marshalling, allowing version 2.2 of both packages. ## hslua-aeson-2.1.0 Released 2022-01-29. - Update to hslua 2.1. - Encode `null` as light userdata: The `NULL` pointer wrapped into a light userdata is used to encode the JSON null value. The `pushNull` function has been removed; use `pushValue Null` instead. - Types that are instances of `ToJSON` and `FromJSON` can be marshalled/unmarshalled by using the new functions `pushViaJSON` and `peekViaJSON`, respectively. - The functions `peekVector`, `pushVector`, `peekScientific`, `pushScientific`, `peekKeyMap`, and `pushKeyMap` are considered an implementation detail and are no longer exported. - Array elements are now marked with a metatable. This avoids the need for an extra `0` element in the table and offers flexibility for users who want to give special behavior to lists. The newly exported value `jsonarray` contains the name of the registry slot under which the metatable is stored. The table can be modified or replaced as required. ## hslua-aeson-2.0.1 Released 2021-12-28. - Restored compatibility with aeson 1.5. ## hslua-aeson-2.0.0 Released 2021-12-17. - Changed module name from `Foreign.Lua.Aeson` to `HsLua.Aeson`. - The Peekable and Pushable instances have been removed. The package no longer defines orphaned instances. - Updated hslua and aeson to the respective 2.0 version. ## hslua-aeson-1.0.3.1 Released 2020-10-16. - Allow hslua-1.3.\*. ## hslua-aeson-1.0.3 Released 2020-08-15. - Relaxed version constraint for hslua, allowing `hslua-1.2.*`. ## hslua-aeson-1.0.2 Released 2020-05-28 - Relaxed version constraint for aeson, allowing `aeson-1.5.*`. - Update CI tests to check with GHC versions 8.0 through 8.10. Compilation with GHC 7.10 is no longer tested. - Bump to stackage LTS-14. ## hslua-aeson-1.0.1 Released 2020-04-03 - Relax version constraint for packages hashable and hslua, allow `hashable-1.3` and `hslua-1.1.*`. ## hslua-aeson-1.0.0 Released 2019-09-24. - 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" ## hslua-aeson-0.3.0 Released 2017-08-18. - Update to hslua 0.8.0. ## hslua-aeson-0.2.0 Not publicly released. - Update to hslua 0.6.0. ## hslua-aeson-0.1.0.4 Released 2017-04-17. - Ensure compatibility with hslua 0.5.0. ## hslua-aeson-0.1.0.0 Released 2017-02-03. - Initial release. [PVP Versioning]: https://pvp.haskell.org hslua-aeson-2.3.0.1/LICENSE0000644000000000000000000000205307346545000013270 0ustar0000000000000000Copyright © 2017–2023 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. hslua-aeson-2.3.0.1/README.md0000644000000000000000000000156607346545000013552 0ustar0000000000000000hslua-aeson =========== [![MIT License]](./LICENSE) Pushes and retrieves aeson `Value`s to and from the Lua stack. - `Null` values are encoded as light userdata containing the @NULL@ pointer. - Objects are converted to string-indexed tables. - Arrays are converted to sequence tables and are given a metatable. This makes it possible to distinguish between empty arrays and empty objects. The metatable is stored in the registry under key `HsLua JSON array`. - JSON numbers are converted to Lua numbers, i.e., `Lua.Number`; the exact C type may vary, depending on compile-time Lua configuration. License ------- This project is licensed under the MIT license, the same license under which hslua and lua itself are published. See the [LICENSE](./LICENSE) file for details. [MIT License]: https://img.shields.io/github/license/hslua/hslua-aeson.svg?style=flat-square hslua-aeson-2.3.0.1/hslua-aeson.cabal0000644000000000000000000000621307346545000015470 0ustar0000000000000000cabal-version: 2.2 name: hslua-aeson version: 2.3.0.1 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://hslua.org/ license: MIT license-file: LICENSE author: Albert Krewinkel maintainer: Albert Krewinkel copyright: © 2017–2023 Albert Krewinkel category: Foreign extra-source-files: README.md , CHANGELOG.md tested-with: GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.7 , GHC == 9.0.2 , GHC == 9.2.5 , GHC == 9.4.4 source-repository head type: git location: https://github.com/hslua/hslua subdir: hslua-aeson common common-options default-language: Haskell2010 build-depends: base >= 4.11 && < 5 , aeson >= 1.5 && < 2.2 , bytestring >= 0.10.2 && < 0.12 , containers >= 0.5.9 && < 0.7 , hashable >= 1.2 && < 1.5 , hslua-core >= 2.0 && < 2.4 , hslua-marshalling >= 2.1 && < 2.4 , mtl >= 2.2 && < 2.4 , scientific >= 0.3 && < 0.4 , unordered-containers >= 0.2 && < 0.3 , text >= 1.2 && < 2.1 , vector >= 0.7 default-extensions: BangPatterns , CPP , LambdaCase , OverloadedStrings , TypeApplications ghc-options: -Wall -Wincomplete-record-updates -Wnoncanonical-monad-instances -Wredundant-constraints if impl(ghc >= 8.2) ghc-options: -Wcpp-undef -Werror=missing-home-modules if impl(ghc >= 8.4) ghc-options: -Widentities -Wincomplete-uni-patterns -Wpartial-fields -fhide-source-paths library import: common-options exposed-modules: HsLua.Aeson hs-source-dirs: src build-depends: base >= 4.7 && < 5 default-language: Haskell2010 test-suite test-hslua-aeson import: common-options type: exitcode-stdio-1.0 main-is: test-hslua-aeson.hs hs-source-dirs: test build-depends: hslua-aeson , QuickCheck , quickcheck-instances , tasty >= 0.11 , tasty-quickcheck >= 0.8 , tasty-hunit >= 0.10 ghc-options: -threaded default-language: Haskell2010 hslua-aeson-2.3.0.1/src/HsLua/0000755000000000000000000000000007346545000014066 5ustar0000000000000000hslua-aeson-2.3.0.1/src/HsLua/Aeson.hs0000644000000000000000000001372707346545000015501 0ustar0000000000000000{-| Module : HsLua.Aeson Copyright : © 2017-2023 Albert Krewinkel License : MIT Maintainer : Albert Krewinkel Pushes and retrieves aeson `Value`s to and from the Lua stack. - JSON @null@ values are encoded as light userdata containing the @NULL@ pointer. - Objects are converted to string-indexed tables. - Arrays are converted to sequence tables and are given a metatable. This makes it possible to distinguish between empty arrays and empty objects. The metatable is stored in the registry under key @\'HsLua JSON array\'@' (see also 'jsonarray'). - JSON numbers are converted to Lua numbers, i.e., 'Lua.Number'; the exact C type may vary, depending on compile-time Lua configuration. -} module HsLua.Aeson ( peekValue , pushValue , peekViaJSON , pushViaJSON , jsonarray -- * Encoding arbitrary objects , peekToAeson , pushToAeson ) where import Control.Applicative ((<|>)) import Control.Monad ((<$!>), void) import Data.Scientific (toRealFloat, fromFloatDigits) import Foreign.Ptr (nullPtr) import HsLua.Core as Lua import HsLua.Marshalling as Lua import qualified Data.Aeson as Aeson import qualified Data.ByteString as B import qualified Data.Vector as Vector import qualified HsLua.Core.Utf8 as UTF8 #if MIN_VERSION_aeson(2,0,0) import Data.Aeson.Key (toText, fromText) import qualified Data.Aeson.KeyMap as KeyMap #else import Data.Text (Text) import qualified Data.HashMap.Strict as KeyMap toText, fromText :: Text -> Text toText = id fromText = id #endif -- | Hslua StackValue instance for the Aeson Value data type. pushValue :: LuaError e => Pusher e Aeson.Value pushValue val = do checkstack' 1 "HsLua.Aeson.pushValue" case val of Aeson.Object o -> pushKeyValuePairs pushKey pushValue $ KeyMap.toList o Aeson.Number n -> pushRealFloat @Double $ toRealFloat n Aeson.String s -> pushText s Aeson.Array a -> pushArray a Aeson.Bool b -> pushBool b Aeson.Null -> pushlightuserdata nullPtr where pushKey = pushText . toText pushArray x = do checkstack' 4 "HsLua.Aeson.pushVector" pushList pushValue $ Vector.toList x void $ newmetatable jsonarray setmetatable (nth 2) -- | Name of the registry slot holding the metatable given to -- array tables. The registry entry can be replaced with a -- different table if needed. jsonarray :: Name jsonarray = "HsLua JSON array" -- | Retrieves an Aeson 'Aeson.Value' from the Lua stack. peekValue :: LuaError e => Peeker e Aeson.Value peekValue idx = liftLua (ltype idx) >>= \case TypeBoolean -> Aeson.Bool <$!> peekBool idx TypeNumber -> Aeson.Number . fromFloatDigits <$!> peekRealFloat @Double idx TypeString -> Aeson.String <$!> peekText idx TypeLightUserdata -> liftLua (touserdata idx) >>= \case -- must be the null pointer Nothing -> pure Aeson.Null _ -> typeMismatchMessage "null" idx >>= failPeek TypeNil -> return Aeson.Null TypeTable -> peekValueViaMetatable idx <|> do liftLua $ checkstack' 2 "HsLua.Aeson.peekValue" let peekKey = fmap fromText . peekText peekArray = Aeson.Array . Vector.fromList <$!> (retrieving "vector" $! peekList peekValue idx) isarray = getmetatable idx >>= \case False -> -- check for nonempty sequence (/= TypeNil) <$> rawgeti idx 1 <* pop 1 True -> getmetatable' jsonarray >>= \case TypeTable -> rawequal (nth 1) (nth 2) <* pop 2 _ -> pure False liftLua isarray >>= \case True -> peekArray False -> Aeson.Object . KeyMap.fromList <$!> peekKeyValuePairs peekKey peekValue idx _ -> peekValueViaMetatable idx -- -- Peek via __toaeson metamethod -- -- | Retrieves a JSON value by using special metafields or metamethods. peekValueViaMetatable :: LuaError e => Peeker e Aeson.Value peekValueViaMetatable idx = peekValueViaToaeson idx <|> peekValueViaTojson idx -- | Retrieves a JSON value by calling an object's @__toaeson@ -- metamethod. peekValueViaToaeson :: Peeker e Aeson.Value peekValueViaToaeson idx = do absidx <- liftLua (absindex idx) liftLua (getmetafield absidx "__toaeson") >>= \case TypeNil -> failPeek "Object does not have a `__toaeson` metavalue." _ -> do fn <- peekToAeson top `lastly` pop 1 fn absidx peekValueViaTojson :: LuaError e => Peeker e Aeson.Value peekValueViaTojson idx = do absidx <- liftLua $ absindex idx liftLua (getmetafield absidx "__tojson") >>= \case TypeNil -> failPeek "Object does not have a `__tojson` metamethod." _ -> do -- Try to use the field value as function liftLua $ do pushvalue absidx call 1 1 json <- peekLazyByteString top `lastly` pop 1 maybe (failPeek "Could not decode string") pure $ Aeson.decode json -- | Type for the function that gets an Aeson value from a Lua object. type ToAeson e = Peeker e Aeson.Value -- | Lua type name for 'ToAeson' values. typeNameToAeson :: Name typeNameToAeson = "HsLua.ToAeson" -- | Pushes a function that converts the object at a given index into a -- 'Aeson.Value'. pushToAeson :: Pusher e (ToAeson e) pushToAeson val = do newhsuserdatauv val 0 _ <- newudmetatable typeNameToAeson setmetatable (nth 2) -- | Gets the 'ToAeson' function from a Lua userdata object. peekToAeson :: Peeker e (ToAeson e) peekToAeson idx = liftLua (fromuserdata idx typeNameToAeson) >>= \case Nothing -> typeMismatchMessage typeNameToAeson idx >>= failPeek Just ta -> return ta -- -- Retrieving any value via JSON -- -- | Retrieves a value from the Lua stack via JSON. peekViaJSON :: (Aeson.FromJSON a, LuaError e) => Peeker e a peekViaJSON idx = do value <- peekValue idx case Aeson.fromJSON value of Aeson.Success x -> pure x Aeson.Error msg -> failPeek $ "failed to decode: " `B.append` UTF8.fromString msg -- | Pushes a value to the Lua stack as a JSON-like value. pushViaJSON :: (Aeson.ToJSON a, LuaError e) => Pusher e a pushViaJSON = pushValue . Aeson.toJSON hslua-aeson-2.3.0.1/test/0000755000000000000000000000000007346545000013242 5ustar0000000000000000hslua-aeson-2.3.0.1/test/test-hslua-aeson.hs0000644000000000000000000001337207346545000017000 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Copyright : © 2017-2023 Albert Krewinkel License : MIT Tests for Aeson–Lua glue. -} import Control.Monad (when) import Data.Aeson (ToJSON, object, (.=)) import Data.Text (Text) import HsLua.Core as Lua import HsLua.Marshalling import HsLua.Aeson import Test.QuickCheck.Monadic (assert) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit ((@?=), testCase) import Test.Tasty.QuickCheck import Test.QuickCheck.Instances () import qualified Data.Aeson as Aeson import qualified Data.Vector as Vector import qualified Test.QuickCheck.Monadic as QC #if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.KeyMap as KeyMap #if !MIN_VERSION_aeson(2,0,3) import Data.Aeson.Key (Key, fromText) import Data.Scientific (Scientific, fromFloatDigits) #endif #else import Data.Scientific (Scientific, fromFloatDigits) import qualified Data.HashMap.Strict as KeyMap #endif -- | Run this spec. main :: IO () main = defaultMain tests -- | Aeson tests tests :: TestTree tests = testGroup "hslua-aeson" [ testGroup "Value" [ testProperty "can be round-tripped through the stack" $ assertRoundtripEqual pushValue peekValue , testProperty "can roundtrip a bool nested in 50 layers of arrays" $ \b -> QC.monadicIO $ do let go _ x = Aeson.Array $ Vector.fromList [x] mkValue a = foldr go (Aeson.Bool a) [(1::Int) .. 50] x <- QC.run . run @Lua.Exception $ do pushValue $ mkValue b forcePeek $ peekValue top return (x === mkValue b) , testProperty "can roundtrip a bool nested in 50 layers of objects" $ \b -> QC.monadicIO $ do let go _ x = Aeson.Object $ KeyMap.fromList [("x", x)] mkValue a = foldr go (Aeson.Bool a) [(1::Int) .. 50] x <- QC.run . run @Lua.Exception $ do pushValue $ mkValue b forcePeek $ peekValue top return (x === mkValue b) , testProperty "can roundtrip a null nested in 50 layers of objects" $ \() -> QC.monadicIO $ do let go _ x = Aeson.Object $ KeyMap.fromList [("x", x)] mkValue = foldr go Aeson.Null [(1::Int) .. 50] x <- QC.run . run @Lua.Exception $ do pushValue mkValue forcePeek $ peekValue top return (x === mkValue) ] , testGroup "via JSON" [ testProperty "can roundtrip 'Maybe Text' via JSON" $ assertRoundtripEqual @(Maybe Int) pushViaJSON peekViaJSON , testProperty "can roundtrip '(Int, Float)' via JSON" $ assertRoundtripEqual @(Int, Float) pushViaJSON peekViaJSON , testProperty "can roundtrip 'Either Bool Text' via JSON" $ assertRoundtripEqual @(Either Bool Text) pushViaJSON peekViaJSON ] , testGroup "special encodings" [ testGroup "__toaeson" [ testCase "respect __toaeson metamethod" . run @Lua.Exception $ do pushTwentyThree TwentyThree val <- forcePeek $ peekValue top liftIO $ object [ "title" .= (23 :: Int) ] @?= val ] , testGroup "__tojson" [ testCase "respect __tojson metamethod" . run @Lua.Exception $ do newtable -- object newtable -- metatable pushHaskellFunction (1 <$ pushText "{\"answer\": 42}") setfield (nth 2) "__tojson" setmetatable (nth 2) val <- forcePeek $ peekValue top liftIO $ object [ "answer" .= (42 :: Int) ] @?= val ] ] ] assertRoundtripEqual :: Eq a => Pusher Lua.Exception a -> Peeker Lua.Exception a -> a -> Property assertRoundtripEqual pushX peekX x = QC.monadicIO $ do y <- QC.run $ roundtrip pushX peekX x assert (x == y) roundtrip :: Pusher Lua.Exception a -> Peeker Lua.Exception a -> a -> IO a roundtrip pushX peekX x = run $ do pushX x size <- gettop when (size /= 1) $ failLua $ "not the right amount of elements on the stack: " ++ show size result <- forcePeek $ peekX top afterPeekSize <- gettop when (afterPeekSize /= 1) $ failLua $ "peeking modified the stack: " ++ show afterPeekSize return result -- aeson defines instances for Arbitrary since 2.0.3.0 #if !MIN_VERSION_aeson(2,0,3) luaNumberToScientific :: Lua.Number -> Scientific luaNumberToScientific = fromFloatDigits . (realToFrac :: Lua.Number -> Double) instance Arbitrary Aeson.Value where arbitrary = arbitraryValue 9 #if MIN_VERSION_aeson(2,0,0) instance Arbitrary Key where arbitrary = fmap fromText arbitrary instance Arbitrary a => Arbitrary (KeyMap.KeyMap a) where arbitrary = fmap KeyMap.fromList arbitrary #endif arbitraryValue :: Int -> Gen Aeson.Value arbitraryValue size = frequency [ (1, return Aeson.Null) , (4, Aeson.Bool <$> arbitrary) -- Note: we don't draw numbers from the whole possible range, but -- only from the range of numbers that Lua can handle without -- rounding errors. This is ok, as JSON doesn't define a required -- precision, and (usually) matches the behavior of JavaScript. , (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) ] #endif -- -- Type for __toaeson tests -- -- | Example type with custom JSON encoding. data TwentyThree = TwentyThree instance ToJSON TwentyThree where toJSON _ = object [ "title" .= (23 :: Int) ] peekTwentyThree :: Peeker e TwentyThree peekTwentyThree = reportValueOnFailure "TwentyThree" (`Lua.fromuserdata` "TwentyThree") pushTwentyThree :: LuaError e => Pusher e TwentyThree pushTwentyThree _ = do Lua.newhsuserdatauv TwentyThree 0 created <- Lua.newudmetatable "TwentyThree" when created $ do pushToAeson (fmap Aeson.toJSON . peekTwentyThree) setfield (nth 2) "__toaeson" setmetatable (nth 2)