Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-hslua-marshalling for
openSUSE:Factory checked in at 2022-02-11 23:09:05
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-hslua-marshalling (Old)
and /work/SRC/openSUSE:Factory/.ghc-hslua-marshalling.new.1956 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-hslua-marshalling"
Fri Feb 11 23:09:05 2022 rev:2 rq:953475 version:2.1.0
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-hslua-marshalling/ghc-hslua-marshalling.changes
2021-11-11 21:37:50.124950501 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-hslua-marshalling.new.1956/ghc-hslua-marshalling.changes
2022-02-11 23:10:58.903218807 +0100
@@ -1,0 +2,9 @@
+Sat Jan 29 10:07:54 UTC 2022 - Peter Simons <[email protected]>
+
+- Update hslua-marshalling to version 2.1.0.
+ Upstream has edited the change log file since the last release in
+ a non-trivial way, i.e. they did more than just add a new entry
+ at the top. You can review the file at:
+ http://hackage.haskell.org/package/hslua-marshalling-2.1.0/src/CHANGELOG.md
+
+-------------------------------------------------------------------
Old:
----
hslua-marshalling-2.0.1.tar.gz
New:
----
hslua-marshalling-2.1.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-hslua-marshalling.spec ++++++
--- /var/tmp/diff_new_pack.OOFAtz/_old 2022-02-11 23:10:59.323220022 +0100
+++ /var/tmp/diff_new_pack.OOFAtz/_new 2022-02-11 23:10:59.327220033 +0100
@@ -1,7 +1,7 @@
#
# spec file for package ghc-hslua-marshalling
#
-# Copyright (c) 2021 SUSE LLC
+# Copyright (c) 2022 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,7 +19,7 @@
%global pkg_name hslua-marshalling
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.0.1
+Version: 2.1.0
Release: 0
Summary: Marshalling of values between Haskell and Lua
License: MIT
++++++ hslua-marshalling-2.0.1.tar.gz -> hslua-marshalling-2.1.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-marshalling-2.0.1/CHANGELOG.md
new/hslua-marshalling-2.1.0/CHANGELOG.md
--- old/hslua-marshalling-2.0.1/CHANGELOG.md 2001-09-09 03:46:40.000000000
+0200
+++ new/hslua-marshalling-2.1.0/CHANGELOG.md 2001-09-09 03:46:40.000000000
+0200
@@ -1,24 +1,57 @@
-## Changelog
+# Changelog
-`hslua-marshalling` uses [PVP Versioning](https://pvp.haskell.org).
+`hslua-marshalling` uses [PVP Versioning][].
-### hslua-marshalling 2.0.1
+## hslua-marshalling-2.1.0
+
+Released 29-01-2022.
+
+- Updated to hslua-core-2.1.0.
+
+- The `Success` constructor of the `Result` type is now strict;
+ the `Failure` constructor remains lazy.
+
+- The stack is checked before pushing or retrieving nested
+ structures: Pushing or peeking a deeply nested structure could
+ lead an overflow of the Lua stack. The functions `pushList`,
+ `pushSet`, and `pushKeyValuePairs`, as well as `peekList`,
+ `peekSet`, and `peekKeyValuePairs` now check that sufficient
+ stack space is available before pushing another value to the
+ stack.
+
+- The function `toByteString` now requires a slot on the stack
+ if the value at the given index is a number. It checks for
+ available space before pushing to the stack, returning
+ `Nothing` if no space is left on the stack.
+
+- The `withContext` function is made more useful and now
+ differs from `retrieving`. The string ???retrieving??? is added
+ to the error context by `retrieving`, so `withContext` allows
+ to define contexts without this prefix.
+
+- New convenience function `pushAsTable`, making it easier to
+ define a pusher function for values marshaled as tables.
+
+## hslua-marshalling-2.0.1
Released 2021-11-04.
- - Allow `pushIterator` to skip values: If the function that
- pushes the values of a list item signals that it didn't push any
- values, then that value will be skipped.
+- Allow `pushIterator` to skip values: If the function that
+ pushes the values of a list item signals that it didn???t push
+ any values, then that value will be skipped.
-### hslua-marshalling 2.0.0
+## hslua-marshalling-2.0.0
Released 2021-10-21.
-- Initially created. Contains modules previously found in the
- modules `Foreign.Lua.Peek` and `Foreign.Lua.Push` from
- `hslua-1.3`.
-
-- Removed most functions from the Userdata module, incl. peekAny,
- pushAny. The functions don't add much value over those in
- `HsLua.Core.Userdata`. Use UDTypes from hslua-packaging for a
- more comfortable method of exposing data via userdata values.
+- Initially created. Contains modules previously found in the
+ modules `Foreign.Lua.Peek` and `Foreign.Lua.Push` from
+ `hslua-1.3`.
+
+- Removed most functions from the Userdata module,
+ incl.??peekAny, pushAny. The functions don???t add much value
+ over those in `HsLua.Core.Userdata`. Use UDTypes from
+ hslua-packaging for a more comfortable method of exposing data
+ via userdata values.
+
+ [PVP Versioning]: https://pvp.haskell.org
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-marshalling-2.0.1/LICENSE
new/hslua-marshalling-2.1.0/LICENSE
--- old/hslua-marshalling-2.0.1/LICENSE 2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-marshalling-2.1.0/LICENSE 2001-09-09 03:46:40.000000000 +0200
@@ -1,7 +1,7 @@
Copyright ?? 1994-2020 Lua.org, PUC-Rio.
Copyright ?? 2007-2012 Gracjan Polak
Copyright ?? 2012-2015 ??mer Sinan A??acan
-Copyright ?? 2016-2021 Albert Krewinkel
+Copyright ?? 2016-2022 Albert Krewinkel
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-marshalling-2.0.1/hslua-marshalling.cabal
new/hslua-marshalling-2.1.0/hslua-marshalling.cabal
--- old/hslua-marshalling-2.0.1/hslua-marshalling.cabal 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-marshalling-2.1.0/hslua-marshalling.cabal 2001-09-09
03:46:40.000000000 +0200
@@ -1,6 +1,6 @@
cabal-version: 2.2
name: hslua-marshalling
-version: 2.0.1
+version: 2.1.0
synopsis: Marshalling of values between Haskell and Lua.
description: Provides functions to marshal values from Haskell
to Lua, and /vice versa/.
@@ -16,7 +16,7 @@
maintainer: [email protected]
copyright: ?? 2007???2012 Gracjan Polak;
?? 2012???2016 ??mer Sinan A??acan;
- ?? 2017-2021 Albert Krewinkel
+ ?? 2017-2022 Albert Krewinkel
category: Foreign
extra-source-files: README.md
, CHANGELOG.md
@@ -25,8 +25,9 @@
, GHC == 8.4.4
, GHC == 8.6.5
, GHC == 8.8.4
- , GHC == 8.10.4
+ , GHC == 8.10.7
, GHC == 9.0.1
+ , GHC == 9.2.1
source-repository head
type: git
@@ -38,9 +39,9 @@
build-depends: base >= 4.8 && < 5
, bytestring >= 0.10.2 && < 0.12
, containers >= 0.5.9 && < 0.7
- , hslua-core >= 2.0 && < 2.1
+ , hslua-core >= 2.0 && < 2.2
, mtl >= 2.2 && < 2.3
- , text >= 1.0 && < 1.3
+ , text >= 1.2 && < 2.1
ghc-options: -Wall
-Wincomplete-record-updates
-Wnoncanonical-monad-instances
@@ -63,6 +64,7 @@
, HsLua.Marshalling.Userdata
hs-source-dirs: src
default-extensions: LambdaCase
+ , StrictData
other-extensions: DeriveDataTypeable
, DeriveFunctor
, OverloadedStrings
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-marshalling-2.0.1/src/HsLua/Marshalling/Peek.hs
new/hslua-marshalling-2.1.0/src/HsLua/Marshalling/Peek.hs
--- old/hslua-marshalling-2.0.1/src/HsLua/Marshalling/Peek.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-marshalling-2.1.0/src/HsLua/Marshalling/Peek.hs 2001-09-09
03:46:40.000000000 +0200
@@ -4,7 +4,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module : HsLua.Marshalling.Peek
-Copyright : ?? 2020-2021 Albert Krewinkel
+Copyright : ?? 2020-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
Stability : beta
@@ -40,20 +40,23 @@
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail (..))
#endif
+#if !MIN_VERSION_base(4,12,0)
+import Data.Semigroup (Semigroup ((<>)))
+#endif
import qualified HsLua.Core.Utf8 as Utf8
-- | Record to keep track of failure contexts while retrieving objects
-- from the Lua stack.
data Result a
- = Success a
+ = Success !a
| Failure ByteString [Name] -- ^ Error message and stack of contexts
deriving (Show, Eq, Functor)
instance Applicative Result where
pure = Success
{-# INLINE pure #-}
- Success f <*> s = fmap f s
- Failure msg stack <*> _ = Failure msg stack
+ Success f <*> s = f <$!> s
+ Failure msg stack <*> _ = Failure msg stack
{-# INLINE (<*>) #-}
instance Monad Result where
@@ -133,7 +136,7 @@
-- | Runs the peek action and Lua action in sequence, even if the peek
-- action fails.
lastly :: Peek e a -> LuaE e b -> Peek e a
-lastly p after = Peek $ runPeek p <* after
+lastly p after = Peek $! runPeek p <* after
{-# INLINABLE lastly #-}
-- | Runs the peek action, resetting the stack top afterwards. This can
@@ -155,7 +158,7 @@
-- | Combines the peek failure components into a reportable string.
formatPeekFailure :: ByteString -> [Name] -> String
formatPeekFailure msg stack =
- intercalate "\n\twhile retrieving " $
+ intercalate "\n\twhile " $
map Utf8.toString (msg : map fromName (reverse stack))
-- | Function to retrieve a value from Lua's stack.
@@ -180,7 +183,7 @@
retrieving :: Name
-> Peek e a
-> Peek e a
-retrieving = withContext
+retrieving = withContext . ("retrieving " <>)
{-# INLINE retrieving #-}
-- | Force creation of an unwrapped result, throwing an exception if
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-marshalling-2.0.1/src/HsLua/Marshalling/Peekers.hs
new/hslua-marshalling-2.1.0/src/HsLua/Marshalling/Peekers.hs
--- old/hslua-marshalling-2.0.1/src/HsLua/Marshalling/Peekers.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-marshalling-2.1.0/src/HsLua/Marshalling/Peekers.hs
2001-09-09 03:46:40.000000000 +0200
@@ -4,7 +4,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module : HsLua.Marshalling.Peekers
-Copyright : ?? 2020-2021 Albert Krewinkel
+Copyright : ?? 2020-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
Stability : beta
@@ -47,7 +47,7 @@
) where
import Control.Applicative (Alternative (..))
-import Control.Monad ((<$!>), (>=>))
+import Control.Monad ((<$!>), (>=>), void)
import Data.ByteString (ByteString)
import Data.Map (Map)
import Data.Set (Set)
@@ -133,11 +133,20 @@
-- | Like 'tostring', but ensures that the value at the given index is
-- not silently converted to a string, as would happen with numbers.
+-- Also returns 'Nothing' if the value is a number and there is no stack
+-- slot left on the Lua stack, which would be needed to convert the
+-- number to a string without changing the original slot.
toByteString :: StackIndex -> LuaE e (Maybe ByteString)
toByteString idx = do
- -- copy value, as tostring converts numbers to strings *in-place*.
- pushvalue idx
- tostring top <* pop 1
+ -- Do an explicit type check, as @tostring@ converts numbers strings
+ -- /in-place/, which we need to avoid.
+ ltype idx >>= \case
+ TypeString -> tostring idx
+ _ -> checkstack 1 >>= \case
+ False -> pure Nothing
+ True -> do
+ pushvalue idx
+ tostring top <* pop 1
{-# INLINABLE toByteString #-}
-- | Retrieves a 'ByteString' as a raw string.
@@ -219,6 +228,7 @@
peekList :: forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList peekElement = fmap (retrieving "list") .
typeChecked "table" istable $ \idx -> do
+ liftLua $ checkstack' 1 "retrieving a list"
let elementsAt [] = return []
elementsAt (i : is) = do
x <- retrieving ("index " <> showInt i) $
@@ -230,15 +240,18 @@
elementsAt [1..fromIntegral listLength]
-- | Retrieves a key-value Lua table as 'Map'.
-peekMap :: Ord a => Peeker e a -> Peeker e b -> Peeker e (Map a b)
+peekMap :: (LuaError e, Ord a)
+ => Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap keyPeeker valuePeeker = retrieving "Map"
. fmap Map.fromList
. peekKeyValuePairs keyPeeker valuePeeker
-- | Read a table into a list of pairs.
-peekKeyValuePairs :: Peeker e a -> Peeker e b -> Peeker e [(a, b)]
+peekKeyValuePairs :: LuaError e
+ => Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs keyPeeker valuePeeker =
typeChecked "table" istable $ \idx -> cleanup $ do
+ liftLua $ checkstack' 2 "retrieving key-value pairs"
idx' <- liftLua $ absindex idx
let remainingPairs = nextPair keyPeeker valuePeeker idx' >>= \case
Nothing -> return []
@@ -267,8 +280,8 @@
-- | Retrieves a 'Set' from an idiomatic Lua representation. A
-- set in Lua is idiomatically represented as a table with the
-- elements as keys. Elements with falsy values are omitted.
-peekSet :: Ord a => Peeker e a -> Peeker e (Set a)
-peekSet elementPeeker = withContext "Set"
+peekSet :: (LuaError e, Ord a) => Peeker e a -> Peeker e (Set a)
+peekSet elementPeeker = retrieving "Set"
. fmap (Set.fromList . map fst . filter snd)
. peekKeyValuePairs elementPeeker peekBool
@@ -281,9 +294,10 @@
peekFieldRaw peeker name idx =
retrieving ("raw field '" <> name <> "'") $! do
liftLua $ do
+ checkstack' 1 "peekFieldRaw"
absidx <- Lua.absindex idx
pushstring $ fromName name
- rawget absidx
+ void (rawget absidx)
peeker top `lastly` Lua.pop 1
{-# INLINABLE peekFieldRaw #-}
@@ -292,7 +306,7 @@
peekIndexRaw i peeker idx = do
let showInt (Lua.Integer x) = fromString $ show x
retrieving (fromString $ "raw index '" <> showInt i <> "'") $! do
- liftLua $ rawgeti idx i
+ liftLua . void $ rawgeti idx i
peeker top `lastly` Lua.pop 1
{-# INLINABLE peekIndexRaw #-}
@@ -302,6 +316,7 @@
=> Peeker e a -> Peeker e b
-> Peeker e (a, b)
peekPair peekA peekB idx = cleanup $ do
+ liftLua $ checkstack' 2 "retrieving a pair"
idx' <- liftLua $ absindex idx
a <- liftLua (rawgeti idx' 1) *> peekA top
b <- liftLua (rawgeti idx' 2) *> peekB top
@@ -313,6 +328,7 @@
=> Peeker e a -> Peeker e b -> Peeker e c
-> Peeker e (a, b, c)
peekTriple peekA peekB peekC idx = cleanup $ do
+ liftLua $ checkstack' 3 "retrieving a triple"
idx' <- liftLua $ absindex idx
a <- liftLua (rawgeti idx' 1) *> peekA top
b <- liftLua (rawgeti idx' 2) *> peekB top
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-marshalling-2.0.1/src/HsLua/Marshalling/Push.hs
new/hslua-marshalling-2.1.0/src/HsLua/Marshalling/Push.hs
--- old/hslua-marshalling-2.0.1/src/HsLua/Marshalling/Push.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-marshalling-2.1.0/src/HsLua/Marshalling/Push.hs 2001-09-09
03:46:40.000000000 +0200
@@ -1,6 +1,6 @@
{-|
Module : HsLua.Marshalling.Push
-Copyright : ?? 2020-2021 Albert Krewinkel
+Copyright : ?? 2020-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
Stability : beta
@@ -28,9 +28,10 @@
-- * Combinators
, pushPair
, pushTriple
+ , pushAsTable
) where
-import Control.Monad (zipWithM_)
+import Control.Monad (forM_, zipWithM_)
import Data.ByteString (ByteString)
import Data.Map (Map, toList)
import Data.Set (Set)
@@ -97,17 +98,21 @@
-- | Push list of pairs as default key-value Lua table.
pushKeyValuePairs :: LuaError e
=> Pusher e a -> Pusher e b -> Pusher e [(a,b)]
-pushKeyValuePairs pushKey pushValue m = do
- let addValue (k, v) = pushKey k *> pushValue v *> rawset (-3)
- newtable
- mapM_ addValue m
+pushKeyValuePairs pushKey pushValue m = checkstack 3 >>= \case
+ False -> failLua "stack overflow while pushing key-value pairs"
+ True -> do
+ let addValue (k, v) = pushKey k *> pushValue v *> rawset (-3)
+ newtable
+ mapM_ addValue m
-- | Push list as numerically indexed table.
pushList :: LuaError e => Pusher e a -> [a] -> LuaE e ()
-pushList push xs = do
- let setField i x = push x *> rawseti (-2) i
- newtable
- zipWithM_ setField [1..] xs
+pushList push xs = checkstack 2 >>= \case
+ False -> failLua "stack overflow while pushing a list"
+ True -> do
+ let setField i x = push x *> rawseti (-2) i
+ newtable
+ zipWithM_ setField [1..] xs
-- | Push 'Map' as default key-value Lua table.
pushMap :: LuaError e => Pusher e a -> Pusher e b -> Pusher e (Map a b)
@@ -116,14 +121,27 @@
-- | Push a 'Set' as idiomatic Lua set, i.e., as a table with the set
-- elements as keys and @true@ as values.
pushSet :: LuaError e => Pusher e a -> Pusher e (Set a)
-pushSet pushElement set = do
- let addItem item = pushElement item *> pushboolean True *> rawset (-3)
- newtable
- mapM_ addItem set
+pushSet pushElement set = checkstack 3 >>= \case
+ False -> failLua "stack overflow while pushing a set"
+ True -> do
+ let addItem item = pushElement item *> pushboolean True *> rawset (-3)
+ newtable
+ mapM_ addItem set
--
-- Combinators
--
+-- | Pushes an object as a table, defined by a list of
+-- field-names/push-function pairs.
+pushAsTable :: LuaError e
+ => [(Name, a -> LuaE e ())]
+ -> a -> LuaE e ()
+pushAsTable props obj = do
+ createtable 0 (length props)
+ forM_ props $ \(name, pushValue) -> do
+ pushName name
+ pushValue obj
+ rawset (nth 3)
-- | Pushes a pair of values as a two element list.
pushPair :: LuaError e
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-marshalling-2.0.1/src/HsLua/Marshalling/Userdata.hs
new/hslua-marshalling-2.1.0/src/HsLua/Marshalling/Userdata.hs
--- old/hslua-marshalling-2.0.1/src/HsLua/Marshalling/Userdata.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-marshalling-2.1.0/src/HsLua/Marshalling/Userdata.hs
2001-09-09 03:46:40.000000000 +0200
@@ -5,7 +5,7 @@
Module : HsLua.Marshalling.Userdata
Copyright : ?? 2007???2012 Gracjan Polak;
?? 2012???2016 ??mer Sinan A??acan;
- ?? 2017-2021 Albert Krewinkel
+ ?? 2017-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
Stability : beta
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-marshalling-2.0.1/src/HsLua/Marshalling.hs
new/hslua-marshalling-2.1.0/src/HsLua/Marshalling.hs
--- old/hslua-marshalling-2.0.1/src/HsLua/Marshalling.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-marshalling-2.1.0/src/HsLua/Marshalling.hs 2001-09-09
03:46:40.000000000 +0200
@@ -2,7 +2,7 @@
Module : HsLua.Marshalling
Copyright : ?? 2007???2012 Gracjan Polak;
?? 2012???2016 ??mer Sinan A??acan;
- ?? 2017-2021 Albert Krewinkel
+ ?? 2017-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-marshalling-2.0.1/test/HsLua/Marshalling/PeekTests.hs
new/hslua-marshalling-2.1.0/test/HsLua/Marshalling/PeekTests.hs
--- old/hslua-marshalling-2.0.1/test/HsLua/Marshalling/PeekTests.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-marshalling-2.1.0/test/HsLua/Marshalling/PeekTests.hs
2001-09-09 03:46:40.000000000 +0200
@@ -2,7 +2,7 @@
{-# LANGUAGE TypeApplications #-}
{-|
Module : HsLua.Marshalling.PeekTests
-Copyright : ?? 2020-2021 Albert Krewinkel
+Copyright : ?? 2020-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
Stability : alpha
@@ -25,9 +25,13 @@
tests = testGroup "Peek"
[ testGroup "helper"
[ "retrieving" =:
- Failure @() "message" ["context"] `shouldBeResultOf`
+ Failure @() "message" ["retrieving context"] `shouldBeResultOf`
runPeek (retrieving "context" $ failPeek "message")
+ , "withContext" =:
+ Failure @() "message" ["context"] `shouldBeResultOf`
+ runPeek (withContext "context" $ failPeek "message")
+
, let firstindex idx = do
Lua.rawgeti idx 1
fromMaybe 0 <$> Lua.tointeger Lua.top <* Lua.pop 1
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-marshalling-2.0.1/test/HsLua/Marshalling/PeekersTests.hs
new/hslua-marshalling-2.1.0/test/HsLua/Marshalling/PeekersTests.hs
--- old/hslua-marshalling-2.0.1/test/HsLua/Marshalling/PeekersTests.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-marshalling-2.1.0/test/HsLua/Marshalling/PeekersTests.hs
2001-09-09 03:46:40.000000000 +0200
@@ -2,7 +2,7 @@
{-# LANGUAGE TypeApplications #-}
{-|
Module : HsLua.Marshalling.PeekersTests
-Copyright : ?? 2020-2021 Albert Krewinkel
+Copyright : ?? 2020-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
@@ -300,7 +300,10 @@
runPeek $ peekSet (peekIntegral @Int) Lua.top
, "fails if element peeker fails" =:
- let errorStack = [ "Set", "key-value pair", "key"]
+ let errorStack = [ "retrieving Set"
+ , "retrieving key-value pair"
+ , "retrieving key"
+ ]
errorMsg = "string expected, got boolean"
in Failure errorMsg errorStack `shouldBeResultOf` do
pushLuaExpr "{ NaN = true, [true] = false }"
@@ -319,14 +322,20 @@
runPeek $ peekMap peekText (peekIntegral @Int) Lua.top
, "fails if key peeker fails" =:
- let errorStack = [ "Map", "key-value pair" , "key" ]
+ let errorStack = [ "retrieving Map"
+ , "retrieving key-value pair"
+ , "retrieving key"
+ ]
errorMsg = "Integral expected, got string"
in Failure errorMsg errorStack `shouldBeResultOf` do
pushLuaExpr "{ NaN = true }"
runPeek $ peekMap (peekIntegral @Int) peekBool Lua.top
, "fails if value peeker fails" =:
- let errorStack = [ "Map", "key-value pair", "value" ]
+ let errorStack = [ "retrieving Map"
+ , "retrieving key-value pair"
+ , "retrieving value"
+ ]
errorMsg = "string expected, got boolean"
in Failure errorMsg errorStack `shouldBeResultOf` do
pushLuaExpr "{ [42] = true }"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-marshalling-2.0.1/test/HsLua/Marshalling/PushTests.hs
new/hslua-marshalling-2.1.0/test/HsLua/Marshalling/PushTests.hs
--- old/hslua-marshalling-2.0.1/test/HsLua/Marshalling/PushTests.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-marshalling-2.1.0/test/HsLua/Marshalling/PushTests.hs
2001-09-09 03:46:40.000000000 +0200
@@ -4,7 +4,7 @@
{-# LANGUAGE TypeApplications #-}
{-|
Module : HsLua.Marshalling.PushTests
-Copyright : ?? 2020-2021 Albert Krewinkel
+Copyright : ?? 2020-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
Stability : alpha
@@ -234,6 +234,17 @@
mc <- Lua.rawgeti Lua.top 3 *> Lua.tonumber Lua.top <* Lua.pop 1
return $ (,,) <$> ma <*> mb <*> mc
assert (mpair == Just (a, b, c))
+
+ , testProperty "pushAsTable" $ \(a, b) -> monadicIO $ do
+ mpair <- run $ Lua.run @Lua.Exception $ do
+ let fields = [ ("int", Lua.pushinteger . fst)
+ , ("str", Lua.pushstring . snd)
+ ]
+ pushAsTable fields (a, b)
+ ma <- Lua.getfield Lua.top "int" *> Lua.tointeger Lua.top <* Lua.pop
1
+ mb <- Lua.getfield Lua.top "str" *> Lua.tostring Lua.top <* Lua.pop
1
+ return $ (,) <$> ma <*> mb
+ assert (mpair == Just (a, b))
]
]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-marshalling-2.0.1/test/HsLua/Marshalling/UserdataTests.hs
new/hslua-marshalling-2.1.0/test/HsLua/Marshalling/UserdataTests.hs
--- old/hslua-marshalling-2.0.1/test/HsLua/Marshalling/UserdataTests.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-marshalling-2.1.0/test/HsLua/Marshalling/UserdataTests.hs
2001-09-09 03:46:40.000000000 +0200
@@ -1,7 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : HsLua.Marshalling.UserdataTests
-Copyright : ?? 2018-2021 Albert Krewinkel
+Copyright : ?? 2018-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-marshalling-2.0.1/test/HsLua/MarshallingTests.hs
new/hslua-marshalling-2.1.0/test/HsLua/MarshallingTests.hs
--- old/hslua-marshalling-2.0.1/test/HsLua/MarshallingTests.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-marshalling-2.1.0/test/HsLua/MarshallingTests.hs 2001-09-09
03:46:40.000000000 +0200
@@ -1,6 +1,8 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
{-|
Module : HsLua.MarshallingTests
-Copyright : ?? 2020-2021 Albert Krewinkel
+Copyright : ?? 2020-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
Stability : alpha
@@ -10,7 +12,13 @@
-}
module HsLua.MarshallingTests (tests) where
+import Control.Monad ((<$!>))
+import HsLua.Core
+import HsLua.Marshalling.Peek
+import HsLua.Marshalling.Peekers
+import HsLua.Marshalling.Push
import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HsLua ((=:), shouldBeResultOf)
import qualified HsLua.Marshalling.PeekTests
import qualified HsLua.Marshalling.PeekersTests
import qualified HsLua.Marshalling.PushTests
@@ -23,4 +31,28 @@
, HsLua.Marshalling.PeekersTests.tests
, HsLua.Marshalling.PushTests.tests
, HsLua.Marshalling.UserdataTests.tests
+ , testGroup "nested"
+ [ "deeply nested list" =:
+ Success (mkDeeplyNested 500) `shouldBeResultOf` do
+ pushNested (mkDeeplyNested 500)
+ runPeek $ peekNested top
+ ]
]
+
+mkDeeplyNested :: Int -> Nested
+mkDeeplyNested i = foldr (\_ n -> List [n]) (Element i) [1..i]
+
+pushNested :: LuaError e => Pusher e Nested
+pushNested = \case
+ Element i -> pushIntegral i
+ List nested -> pushList pushNested nested
+
+peekNested :: LuaError e => Peeker e Nested
+peekNested idx = do
+ liftLua (ltype idx) >>= \case
+ TypeNumber -> Element <$!> peekIntegral idx
+ TypeTable -> (List <$!> peekList peekNested idx)
+ _ -> failPeek "you dun goofed"
+
+data Nested = Element Int | List [Nested]
+ deriving (Eq, Show)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-marshalling-2.0.1/test/test-hslua-marshalling.hs
new/hslua-marshalling-2.1.0/test/test-hslua-marshalling.hs
--- old/hslua-marshalling-2.0.1/test/test-hslua-marshalling.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-marshalling-2.1.0/test/test-hslua-marshalling.hs 2001-09-09
03:46:40.000000000 +0200
@@ -1,6 +1,6 @@
{-|
Module : Main
-Copyright : ?? 2017-2021 Albert Krewinkel
+Copyright : ?? 2017-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
