hslua-aeson 2.2.1 → 2.3.0

raw patch · 5 files changed

+144/−10 lines, 5 filesdep +tasty-hunitdep ~hslua-corePVP ok

version bump matches the API change (PVP)

Dependencies added: tasty-hunit

Dependency ranges changed: hslua-core

API changes (from Hackage documentation)

Files

• CHANGELOG.md +23/−0
• LICENSE +1/−1
• hslua-aeson.cabal +7/−7
• src/HsLua/Aeson.hs +65/−2
• test/test-hslua-aeson.hs +48/−0

@@ -2,6 +2,29 @@  `hslua-aeson` uses [PVP Versioning][]. +## hslua-aeson-2.3.0++Release pending.++-   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.

@@ -1,4 +1,4 @@-Copyright © 2017–2019 Albert Krewinkel+Copyright © 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

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                hslua-aeson-version:             2.2.1+version:             2.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.@@ -9,18 +9,17 @@ license-file:        LICENSE author:              Albert Krewinkel maintainer:          Albert Krewinkel <albert+hslua@zeitkraut.de>-copyright:           © 2017–2022 Albert Krewinkel+copyright:           © 2017–2023 Albert Krewinkel category:            Foreign extra-source-files:  README.md                    , CHANGELOG.md-tested-with:         GHC == 8.0.2-                   , GHC == 8.2.2-                   , GHC == 8.4.4+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.3+                   , GHC == 9.2.5+                   , GHC == 9.4.4  source-repository head   type:                git@@ -34,7 +33,7 @@                      , bytestring           >= 0.10.2 && < 0.12                      , containers           >= 0.5.9  && < 0.7                      , hashable             >= 1.2    && < 1.5-                     , hslua-core           >= 2.0    && < 2.3+                     , hslua-core           >= 2.0    && < 2.4                      , hslua-marshalling    >= 2.1    && < 2.3                      , mtl                  >= 2.2    && < 2.4                      , scientific           >= 0.3    && < 0.4@@ -76,5 +75,6 @@                      , quickcheck-instances                      , tasty                >= 0.11                      , tasty-quickcheck     >= 0.8+                     , tasty-hunit          >= 0.10   ghc-options:         -threaded   default-language:    Haskell2010

@@ -27,8 +27,12 @@   , 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)@@ -88,7 +92,7 @@     Nothing -> pure Aeson.Null     _       -> typeMismatchMessage "null" idx >>= failPeek   TypeNil -> return Aeson.Null-  TypeTable -> do+  TypeTable -> peekValueViaMetatable idx <|> do       liftLua $ checkstack' 2 "HsLua.Aeson.peekValue"       let peekKey = fmap fromText . peekText           peekArray = Aeson.Array . Vector.fromList <$!>@@ -104,7 +108,66 @@         True  -> peekArray         False -> Aeson.Object . KeyMap.fromList <$!>                  peekKeyValuePairs peekKey peekValue idx-  luaType -> fail ("Unexpected type: " ++ show luaType)+  _ -> 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

@@ -6,12 +6,14 @@ 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 () @@ -75,6 +77,27 @@     , 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@@ -126,3 +149,28 @@     , (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)