{-# 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
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability   : beta
Portability : non-portable (depends on GHC)

Sending haskell objects to the lua stack.
-}
module HsLua.Class.Peekable
  ( Peekable (..)
  , PeekError (..)
  , peekKeyValuePairs
  , peekList
  , reportValueOnFailure
  , inContext
  ) where

import Control.Monad ((>=>))
import Data.ByteString (ByteString)
import Data.Map (Map, fromList)
import Data.Set (Set)
import HsLua.Core as Lua
import HsLua.Marshalling.Peek (runPeeker)
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.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 :: ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e a)
-> StackIndex
-> LuaE e a
typeChecked ByteString
expectedType StackIndex -> LuaE e Bool
test StackIndex -> LuaE e a
peekfn StackIndex
idx = do
  Bool
v <- StackIndex -> LuaE e Bool
test StackIndex
idx
  if Bool
v
    then StackIndex -> LuaE e a
peekfn StackIndex
idx
    else ByteString -> StackIndex -> LuaE e a
forall e a. LuaError e => ByteString -> StackIndex -> LuaE e a
throwTypeMismatchError ByteString
expectedType StackIndex
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 :: ByteString
-> (StackIndex -> LuaE e (Maybe a)) -> StackIndex -> LuaE e a
reportValueOnFailure ByteString
expected StackIndex -> LuaE e (Maybe a)
peekMb StackIndex
idx = do
  Maybe a
res <- StackIndex -> LuaE e (Maybe a)
peekMb StackIndex
idx
  case Maybe a
res of
    (Just a
x) -> a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    Maybe a
Nothing  -> ByteString -> StackIndex -> LuaE e a
forall e a. LuaError e => ByteString -> StackIndex -> LuaE e a
throwTypeMismatchError ByteString
expected StackIndex
idx

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

instance Peekable () where
  peek :: StackIndex -> LuaE e ()
peek = ByteString
-> (StackIndex -> LuaE e (Maybe ())) -> StackIndex -> LuaE e ()
forall e a.
PeekError e =>
ByteString
-> (StackIndex -> LuaE e (Maybe a)) -> StackIndex -> LuaE e a
reportValueOnFailure ByteString
"nil" ((StackIndex -> LuaE e (Maybe ())) -> StackIndex -> LuaE e ())
-> (StackIndex -> LuaE e (Maybe ())) -> StackIndex -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> do
    Bool
isNil <- StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
isnil StackIndex
idx
    Maybe () -> LuaE e (Maybe ())
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
isNil then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing)

instance Peekable Lua.Integer where
  peek :: StackIndex -> LuaE e Integer
peek = ByteString
-> (StackIndex -> LuaE e (Maybe Integer))
-> StackIndex
-> LuaE e Integer
forall e a.
PeekError e =>
ByteString
-> (StackIndex -> LuaE e (Maybe a)) -> StackIndex -> LuaE e a
reportValueOnFailure ByteString
"integer" StackIndex -> LuaE e (Maybe Integer)
forall e. StackIndex -> LuaE e (Maybe Integer)
tointeger

instance Peekable Lua.Number where
  peek :: StackIndex -> LuaE e Number
peek = ByteString
-> (StackIndex -> LuaE e (Maybe Number))
-> StackIndex
-> LuaE e Number
forall e a.
PeekError e =>
ByteString
-> (StackIndex -> LuaE e (Maybe a)) -> StackIndex -> LuaE e a
reportValueOnFailure ByteString
"number" StackIndex -> LuaE e (Maybe Number)
forall e. StackIndex -> LuaE e (Maybe Number)
tonumber

instance Peekable ByteString where
  peek :: StackIndex -> LuaE e ByteString
peek = Peeker e ByteString -> StackIndex -> LuaE e (Result ByteString)
forall e a. Peeker e a -> StackIndex -> LuaE e (Result a)
runPeeker Peeker e ByteString
forall e. Peeker e ByteString
Peek.peekByteString (StackIndex -> LuaE e (Result ByteString))
-> (Result ByteString -> LuaE e ByteString)
-> StackIndex
-> LuaE e ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Result ByteString -> LuaE e ByteString
forall e a. LuaError e => Result a -> LuaE e a
Peek.force

instance Peekable Bool where
  peek :: StackIndex -> LuaE e Bool
peek = StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
toboolean

instance Peekable CFunction where
  peek :: StackIndex -> LuaE e CFunction
peek = ByteString
-> (StackIndex -> LuaE e (Maybe CFunction))
-> StackIndex
-> LuaE e CFunction
forall e a.
PeekError e =>
ByteString
-> (StackIndex -> LuaE e (Maybe a)) -> StackIndex -> LuaE e a
reportValueOnFailure ByteString
"C function" StackIndex -> LuaE e (Maybe CFunction)
forall e. StackIndex -> LuaE e (Maybe CFunction)
tocfunction

instance Peekable (Ptr a) where
  peek :: StackIndex -> LuaE e (Ptr a)
peek = ByteString
-> (StackIndex -> LuaE e (Maybe (Ptr a)))
-> StackIndex
-> LuaE e (Ptr a)
forall e a.
PeekError e =>
ByteString
-> (StackIndex -> LuaE e (Maybe a)) -> StackIndex -> LuaE e a
reportValueOnFailure ByteString
"userdata" StackIndex -> LuaE e (Maybe (Ptr a))
forall e a. StackIndex -> LuaE e (Maybe (Ptr a))
touserdata

instance Peekable Lua.State where
  peek :: StackIndex -> LuaE e State
peek = ByteString
-> (StackIndex -> LuaE e (Maybe State))
-> StackIndex
-> LuaE e State
forall e a.
PeekError e =>
ByteString
-> (StackIndex -> LuaE e (Maybe a)) -> StackIndex -> LuaE e a
reportValueOnFailure ByteString
"Lua state (i.e., a thread)" StackIndex -> LuaE e (Maybe State)
forall e. StackIndex -> LuaE e (Maybe State)
tothread

instance Peekable T.Text where
  peek :: StackIndex -> LuaE e Text
peek = Peeker e Text -> StackIndex -> LuaE e (Result Text)
forall e a. Peeker e a -> StackIndex -> LuaE e (Result a)
runPeeker Peeker e Text
forall e. Peeker e Text
Peek.peekText (StackIndex -> LuaE e (Result Text))
-> (Result Text -> LuaE e Text) -> StackIndex -> LuaE e Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Result Text -> LuaE e Text
forall e a. LuaError e => Result a -> LuaE e a
Peek.force

instance Peekable BL.ByteString where
  peek :: StackIndex -> LuaE e ByteString
peek = Peeker e ByteString -> StackIndex -> LuaE e (Result ByteString)
forall e a. Peeker e a -> StackIndex -> LuaE e (Result a)
runPeeker Peeker e ByteString
forall e. Peeker e ByteString
Peek.peekLazyByteString (StackIndex -> LuaE e (Result ByteString))
-> (Result ByteString -> LuaE e ByteString)
-> StackIndex
-> LuaE e ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Result ByteString -> LuaE e ByteString
forall e a. LuaError e => Result a -> LuaE e a
Peek.force

instance Peekable Prelude.Integer where
  peek :: StackIndex -> LuaE e Integer
peek = Peeker e Integer -> StackIndex -> LuaE e (Result Integer)
forall e a. Peeker e a -> StackIndex -> LuaE e (Result a)
runPeeker Peeker e Integer
forall a e. (Integral a, Read a) => Peeker e a
Peek.peekIntegral (StackIndex -> LuaE e (Result Integer))
-> (Result Integer -> LuaE e Integer)
-> StackIndex
-> LuaE e Integer
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Result Integer -> LuaE e Integer
forall e a. LuaError e => Result a -> LuaE e a
Peek.force

instance Peekable Int where
  peek :: StackIndex -> LuaE e Int
peek = Peeker e Int -> StackIndex -> LuaE e (Result Int)
forall e a. Peeker e a -> StackIndex -> LuaE e (Result a)
runPeeker Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
Peek.peekIntegral (StackIndex -> LuaE e (Result Int))
-> (Result Int -> LuaE e Int) -> StackIndex -> LuaE e Int
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Result Int -> LuaE e Int
forall e a. LuaError e => Result a -> LuaE e a
Peek.force

instance Peekable Float where
  peek :: StackIndex -> LuaE e Float
peek = Peeker e Float -> StackIndex -> LuaE e (Result Float)
forall e a. Peeker e a -> StackIndex -> LuaE e (Result a)
runPeeker Peeker e Float
forall a e. (RealFloat a, Read a) => Peeker e a
Peek.peekRealFloat (StackIndex -> LuaE e (Result Float))
-> (Result Float -> LuaE e Float) -> StackIndex -> LuaE e Float
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Result Float -> LuaE e Float
forall e a. LuaError e => Result a -> LuaE e a
Peek.force

instance Peekable Double where
  peek :: StackIndex -> LuaE e Double
peek = Peeker e Double -> StackIndex -> LuaE e (Result Double)
forall e a. Peeker e a -> StackIndex -> LuaE e (Result a)
runPeeker Peeker e Double
forall a e. (RealFloat a, Read a) => Peeker e a
Peek.peekRealFloat (StackIndex -> LuaE e (Result Double))
-> (Result Double -> LuaE e Double) -> StackIndex -> LuaE e Double
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Result Double -> LuaE e Double
forall e a. LuaError e => Result a -> LuaE e a
Peek.force

instance {-# OVERLAPS #-} Peekable [Char] where
  peek :: StackIndex -> LuaE e [Char]
peek = Peeker e [Char] -> StackIndex -> LuaE e (Result [Char])
forall e a. Peeker e a -> StackIndex -> LuaE e (Result a)
runPeeker Peeker e [Char]
forall e. Peeker e [Char]
Peek.peekString (StackIndex -> LuaE e (Result [Char]))
-> (Result [Char] -> LuaE e [Char]) -> StackIndex -> LuaE e [Char]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Result [Char] -> LuaE e [Char]
forall e a. LuaError e => Result a -> LuaE e a
Peek.force

instance Peekable a => Peekable [a] where
  peek :: StackIndex -> LuaE e [a]
peek = StackIndex -> LuaE e [a]
forall e a. (PeekError e, Peekable a) => StackIndex -> LuaE e [a]
peekList

instance (Ord a, Peekable a, Peekable b) => Peekable (Map a b) where
  peek :: StackIndex -> LuaE e (Map a b)
peek = ([(a, b)] -> Map a b) -> LuaE e [(a, b)] -> LuaE e (Map a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(a, b)] -> Map a b
forall k a. Ord k => [(k, a)] -> Map k a
fromList (LuaE e [(a, b)] -> LuaE e (Map a b))
-> (StackIndex -> LuaE e [(a, b)])
-> StackIndex
-> LuaE e (Map a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> LuaE e [(a, b)]
forall a b e.
(Peekable a, Peekable b, PeekError e) =>
StackIndex -> LuaE e [(a, b)]
peekKeyValuePairs

instance (Ord a, Peekable a) => Peekable (Set a) where
  peek :: StackIndex -> LuaE e (Set a)
peek = -- All keys with non-nil values are in the set
    ([(a, Bool)] -> Set a) -> LuaE e [(a, Bool)] -> LuaE e (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> ([(a, Bool)] -> [a]) -> [(a, Bool)] -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Bool) -> a) -> [(a, Bool)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Bool) -> a
forall a b. (a, b) -> a
fst ([(a, Bool)] -> [a])
-> ([(a, Bool)] -> [(a, Bool)]) -> [(a, Bool)] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Bool) -> Bool) -> [(a, Bool)] -> [(a, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (a, Bool) -> Bool
forall a b. (a, b) -> b
snd) (LuaE e [(a, Bool)] -> LuaE e (Set a))
-> (StackIndex -> LuaE e [(a, Bool)])
-> StackIndex
-> LuaE e (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> LuaE e [(a, Bool)]
forall a b e.
(Peekable a, Peekable b, PeekError e) =>
StackIndex -> LuaE e [(a, b)]
peekKeyValuePairs

-- | Read a table into a list
peekList :: (PeekError e, Peekable a) => StackIndex -> LuaE e [a]
peekList :: StackIndex -> LuaE e [a]
peekList = ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e [a])
-> StackIndex
-> LuaE e [a]
forall e a.
LuaError e =>
ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e a)
-> StackIndex
-> LuaE e a
typeChecked ByteString
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
istable ((StackIndex -> LuaE e [a]) -> StackIndex -> LuaE e [a])
-> (StackIndex -> LuaE e [a]) -> StackIndex -> LuaE e [a]
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> do
  let elementsAt :: [Integer] -> LuaE e [a]
elementsAt [] = [a] -> LuaE e [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      elementsAt (Integer
i : [Integer]
is) = do
        a
x <- (StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx Integer
i LuaE e () -> LuaE e a -> LuaE e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> LuaE e a
forall a e. (Peekable a, PeekError e) => StackIndex -> LuaE e a
peek StackIndex
top) LuaE e a -> LuaE e () -> LuaE e a
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`Catch.finally` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
        (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> LuaE e [a] -> LuaE e [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer] -> LuaE e [a]
elementsAt [Integer]
is
  Integer
listLength <- Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> LuaE e Int -> LuaE e Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> LuaE e Int
forall e. StackIndex -> LuaE e Int
rawlen StackIndex
idx
  [Char] -> LuaE e [a] -> LuaE e [a]
forall e a. PeekError e => [Char] -> LuaE e a -> LuaE e a
inContext [Char]
"Could not read list:" ([Integer] -> LuaE e [a]
forall e a. (Peekable a, PeekError e) => [Integer] -> LuaE e [a]
elementsAt [Integer
1..Integer
listLength])

-- | Read a table into a list of pairs.
peekKeyValuePairs :: (Peekable a, Peekable b, PeekError e)
                  => StackIndex -> LuaE e [(a, b)]
peekKeyValuePairs :: StackIndex -> LuaE e [(a, b)]
peekKeyValuePairs = ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e [(a, b)])
-> StackIndex
-> LuaE e [(a, b)]
forall e a.
LuaError e =>
ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e a)
-> StackIndex
-> LuaE e a
typeChecked ByteString
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
istable ((StackIndex -> LuaE e [(a, b)]) -> StackIndex -> LuaE e [(a, b)])
-> (StackIndex -> LuaE e [(a, b)]) -> StackIndex -> LuaE e [(a, b)]
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> do
  let remainingPairs :: LuaE e [(a, b)]
remainingPairs = do
        Maybe (a, b)
res <- StackIndex -> LuaE e (Maybe (a, b))
forall e a b.
(PeekError e, Peekable a, Peekable b) =>
StackIndex -> LuaE e (Maybe (a, b))
nextPair (if StackIndex
idx StackIndex -> StackIndex -> Bool
forall a. Ord a => a -> a -> Bool
< StackIndex
0 then StackIndex
idx StackIndex -> StackIndex -> StackIndex
forall a. Num a => a -> a -> a
- StackIndex
1 else StackIndex
idx)
        case Maybe (a, b)
res of
          Maybe (a, b)
Nothing -> [] [(a, b)] -> LuaE e () -> LuaE e [(a, b)]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ () -> LuaE e ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just (a, b)
a  -> ((a, b)
a(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:) ([(a, b)] -> [(a, b)]) -> LuaE e [(a, b)] -> LuaE e [(a, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LuaE e [(a, b)]
remainingPairs
  LuaE e ()
forall e. LuaE e ()
pushnil
  LuaE e [(a, b)]
remainingPairs
    -- ensure the remaining key is removed from the stack on exception
    LuaE e [(a, b)] -> LuaE e () -> LuaE e [(a, b)]
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`Catch.onException` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
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 :: StackIndex -> LuaE e (Maybe (a, b))
nextPair StackIndex
idx = do
  Bool
hasNext <- StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Unsafe.next StackIndex
idx
  if Bool
hasNext
    then let pair :: LuaE e (a, b)
pair = (,) (a -> b -> (a, b)) -> LuaE e a -> LuaE e (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> LuaE e a -> LuaE e a
forall e a. PeekError e => [Char] -> LuaE e a -> LuaE e a
inContext [Char]
"Could not read key of key-value pair:"
                                      (StackIndex -> LuaE e a
forall a e. (Peekable a, PeekError e) => StackIndex -> LuaE e a
peek (CInt -> StackIndex
nth CInt
2))
                        LuaE e (b -> (a, b)) -> LuaE e b -> LuaE e (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> LuaE e b -> LuaE e b
forall e a. PeekError e => [Char] -> LuaE e a -> LuaE e a
inContext [Char]
"Could not read value of key-value pair:"
                                      (StackIndex -> LuaE e b
forall a e. (Peekable a, PeekError e) => StackIndex -> LuaE e a
peek (CInt -> StackIndex
nth CInt
1))
         in (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just ((a, b) -> Maybe (a, b)) -> LuaE e (a, b) -> LuaE e (Maybe (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LuaE e (a, b)
pair LuaE e (a, b) -> LuaE e () -> LuaE e (a, b)
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`Catch.finally` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
            -- removes the value, keeps the key
    else Maybe (a, b) -> LuaE e (Maybe (a, b))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, b)
forall a. Maybe a
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 :: [Char] -> LuaE e a -> LuaE e a
inContext [Char]
ctx LuaE e a
op = LuaE e a -> LuaE e (Either e a)
forall e a. Exception e => LuaE e a -> LuaE e (Either e a)
try LuaE e a
op LuaE e (Either e a) -> (Either e a -> LuaE e a) -> LuaE e a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Right a
x  -> a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
  Left (e
err :: e) -> e -> LuaE e a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Catch.throwM (e -> LuaE e a) -> e -> LuaE e a
forall a b. (a -> b) -> a -> b
$
    [Char] -> e
forall e. LuaError e => [Char] -> e
luaException @e ([Char]
ctx [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n\t" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ e -> [Char]
forall e. PeekError e => e -> [Char]
messageFromException e
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 :: Exception -> [Char]
messageFromException = Exception -> [Char]
Lua.exceptionMessage

--
-- Tuples
--

instance {-# OVERLAPPABLE #-}
  (Peekable a, Peekable b) =>
  Peekable (a, b)
 where
  peek :: StackIndex -> LuaE e (a, b)
peek = ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e (a, b))
-> StackIndex
-> LuaE e (a, b)
forall e a.
LuaError e =>
ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e a)
-> StackIndex
-> LuaE e a
typeChecked ByteString
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
istable ((StackIndex -> LuaE e (a, b)) -> StackIndex -> LuaE e (a, b))
-> (StackIndex -> LuaE e (a, b)) -> StackIndex -> LuaE e (a, b)
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx ->
    (,) (a -> b -> (a, b)) -> LuaE e a -> LuaE e (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Integer -> LuaE e a
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
1 LuaE e (b -> (a, b)) -> LuaE e b -> LuaE e (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e b
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
2

instance {-# OVERLAPPABLE #-}
  (Peekable a, Peekable b, Peekable c) =>
  Peekable (a, b, c)
 where
  peek :: StackIndex -> LuaE e (a, b, c)
peek = ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e (a, b, c))
-> StackIndex
-> LuaE e (a, b, c)
forall e a.
LuaError e =>
ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e a)
-> StackIndex
-> LuaE e a
typeChecked ByteString
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
istable ((StackIndex -> LuaE e (a, b, c))
 -> StackIndex -> LuaE e (a, b, c))
-> (StackIndex -> LuaE e (a, b, c))
-> StackIndex
-> LuaE e (a, b, c)
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx ->
    (,,) (a -> b -> c -> (a, b, c))
-> LuaE e a -> LuaE e (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Integer -> LuaE e a
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
1 LuaE e (b -> c -> (a, b, c)) -> LuaE e b -> LuaE e (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e b
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
2 LuaE e (c -> (a, b, c)) -> LuaE e c -> LuaE e (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e c
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
3

instance {-# OVERLAPPABLE #-}
  (Peekable a, Peekable b, Peekable c, Peekable d) =>
  Peekable (a, b, c, d)
 where
  peek :: StackIndex -> LuaE e (a, b, c, d)
peek = ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e (a, b, c, d))
-> StackIndex
-> LuaE e (a, b, c, d)
forall e a.
LuaError e =>
ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e a)
-> StackIndex
-> LuaE e a
typeChecked ByteString
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
istable ((StackIndex -> LuaE e (a, b, c, d))
 -> StackIndex -> LuaE e (a, b, c, d))
-> (StackIndex -> LuaE e (a, b, c, d))
-> StackIndex
-> LuaE e (a, b, c, d)
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx ->
    (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> LuaE e a -> LuaE e (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Integer -> LuaE e a
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
1 LuaE e (b -> c -> d -> (a, b, c, d))
-> LuaE e b -> LuaE e (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e b
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
2 LuaE e (c -> d -> (a, b, c, d))
-> LuaE e c -> LuaE e (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e c
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
3
          LuaE e (d -> (a, b, c, d)) -> LuaE e d -> LuaE e (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e d
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
4

instance {-# OVERLAPPABLE #-}
  (Peekable a, Peekable b, Peekable c, Peekable d, Peekable e) =>
  Peekable (a, b, c, d, e)
 where
  peek :: StackIndex -> LuaE e (a, b, c, d, e)
peek = ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e (a, b, c, d, e))
-> StackIndex
-> LuaE e (a, b, c, d, e)
forall e a.
LuaError e =>
ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e a)
-> StackIndex
-> LuaE e a
typeChecked ByteString
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
istable ((StackIndex -> LuaE e (a, b, c, d, e))
 -> StackIndex -> LuaE e (a, b, c, d, e))
-> (StackIndex -> LuaE e (a, b, c, d, e))
-> StackIndex
-> LuaE e (a, b, c, d, e)
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx ->
    (,,,,) (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> LuaE e a -> LuaE e (b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Integer -> LuaE e a
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
1 LuaE e (b -> c -> d -> e -> (a, b, c, d, e))
-> LuaE e b -> LuaE e (c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e b
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
2 LuaE e (c -> d -> e -> (a, b, c, d, e))
-> LuaE e c -> LuaE e (d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e c
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
3
           LuaE e (d -> e -> (a, b, c, d, e))
-> LuaE e d -> LuaE e (e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e d
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
4 LuaE e (e -> (a, b, c, d, e)) -> LuaE e e -> LuaE e (a, b, c, d, e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e e
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
5

instance {-# OVERLAPPABLE #-}
  (Peekable a, Peekable b, Peekable c, Peekable d, Peekable e, Peekable f) =>
  Peekable (a, b, c, d, e, f)
 where
  peek :: StackIndex -> LuaE e (a, b, c, d, e, f)
peek = ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e (a, b, c, d, e, f))
-> StackIndex
-> LuaE e (a, b, c, d, e, f)
forall e a.
LuaError e =>
ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e a)
-> StackIndex
-> LuaE e a
typeChecked ByteString
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
istable ((StackIndex -> LuaE e (a, b, c, d, e, f))
 -> StackIndex -> LuaE e (a, b, c, d, e, f))
-> (StackIndex -> LuaE e (a, b, c, d, e, f))
-> StackIndex
-> LuaE e (a, b, c, d, e, f)
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx ->
    (,,,,,) (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> LuaE e a -> LuaE e (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Integer -> LuaE e a
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
1 LuaE e (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> LuaE e b -> LuaE e (c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e b
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
2 LuaE e (c -> d -> e -> f -> (a, b, c, d, e, f))
-> LuaE e c -> LuaE e (d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e c
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
3
            LuaE e (d -> e -> f -> (a, b, c, d, e, f))
-> LuaE e d -> LuaE e (e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e d
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
4 LuaE e (e -> f -> (a, b, c, d, e, f))
-> LuaE e e -> LuaE e (f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e e
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
5 LuaE e (f -> (a, b, c, d, e, f))
-> LuaE e f -> LuaE e (a, b, c, d, e, f)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e f
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
6


instance {-# OVERLAPPABLE #-}
  (Peekable a, Peekable b, Peekable c, Peekable d,
   Peekable e, Peekable f, Peekable g) =>
  Peekable (a, b, c, d, e, f, g)
 where
  peek :: StackIndex -> LuaE e (a, b, c, d, e, f, g)
peek = ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e (a, b, c, d, e, f, g))
-> StackIndex
-> LuaE e (a, b, c, d, e, f, g)
forall e a.
LuaError e =>
ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e a)
-> StackIndex
-> LuaE e a
typeChecked ByteString
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
istable ((StackIndex -> LuaE e (a, b, c, d, e, f, g))
 -> StackIndex -> LuaE e (a, b, c, d, e, f, g))
-> (StackIndex -> LuaE e (a, b, c, d, e, f, g))
-> StackIndex
-> LuaE e (a, b, c, d, e, f, g)
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx ->
    (,,,,,,) (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> LuaE e a
-> LuaE e (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Integer -> LuaE e a
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
1 LuaE e (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> LuaE e b
-> LuaE e (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e b
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
2 LuaE e (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> LuaE e c -> LuaE e (d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e c
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
3
             LuaE e (d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> LuaE e d -> LuaE e (e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e d
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
4 LuaE e (e -> f -> g -> (a, b, c, d, e, f, g))
-> LuaE e e -> LuaE e (f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e e
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
5 LuaE e (f -> g -> (a, b, c, d, e, f, g))
-> LuaE e f -> LuaE e (g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e f
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
6
             LuaE e (g -> (a, b, c, d, e, f, g))
-> LuaE e g -> LuaE e (a, b, c, d, e, f, g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e g
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
7

instance {-# OVERLAPPABLE #-}
  (Peekable a, Peekable b, Peekable c, Peekable d,
   Peekable e, Peekable f, Peekable g, Peekable h) =>
  Peekable (a, b, c, d, e, f, g, h)
 where
  peek :: StackIndex -> LuaE e (a, b, c, d, e, f, g, h)
peek = ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e (a, b, c, d, e, f, g, h))
-> StackIndex
-> LuaE e (a, b, c, d, e, f, g, h)
forall e a.
LuaError e =>
ByteString
-> (StackIndex -> LuaE e Bool)
-> (StackIndex -> LuaE e a)
-> StackIndex
-> LuaE e a
typeChecked ByteString
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
istable ((StackIndex -> LuaE e (a, b, c, d, e, f, g, h))
 -> StackIndex -> LuaE e (a, b, c, d, e, f, g, h))
-> (StackIndex -> LuaE e (a, b, c, d, e, f, g, h))
-> StackIndex
-> LuaE e (a, b, c, d, e, f, g, h)
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx ->
    (,,,,,,,) (a -> b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> LuaE e a
-> LuaE
     e (b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Integer -> LuaE e a
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
1 LuaE
  e (b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> LuaE e b
-> LuaE e (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e b
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
2 LuaE e (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> LuaE e c
-> LuaE e (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e c
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
3
              LuaE e (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> LuaE e d
-> LuaE e (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e d
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
4 LuaE e (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> LuaE e e -> LuaE e (f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e e
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
5 LuaE e (f -> g -> h -> (a, b, c, d, e, f, g, h))
-> LuaE e f -> LuaE e (g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e f
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
6
              LuaE e (g -> h -> (a, b, c, d, e, f, g, h))
-> LuaE e g -> LuaE e (h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e g
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
7 LuaE e (h -> (a, b, c, d, e, f, g, h))
-> LuaE e h -> LuaE e (a, b, c, d, e, f, g, h)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> LuaE e h
forall e a.
(PeekError e, Peekable a) =>
StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
8

-- | Helper function to get the nth table value
nthValue :: (PeekError e, Peekable a)
         => StackIndex -> Lua.Integer -> LuaE e a
nthValue :: StackIndex -> Integer -> LuaE e a
nthValue StackIndex
idx Integer
n = do
  StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx Integer
n
  StackIndex -> LuaE e a
forall a e. (Peekable a, PeekError e) => StackIndex -> LuaE e a
peek StackIndex
top LuaE e a -> LuaE e () -> LuaE e a
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`Catch.finally` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1