hslua-classes 2.0.0 → 2.1.0

raw patch · 16 files changed

+169/−252 lines, 16 filesdep ~hslua-coredep ~hslua-marshallingdep ~textPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hslua-core, hslua-marshalling, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +40/−6
• LICENSE +1/−1
• hslua-classes.cabal +7/−6
• src/HsLua/Class/Exposable.hs +30/−23
• src/HsLua/Class/Invokable.hs +8/−12
• src/HsLua/Class/Peekable.hs +44/−140
• src/HsLua/Class/Pushable.hs +1/−1
• src/HsLua/Class/Util.hs +11/−13
• src/HsLua/Classes.hs +1/−3
• test/HsLua/Class/ExposableTests.hs +7/−7
• test/HsLua/Class/InvokableTests.hs +6/−7
• test/HsLua/Class/PeekableTests.hs +6/−27
• test/HsLua/Class/PushableTests.hs +1/−1
• test/HsLua/Class/UtilTests.hs +4/−3
• test/HsLua/ClassesTests.hs +1/−1
• test/test-hslua-classes.hs +1/−1

@@ -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

@@ -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

@@ -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:          albert+hslua@zeitkraut.de 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

@@ -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 <tarleb+hslua@zeitkraut.de>-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

@@ -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 <tarleb+hslua@zeitkraut.de> 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

@@ -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 <tarleb+hslua@zeitkraut.de> 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

@@ -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 <tarleb+hslua@zeitkraut.de> Stability   : beta

@@ -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 <tarleb+hslua@zeitkraut.de> 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 #-}

@@ -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 <tarleb+hslua@zeitkraut.de> 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

@@ -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 <tarleb+hslua@zeitkraut.de> @@ -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)

@@ -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 <tarleb+hslua@zeitkraut.de> @@ -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   ]

@@ -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 <tarleb+hslua@zeitkraut.de>@@ -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)     ]

@@ -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 <tarleb+hslua@zeitkraut.de>

@@ -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 <tarleb+hslua@zeitkraut.de>@@ -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

@@ -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 <tarleb+hslua@zeitkraut.de> Stability   : beta

@@ -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 <tarleb+hslua@zeitkraut.de> Stability   : beta