Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-hslua-classes for
openSUSE:Factory checked in at 2022-02-11 23:09:04
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-hslua-classes (Old)
and /work/SRC/openSUSE:Factory/.ghc-hslua-classes.new.1956 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-hslua-classes"
Fri Feb 11 23:09:04 2022 rev:2 rq:953473 version:2.1.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-hslua-classes/ghc-hslua-classes.changes
2021-11-11 21:37:46.744948037 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-hslua-classes.new.1956/ghc-hslua-classes.changes
2022-02-11 23:10:57.555214908 +0100
@@ -1,0 +2,9 @@
+Sat Jan 29 10:07:52 UTC 2022 - Peter Simons <[email protected]>
+
+- Update hslua-classes 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-classes-2.1.0/src/CHANGELOG.md
+
+-------------------------------------------------------------------
Old:
----
hslua-classes-2.0.0.tar.gz
New:
----
hslua-classes-2.1.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-hslua-classes.spec ++++++
--- /var/tmp/diff_new_pack.45X2TT/_old 2022-02-11 23:10:57.991216169 +0100
+++ /var/tmp/diff_new_pack.45X2TT/_new 2022-02-11 23:10:57.995216181 +0100
@@ -1,7 +1,7 @@
#
# spec file for package ghc-hslua-classes
#
-# 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-classes
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.0.0
+Version: 2.1.0
Release: 0
Summary: Type classes for HsLua
License: MIT
++++++ hslua-classes-2.0.0.tar.gz -> hslua-classes-2.1.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-classes-2.0.0/CHANGELOG.md
new/hslua-classes-2.1.0/CHANGELOG.md
--- old/hslua-classes-2.0.0/CHANGELOG.md 2001-09-09 03:46:40.000000000
+0200
+++ new/hslua-classes-2.1.0/CHANGELOG.md 2001-09-09 03:46:40.000000000
+0200
@@ -1,12 +1,46 @@
# Changelog
-`hslua-classes` uses [PVP Versioning][1].
+`hslua-classes` uses [PVP Versioning][].
-## hslua-classes 2.0.0
+## hslua-classes-2.1.0
-Release pending.
+Released 29-01-2022.
-- Initially created. Contains modules previously found in the
- `Foreign.Lua.Types` hierarchy from `hslua-1.3`.
+- Updated to hslua-core 2.1 and hslua-marshalling 2.1.
-[1]: https://pvp.haskell.org
+- The Peekable class has been remodeled:
+
+ - Peekable now contains `safepeek`, which is a `Peeker`
+ function for the type.
+
+ - `peek` is no longer part of Peekable, but a normal
+ function defined as `forcePeek . safepeek`.
+
+- HsLua.Class no longer exports `peekList` and
+ `peekKeyValuePairs`. Use the functions from HsLua.Marshalling
+ instead.
+
+- The Exposable class is changed to use the `Peek` monad
+ instead of `LuaE`, thereby unifying the way errors are
+ reported in HsLua.
+
+- PeekError has been removed; it is now sufficient for
+ exception types used with Peekable, Exposable, and Invokable
+ to be instances of LuaError.
+
+- The Invokable type class now has a single parameter. This
+ removes the need for the AllowAmbiguousTypes extension and
+ makes using `invoke` much more convenient, as the proper error
+ type can now be inferred automatically.
+
+- Added function `pushAsHaskellFunction` to make it even easier
+ to use Haskell functions in Lua.
+
+## hslua-classes-2.0.0
+
+Released 2021-10-21.
+
+- Initially created. Contains modules previously found in the
+ `Foreign.Lua.Types` hierarchy from `hslua-1.3`.
+
+ [PVP Versioning]: https://pvp.haskell.org
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-classes-2.0.0/LICENSE
new/hslua-classes-2.1.0/LICENSE
--- old/hslua-classes-2.0.0/LICENSE 2001-09-09 03:46:40.000000000 +0200
+++ new/hslua-classes-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-classes-2.0.0/hslua-classes.cabal
new/hslua-classes-2.1.0/hslua-classes.cabal
--- old/hslua-classes-2.0.0/hslua-classes.cabal 2001-09-09 03:46:40.000000000
+0200
+++ new/hslua-classes-2.1.0/hslua-classes.cabal 2001-09-09 03:46:40.000000000
+0200
@@ -1,6 +1,6 @@
cabal-version: 2.2
name: hslua-classes
-version: 2.0.0
+version: 2.1.0
synopsis: Type classes for HsLua
description: Type classes for convenient marshalling and calling of
Lua functions.
@@ -12,7 +12,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
build-type: Simple
extra-source-files: README.md
@@ -22,8 +22,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
@@ -36,9 +37,9 @@
, bytestring >= 0.10.2 && < 0.12
, containers >= 0.5.9 && < 0.7
, exceptions >= 0.8 && < 0.11
- , hslua-core >= 2.0 && < 2.1
- , hslua-marshalling >= 2.0 && < 2.1
- , text >= 1.0 && < 1.3
+ , hslua-core >= 2.1 && < 2.2
+ , hslua-marshalling >= 2.1 && < 2.2
+ , text >= 1.2 && < 2.1
ghc-options: -Wall
-Wincomplete-record-updates
-Wnoncanonical-monad-instances
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-classes-2.0.0/src/HsLua/Class/Exposable.hs
new/hslua-classes-2.1.0/src/HsLua/Class/Exposable.hs
--- old/hslua-classes-2.0.0/src/HsLua/Class/Exposable.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-classes-2.1.0/src/HsLua/Class/Exposable.hs 2001-09-09
03:46:40.000000000 +0200
@@ -6,75 +6,82 @@
Module : HsLua.Class.Exposable
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
-Portability : FlexibleInstances, ForeignFunctionInterface, ScopedTypeVariables
Call Haskell functions from Lua.
-}
module HsLua.Class.Exposable
( Exposable (..)
, toHaskellFunction
+ , pushAsHaskellFunction
, registerHaskellFunction
) where
+import Data.String (fromString)
import HsLua.Core as Lua
-import HsLua.Class.Peekable (Peekable (peek), PeekError (..), inContext)
+import HsLua.Marshalling (Peek, forcePeek, liftLua, retrieving, withContext)
+import HsLua.Class.Peekable (Peekable (safepeek))
import HsLua.Class.Pushable (Pushable (push))
-- | Operations and functions that can be pushed to the Lua stack. This
-- is a helper function not intended to be used directly. Use the
-- @'toHaskellFunction'@ wrapper instead.
-class PeekError e => Exposable e a where
+class LuaError e => Exposable e a where
-- | Helper function, called by @'toHaskellFunction'@. Should do a
-- partial application of the argument at the given index to the
-- underlying function. Recurses if necessary, causing further partial
-- applications until the operation is a easily exposable to Lua.
- partialApply :: StackIndex -> a -> LuaE e NumResults
+ partialApply :: StackIndex -> a -> Peek e NumResults
-instance {-# OVERLAPPING #-} PeekError e =>
+instance {-# OVERLAPPING #-} LuaError e =>
Exposable e (HaskellFunction e) where
- partialApply _ = id
+ partialApply _ = liftLua
-instance (PeekError e, Pushable a) => Exposable e (LuaE e a) where
- partialApply _narg x = 1 <$ (x >>= push)
+instance (LuaError e, Pushable a) => Exposable e (LuaE e a) where
+ partialApply _narg x = 1 <$ liftLua (x >>= push)
+
+instance (LuaError e, Pushable a) => Exposable e (Peek e a) where
+ partialApply _narg x = 1 <$ (x >>= liftLua . push)
instance (Peekable a, Exposable e b) => Exposable e (a -> b) where
partialApply narg f = getArg >>= partialApply (narg + 1) . f
where
- getArg = inContext errorPrefix (peek narg)
- errorPrefix = "could not read argument " ++
- show (fromStackIndex narg) ++ ":"
+ getArg = retrieving (fromString errorPrefix) (safepeek narg)
+ errorPrefix = "argument " ++ show (fromStackIndex narg)
-- | Convert a Haskell function to a function type directly exposable to
-- Lua. Any Haskell function can be converted provided that:
--
-- * all arguments are instances of @'Peekable'@
--- * return type is @Lua a@, where @a@ is an instance of
+-- * return type is @LuaE e a@, where @a@ is an instance of
-- @'Pushable'@
--
--- Any @'Lua.Exception'@ will be converted to a string and returned
--- as Lua error.
+-- Any exception of type @e@ will be caught.
--
--- /Important/: this does __not__ catch exceptions other than
--- @'Lua.Exception'@; exception handling must be done by the converted
--- Haskell function. Failure to do so will cause the program to crash.
+-- /Important/: this does __not__ catch exceptions other than @e@;
+-- exception handling must be done by the Haskell function. Failure to
+-- do so will cause the program to crash.
--
-- E.g., the following code could be used to handle an Exception
-- of type FooException, if that type is an instance of
-- 'Control.Monad.Catch.MonadCatch' and 'Pushable':
--
-- > toHaskellFunction (myFun `catchM` (\e -> raiseError (e :: FooException)))
---
toHaskellFunction :: forall e a. Exposable e a => a -> HaskellFunction e
-toHaskellFunction a = do
- inContext "Error during function call:" $ partialApply 1 a
+toHaskellFunction a = forcePeek $ do
+ withContext "executing function call" $ partialApply 1 a
+
+-- | Pushes the given value as a function to the Lua stack.
+--
+-- See 'toHaskellFunction' for details.
+pushAsHaskellFunction :: forall e a. Exposable e a => a -> LuaE e ()
+pushAsHaskellFunction = pushHaskellFunction . toHaskellFunction
-- | Imports a Haskell function and registers it at global name.
registerHaskellFunction :: Exposable e a
=> Name -> a -> LuaE e ()
registerHaskellFunction n f = do
- pushHaskellFunction $ toHaskellFunction f
+ pushAsHaskellFunction f
setglobal n
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-classes-2.0.0/src/HsLua/Class/Invokable.hs
new/hslua-classes-2.1.0/src/HsLua/Class/Invokable.hs
--- old/hslua-classes-2.0.0/src/HsLua/Class/Invokable.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-classes-2.1.0/src/HsLua/Class/Invokable.hs 2001-09-09
03:46:40.000000000 +0200
@@ -1,14 +1,10 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE RankNTypes #-}
{-|
Module : HsLua.Class.Invokable
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
@@ -28,22 +24,22 @@
import HsLua.Class.Util (popValue)
-- | Helper class used to make Lua functions useable from Haskell.
-class PeekError e => Invokable e a where
- addArg :: Name -> LuaE e () -> NumArgs -> a
+class Invokable a where
+ addArg :: Name -> (forall e. LuaError e => LuaE e ()) -> NumArgs -> a
-instance (PeekError e, Peekable a) => Invokable e (LuaE e a) where
+instance (LuaError e, Peekable a) => Invokable (LuaE e a) where
addArg fnName pushArgs nargs = do
_ <- dostring $ "return " `append` Lua.fromName fnName
pushArgs
call nargs 1
popValue
-instance (Pushable a, PeekError e, Invokable e b) => Invokable e (a -> b) where
+instance (Pushable a, Invokable b) => Invokable (a -> b) where
addArg fnName pushArgs nargs x =
addArg fnName (pushArgs *> push x) (nargs + 1)
-- | Invoke a Lua function. Use as:
--
-- > v <- invoke "proc" "abc" (1::Int) (5.0::Double)
-invoke :: forall e a. Invokable e a => Name -> a
-invoke fname = addArg @e fname (return ()) 0
+invoke :: Invokable a => Name -> a
+invoke fname = addArg fname (return ()) 0
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-classes-2.0.0/src/HsLua/Class/Peekable.hs
new/hslua-classes-2.1.0/src/HsLua/Class/Peekable.hs
--- old/hslua-classes-2.0.0/src/HsLua/Class/Peekable.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-classes-2.1.0/src/HsLua/Class/Peekable.hs 2001-09-09
03:46:40.000000000 +0200
@@ -1,12 +1,11 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
{-|
Module : HsLua.Class.Peekable
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
@@ -16,174 +15,83 @@
-}
module HsLua.Class.Peekable
( Peekable (..)
- , PeekError (..)
- , peekKeyValuePairs
- , peekList
- , reportValueOnFailure
- , inContext
+ , peek
) where
-import Control.Monad ((>=>))
-import Data.ByteString (ByteString)
-import Data.Map (Map, fromList)
+import Data.Map (Map)
import Data.Set (Set)
+import Data.Text (Text)
import HsLua.Core as Lua
-import HsLua.Marshalling.Peek (runPeeker)
+import HsLua.Marshalling
import Foreign.Ptr (Ptr)
-import qualified Control.Monad.Catch as Catch
-import qualified Data.Set as Set
-import qualified Data.Text as T
+import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
-import qualified HsLua.Core.Unsafe as Unsafe
-import qualified HsLua.Marshalling as Peek
-
--- | Use @test@ to check whether the value at stack index @n@ has the
--- correct type and use @peekfn@ to convert it to a haskell value if
--- possible. Throws and exception if the test failes with the expected
--- type name as part of the message.
-typeChecked :: forall e a. LuaError e
- => ByteString -- ^ expected type
- -> (StackIndex -> LuaE e Bool) -- ^ pre-condition Checker
- -> (StackIndex -> LuaE e a) -- ^ retrieval function
- -> StackIndex -> LuaE e a
-typeChecked expectedType test peekfn idx = do
- v <- test idx
- if v
- then peekfn idx
- else throwTypeMismatchError expectedType idx
-
--- | Report the expected and actual type of the value under the given
--- index if conversion failed.
-reportValueOnFailure :: forall e a. PeekError e
- => ByteString
- -> (StackIndex -> LuaE e (Maybe a))
- -> StackIndex -> LuaE e a
-reportValueOnFailure expected peekMb idx = do
- res <- peekMb idx
- case res of
- (Just x) -> return x
- Nothing -> throwTypeMismatchError expected idx
+import qualified HsLua.Marshalling.Peekers as Peekers
-- | A value that can be read from the Lua stack.
class Peekable a where
- -- | Check if at index @n@ there is a convertible Lua value and if so return
- -- it. Throws a @'Lua.Exception'@ otherwise.
- peek :: PeekError e => StackIndex -> LuaE e a
+ -- | Function that retrieves a value from the Lua stack.
+ safepeek :: LuaError e => Peeker e a
+
+-- | Retrieves a 'Peekable' value from the stack. Throws an exception of
+-- type @e@ if the given stack index does not a suitable value.
+peek :: forall a e. (LuaError e, Peekable a) => StackIndex -> LuaE e a
+peek = forcePeek . safepeek
instance Peekable () where
- peek = reportValueOnFailure "nil" $ \idx -> do
- isNil <- isnil idx
- return (if isNil then Just () else Nothing)
+ safepeek = peekNil
instance Peekable Lua.Integer where
- peek = reportValueOnFailure "integer" tointeger
+ safepeek = reportValueOnFailure "integer" tointeger
instance Peekable Lua.Number where
- peek = reportValueOnFailure "number" tonumber
+ safepeek = reportValueOnFailure "number" tonumber
-instance Peekable ByteString where
- peek = runPeeker Peek.peekByteString >=> Peek.force
+instance Peekable B.ByteString where
+ safepeek = peekByteString
instance Peekable Bool where
- peek = toboolean
+ safepeek = peekBool
instance Peekable CFunction where
- peek = reportValueOnFailure "C function" tocfunction
+ safepeek = reportValueOnFailure "C function" tocfunction
instance Peekable (Ptr a) where
- peek = reportValueOnFailure "userdata" touserdata
+ safepeek = reportValueOnFailure "userdata" touserdata
instance Peekable Lua.State where
- peek = reportValueOnFailure "Lua state (i.e., a thread)" tothread
+ safepeek = reportValueOnFailure "Lua state (i.e., a thread)" tothread
-instance Peekable T.Text where
- peek = runPeeker Peek.peekText >=> Peek.force
+instance Peekable Text where
+ safepeek = peekText
instance Peekable BL.ByteString where
- peek = runPeeker Peek.peekLazyByteString >=> Peek.force
+ safepeek = peekLazyByteString
instance Peekable Prelude.Integer where
- peek = runPeeker Peek.peekIntegral >=> Peek.force
+ safepeek = peekIntegral
instance Peekable Int where
- peek = runPeeker Peek.peekIntegral >=> Peek.force
+ safepeek = peekIntegral
instance Peekable Float where
- peek = runPeeker Peek.peekRealFloat >=> Peek.force
+ safepeek = peekRealFloat
instance Peekable Double where
- peek = runPeeker Peek.peekRealFloat >=> Peek.force
+ safepeek = peekRealFloat
instance {-# OVERLAPS #-} Peekable [Char] where
- peek = runPeeker Peek.peekString >=> Peek.force
+ safepeek = peekString
instance Peekable a => Peekable [a] where
- peek = peekList
+ safepeek = peekList safepeek
instance (Ord a, Peekable a, Peekable b) => Peekable (Map a b) where
- peek = fmap fromList . peekKeyValuePairs
+ safepeek = peekMap safepeek safepeek
instance (Ord a, Peekable a) => Peekable (Set a) where
- peek = -- All keys with non-nil values are in the set
- fmap (Set.fromList . map fst . filter snd) . peekKeyValuePairs
-
--- | Read a table into a list
-peekList :: (PeekError e, Peekable a) => StackIndex -> LuaE e [a]
-peekList = typeChecked "table" istable $ \idx -> do
- let elementsAt [] = return []
- elementsAt (i : is) = do
- x <- (rawgeti idx i *> peek top) `Catch.finally` pop 1
- (x:) <$> elementsAt is
- listLength <- fromIntegral <$> rawlen idx
- inContext "Could not read list:" (elementsAt [1..listLength])
-
--- | Read a table into a list of pairs.
-peekKeyValuePairs :: (Peekable a, Peekable b, PeekError e)
- => StackIndex -> LuaE e [(a, b)]
-peekKeyValuePairs = typeChecked "table" istable $ \idx -> do
- let remainingPairs = do
- res <- nextPair (if idx < 0 then idx - 1 else idx)
- case res of
- Nothing -> [] <$ return ()
- Just a -> (a:) <$> remainingPairs
- pushnil
- remainingPairs
- -- ensure the remaining key is removed from the stack on exception
- `Catch.onException` pop 1
-
--- | Get the next key-value pair from a table. Assumes the last key to
--- be on the top of the stack and the table at the given index @idx@.
-nextPair :: (PeekError e, Peekable a, Peekable b)
- => StackIndex -> LuaE e (Maybe (a, b))
-nextPair idx = do
- hasNext <- Unsafe.next idx
- if hasNext
- then let pair = (,) <$> inContext "Could not read key of key-value pair:"
- (peek (nth 2))
- <*> inContext "Could not read value of key-value pair:"
- (peek (nth 1))
- in Just <$> pair `Catch.finally` pop 1
- -- removes the value, keeps the key
- else return Nothing
-
--- | Specify a name for the context in which a computation is run. The
--- name is added to the error message in case of an exception.
-inContext :: forall e a. PeekError e
- => String -> LuaE e a -> LuaE e a
-inContext ctx op = try op >>= \case
- Right x -> return x
- Left (err :: e) -> Catch.throwM $
- luaException @e (ctx ++ "\n\t" ++ messageFromException err)
-
--- | Exceptions that are to be used with 'peek' and similar functions
--- must be instances of this class. It ensures that error can be amended
--- with the context in which they happened.
-class LuaError e => PeekError e where
- messageFromException :: e -> String
-
-instance PeekError Lua.Exception where
- messageFromException = Lua.exceptionMessage
+ safepeek = peekSet safepeek
--
-- Tuples
@@ -193,21 +101,19 @@
(Peekable a, Peekable b) =>
Peekable (a, b)
where
- peek = typeChecked "table" istable $ \idx ->
- (,) <$> nthValue idx 1 <*> nthValue idx 2
+ safepeek = peekPair safepeek safepeek
instance {-# OVERLAPPABLE #-}
(Peekable a, Peekable b, Peekable c) =>
Peekable (a, b, c)
where
- peek = typeChecked "table" istable $ \idx ->
- (,,) <$> nthValue idx 1 <*> nthValue idx 2 <*> nthValue idx 3
+ safepeek = peekTriple safepeek safepeek safepeek
instance {-# OVERLAPPABLE #-}
(Peekable a, Peekable b, Peekable c, Peekable d) =>
Peekable (a, b, c, d)
where
- peek = typeChecked "table" istable $ \idx ->
+ safepeek = typeChecked "table" istable $ \idx ->
(,,,) <$> nthValue idx 1 <*> nthValue idx 2 <*> nthValue idx 3
<*> nthValue idx 4
@@ -215,7 +121,7 @@
(Peekable a, Peekable b, Peekable c, Peekable d, Peekable e) =>
Peekable (a, b, c, d, e)
where
- peek = typeChecked "table" istable $ \idx ->
+ safepeek = typeChecked "table" istable $ \idx ->
(,,,,) <$> nthValue idx 1 <*> nthValue idx 2 <*> nthValue idx 3
<*> nthValue idx 4 <*> nthValue idx 5
@@ -223,7 +129,7 @@
(Peekable a, Peekable b, Peekable c, Peekable d, Peekable e, Peekable f) =>
Peekable (a, b, c, d, e, f)
where
- peek = typeChecked "table" istable $ \idx ->
+ safepeek = typeChecked "table" istable $ \idx ->
(,,,,,) <$> nthValue idx 1 <*> nthValue idx 2 <*> nthValue idx 3
<*> nthValue idx 4 <*> nthValue idx 5 <*> nthValue idx 6
@@ -233,7 +139,7 @@
Peekable e, Peekable f, Peekable g) =>
Peekable (a, b, c, d, e, f, g)
where
- peek = typeChecked "table" istable $ \idx ->
+ safepeek = typeChecked "table" istable $ \idx ->
(,,,,,,) <$> nthValue idx 1 <*> nthValue idx 2 <*> nthValue idx 3
<*> nthValue idx 4 <*> nthValue idx 5 <*> nthValue idx 6
<*> nthValue idx 7
@@ -243,14 +149,12 @@
Peekable e, Peekable f, Peekable g, Peekable h) =>
Peekable (a, b, c, d, e, f, g, h)
where
- peek = typeChecked "table" istable $ \idx ->
+ safepeek = typeChecked "table" istable $ \idx ->
(,,,,,,,) <$> nthValue idx 1 <*> nthValue idx 2 <*> nthValue idx 3
<*> nthValue idx 4 <*> nthValue idx 5 <*> nthValue idx 6
<*> nthValue idx 7 <*> nthValue idx 8
-- | Helper function to get the nth table value
-nthValue :: (PeekError e, Peekable a)
- => StackIndex -> Lua.Integer -> LuaE e a
-nthValue idx n = do
- rawgeti idx n
- peek top `Catch.finally` pop 1
+nthValue :: (LuaError e, Peekable a)
+ => StackIndex -> Lua.Integer -> Peek e a
+nthValue idx n = Peekers.peekIndexRaw n safepeek idx
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-classes-2.0.0/src/HsLua/Class/Pushable.hs
new/hslua-classes-2.1.0/src/HsLua/Class/Pushable.hs
--- old/hslua-classes-2.0.0/src/HsLua/Class/Pushable.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-classes-2.1.0/src/HsLua/Class/Pushable.hs 2001-09-09
03:46:40.000000000 +0200
@@ -4,7 +4,7 @@
Module : HsLua.Class.Pushable
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-classes-2.0.0/src/HsLua/Class/Util.hs
new/hslua-classes-2.1.0/src/HsLua/Class/Util.hs
--- old/hslua-classes-2.0.0/src/HsLua/Class/Util.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-classes-2.1.0/src/HsLua/Class/Util.hs 2001-09-09
03:46:40.000000000 +0200
@@ -3,7 +3,7 @@
Module : HsLua.Class.Util
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
@@ -19,15 +19,16 @@
, popValue
) where
-import HsLua.Core (LuaE, NumResults, StackIndex, top)
-import HsLua.Class.Peekable (Peekable (peek), PeekError)
+import Control.Applicative ((<|>))
+import HsLua.Core (LuaE, LuaError, NumResults, StackIndex, top)
+import HsLua.Class.Peekable (Peekable (safepeek), peek)
import HsLua.Class.Pushable (Pushable (push))
-import qualified Control.Monad.Catch as Catch
import qualified HsLua.Core as Lua
+import qualified HsLua.Marshalling as Lua
-- | Raise a Lua error, using the given value as the error object.
-raiseError :: (PeekError e, Pushable a) => a -> LuaE e NumResults
+raiseError :: (LuaError e, Pushable a) => a -> LuaE e NumResults
raiseError e = do
push e
Lua.error
@@ -40,11 +41,8 @@
newtype Optional a = Optional { fromOptional :: Maybe a }
instance Peekable a => Peekable (Optional a) where
- peek idx = do
- noValue <- Lua.isnoneornil idx
- if noValue
- then return $ Optional Nothing
- else Optional . Just <$> peek idx
+ safepeek idx = (Optional Nothing <$ Lua.peekNoneOrNil idx)
+ <|> (Optional . Just <$> safepeek idx)
instance Pushable a => Pushable (Optional a) where
push (Optional Nothing) = Lua.pushnil
@@ -57,12 +55,12 @@
-- | Try to convert the value at the given stack index to a Haskell value.
-- Returns 'Left' with the error on failure.
-peekEither :: (PeekError e, Peekable a)
+peekEither :: (LuaError e, Peekable a)
=> StackIndex -> LuaE e (Either e a)
peekEither = Lua.try . peek
-- | Get, then pop the value at the top of the stack. The pop operation is
-- executed even if the retrieval operation failed.
-popValue :: (PeekError e, Peekable a) => LuaE e a
-popValue = peek top `Catch.finally` Lua.pop 1
+popValue :: (LuaError e, Peekable a) => LuaE e a
+popValue = Lua.forcePeek $ safepeek top `Lua.lastly` Lua.pop 1
{-# INLINABLE popValue #-}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-classes-2.0.0/src/HsLua/Classes.hs
new/hslua-classes-2.1.0/src/HsLua/Classes.hs
--- old/hslua-classes-2.0.0/src/HsLua/Classes.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-classes-2.1.0/src/HsLua/Classes.hs 2001-09-09
03:46:40.000000000 +0200
@@ -2,7 +2,7 @@
Module : HsLua.Classes
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
@@ -15,8 +15,6 @@
( -- * Receiving values from Lua stack (Lua ??? Haskell)
Peekable (..)
, peekEither
- , peekList
- , peekKeyValuePairs
-- * Pushing values to Lua stack (Haskell ??? Lua)
, Pushable (..)
, pushList
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-classes-2.0.0/test/HsLua/Class/ExposableTests.hs
new/hslua-classes-2.1.0/test/HsLua/Class/ExposableTests.hs
--- old/hslua-classes-2.0.0/test/HsLua/Class/ExposableTests.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-classes-2.1.0/test/HsLua/Class/ExposableTests.hs 2001-09-09
03:46:40.000000000 +0200
@@ -2,7 +2,7 @@
{-# LANGUAGE TypeApplications #-}
{-|
Module : HsLua.Class.ExposableTests
-Copyright : ?? 2017-2021 Albert Krewinkel
+Copyright : ?? 2017-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
@@ -34,7 +34,7 @@
i1 <- Lua.peek (-1)
i2 <- Lua.peek (-2)
return (i1 + i2)
- Lua.registerHaskellFunction "add" $ toHaskellFunction @Lua.Exception add
+ Lua.registerHaskellFunction "add" add
Lua.loadstring "return add(23, 5)" *> Lua.call 0 1
Lua.peek Lua.top <* Lua.pop 1
@@ -45,16 +45,16 @@
Lua.peek (-1) <* Lua.pop 1
, "argument type errors are propagated" =:
- ("Error during function call:\n\tcould not read argument 2:\n\t"
- ++ "integer expected, got boolean") `shouldBeErrorMessageOf` do
+ ("integer expected, got boolean" ++
+ "\n\twhile retrieving argument 2" ++
+ "\n\twhile executing function call") `shouldBeErrorMessageOf` do
Lua.registerHaskellFunction "integerOp" integerOperation
pushLuaExpr "integerOp(23, true)"
, "Error in Haskell function is converted into Lua error" =:
- (False, "Error during function call:\n\tfoo") `shouldBeResultOf` do
+ (False, "foo") `shouldBeResultOf` do
Lua.openlibs
- Lua.pushHaskellFunction $
- toHaskellFunction (Lua.failLua "foo" :: Lua ())
+ Lua.pushAsHaskellFunction (Lua.failLua "foo" :: Lua ())
Lua.setglobal "throw_foo"
Lua.loadstring "return pcall(throw_foo)" *> Lua.call 0 2
(,) <$> Lua.peek (Lua.nth 2) <*> Lua.peek @String (Lua.nth 1)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-classes-2.0.0/test/HsLua/Class/InvokableTests.hs
new/hslua-classes-2.1.0/test/HsLua/Class/InvokableTests.hs
--- old/hslua-classes-2.0.0/test/HsLua/Class/InvokableTests.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-classes-2.1.0/test/HsLua/Class/InvokableTests.hs 2001-09-09
03:46:40.000000000 +0200
@@ -1,8 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeApplications #-}
{-|
Module : HsLua.Class.InvokableTests
-Copyright : ?? 2017-2021 Albert Krewinkel
+Copyright : ?? 2017-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
@@ -24,25 +23,25 @@
[ "test equality within lua" =:
True `shouldBeResultOf` do
openlibs
- invoke @Lua.Exception "rawequal" (5 :: Lua.Integer) (5.0 :: Lua.Number)
+ invoke "rawequal" (5 :: Lua.Integer) (5.0 :: Lua.Number)
, "failing lua function call" =:
"foo" `shouldBeErrorMessageOf` do
openlibs
- invoke @Lua.Exception "assert" False (Char8.pack "foo") :: Lua Bool
+ invoke "assert" False (Char8.pack "foo") :: Lua Bool
, "pack table via lua procedure" =:
(True, 23 :: Lua.Integer, "moin" :: ByteString) `shouldBeResultOf` do
openlibs
- invoke @Lua.Exception "table.pack" True (23 :: Lua.Integer) (Char8.pack
"moin")
+ invoke "table.pack" True (23 :: Lua.Integer) (Char8.pack "moin")
, "failing lua procedure call" =:
"foo" `shouldBeErrorMessageOf` do
openlibs
- invoke @Lua.Exception "error" (Char8.pack "foo") :: Lua ()
+ invoke "error" (Char8.pack "foo") :: Lua ()
, "Error when Lua-to-Haskell result conversion fails" =:
"string expected, got boolean" `shouldBeErrorMessageOf` do
openlibs
- invoke @Lua.Exception "rawequal" (Char8.pack "a") () :: Lua String
+ invoke "rawequal" (Char8.pack "a") () :: Lua String
]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-classes-2.0.0/test/HsLua/Class/PeekableTests.hs
new/hslua-classes-2.1.0/test/HsLua/Class/PeekableTests.hs
--- old/hslua-classes-2.0.0/test/HsLua/Class/PeekableTests.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-classes-2.1.0/test/HsLua/Class/PeekableTests.hs 2001-09-09
03:46:40.000000000 +0200
@@ -2,7 +2,7 @@
{-# LANGUAGE TypeApplications #-}
{-|
Module : HsLua.Class.PeekableTests
-Copyright : ?? 2017-2021 Albert Krewinkel
+Copyright : ?? 2017-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
@@ -20,8 +20,6 @@
, shouldBeErrorMessageOf )
import Test.Tasty (TestTree, testGroup)
-import qualified Data.Set as Set
-
-- | Specifications for Attributes parsing functions.
tests :: TestTree
tests = testGroup "Peekable"
@@ -58,27 +56,6 @@
peek top
]
- , testGroup "peekKeyValuePairs"
- [ "`next` is not confused when peeking at number keys as strings" =:
- -- list of numbers can be retrieved as pair of strings
- [("1", "2"), ("2", "4"), ("3", "8"), ("4", "16")] `shouldBeResultOf` do
- pushLuaExpr "{2, 4, 8, 16}"
- peekKeyValuePairs top :: Lua [(String, String)]
-
- , "peek string pairs" =:
- Set.fromList [("foo", "bar"), ("qux", "quux")] `shouldBeResultOf` do
- pushLuaExpr "{foo = 'bar', qux = 'quux'}"
- Set.fromList <$> (peekKeyValuePairs top :: Lua [(String, String)])
-
- , "stack is left unchanged" =:
- 0 `shouldBeResultOf` do
- pushLuaExpr "{foo = 'bar', qux = 'quux'}"
- topBefore <- gettop
- _ <- peekKeyValuePairs top :: Lua [(String, String)]
- topAfter <- gettop
- return (topAfter - topBefore)
- ]
-
, testGroup "error handling"
[ "error is thrown if boolean is given instead of stringy value" =:
"string expected, got boolean" `shouldBeErrorMessageOf` do
@@ -96,7 +73,9 @@
peek top :: Lua Lua.Number
, "list cannot be read if a peeking at list element fails" =:
- "Could not read list:\n\tnumber expected, got boolean"
+ ("number expected, got boolean" ++
+ "\n\twhile retrieving index 4" ++
+ "\n\twhile retrieving list")
`shouldBeErrorMessageOf` do
pushLuaExpr "{1, 5, 23, true, 42}"
peek top :: Lua [Lua.Number]
@@ -105,7 +84,7 @@
0 `shouldBeResultOf` do
pushLuaExpr "{true, 1, 1, 2, 3, 5, 8}"
topBefore <- gettop
- _ <- peekList top :: Lua [Bool]
+ _ <- peek top :: Lua [Bool]
topAfter <- gettop
return (topAfter - topBefore)
@@ -113,7 +92,7 @@
0 `shouldBeResultOf` do
pushLuaExpr "{foo = 'bar', baz = false}"
topBefore <- gettop
- _ <- try (peekKeyValuePairs top :: Lua [(String, String)])
+ _ <- try (peek top :: Lua [(String, String)])
topAfter <- gettop
return (topAfter - topBefore)
]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/hslua-classes-2.0.0/test/HsLua/Class/PushableTests.hs
new/hslua-classes-2.1.0/test/HsLua/Class/PushableTests.hs
--- old/hslua-classes-2.0.0/test/HsLua/Class/PushableTests.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-classes-2.1.0/test/HsLua/Class/PushableTests.hs 2001-09-09
03:46:40.000000000 +0200
@@ -2,7 +2,7 @@
{-# LANGUAGE TypeApplications #-}
{-|
Module : HsLua.Class.PushableTests
-Copyright : ?? 2017-2021 Albert Krewinkel
+Copyright : ?? 2017-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-classes-2.0.0/test/HsLua/Class/UtilTests.hs
new/hslua-classes-2.1.0/test/HsLua/Class/UtilTests.hs
--- old/hslua-classes-2.0.0/test/HsLua/Class/UtilTests.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-classes-2.1.0/test/HsLua/Class/UtilTests.hs 2001-09-09
03:46:40.000000000 +0200
@@ -2,7 +2,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : HsLua.Class.UtilTests
-Copyright : ?? 2017-2021 Albert Krewinkel
+Copyright : ?? 2017-2022 Albert Krewinkel
License : MIT
Maintainer : Albert Krewinkel <[email protected]>
@@ -66,8 +66,9 @@
peekEither top
, "return error message on failure" =:
- let msg = "Could not read list:\n"
- <> "\tinteger expected, got boolean"
+ let msg = "integer expected, got boolean"
+ <> "\n\twhile retrieving index 2"
+ <> "\n\twhile retrieving list"
in
Left (Lua.Exception msg)
`shouldBeResultOf` do
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/hslua-classes-2.0.0/test/HsLua/ClassesTests.hs
new/hslua-classes-2.1.0/test/HsLua/ClassesTests.hs
--- old/hslua-classes-2.0.0/test/HsLua/ClassesTests.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-classes-2.1.0/test/HsLua/ClassesTests.hs 2001-09-09
03:46:40.000000000 +0200
@@ -3,7 +3,7 @@
Module : HsLua.ClassesTests
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-classes-2.0.0/test/test-hslua-classes.hs
new/hslua-classes-2.1.0/test/test-hslua-classes.hs
--- old/hslua-classes-2.0.0/test/test-hslua-classes.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/hslua-classes-2.1.0/test/test-hslua-classes.hs 2001-09-09
03:46:40.000000000 +0200
@@ -2,7 +2,7 @@
Module : Main
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
