{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module      : HsLua.Class.Peekable
Copyright   : © 2007–2012 Gracjan Polak;
              © 2012–2016 Ömer Sinan Ağacan;
              © 2017-2022 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 (..)
  , peek
  ) where

import Data.Map (Map)
import Data.Set (Set)
import Data.Text (Text)
import HsLua.Core as Lua
import HsLua.Marshalling
import Foreign.Ptr (Ptr)

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified HsLua.Marshalling.Peekers as Peekers

-- | A value that can be read from the Lua stack.
class Peekable a where
  -- | 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 :: StackIndex -> LuaE e a
peek = Peek e a -> LuaE e a
forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek (Peek e a -> LuaE e a)
-> (StackIndex -> Peek e a) -> StackIndex -> LuaE e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e a
forall a e. (Peekable a, LuaError e) => Peeker e a
safepeek

instance Peekable () where
  safepeek :: Peeker e ()
safepeek = Peeker e ()
forall e. Peeker e ()
peekNil

instance Peekable Lua.Integer where
  safepeek :: Peeker e Integer
safepeek = Name -> (StackIndex -> LuaE e (Maybe Integer)) -> Peeker e Integer
forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
"integer" StackIndex -> LuaE e (Maybe Integer)
forall e. StackIndex -> LuaE e (Maybe Integer)
tointeger

instance Peekable Lua.Number where
  safepeek :: Peeker e Number
safepeek = Name -> (StackIndex -> LuaE e (Maybe Number)) -> Peeker e Number
forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
"number" StackIndex -> LuaE e (Maybe Number)
forall e. StackIndex -> LuaE e (Maybe Number)
tonumber

instance Peekable B.ByteString where
  safepeek :: Peeker e ByteString
safepeek = Peeker e ByteString
forall e. Peeker e ByteString
peekByteString

instance Peekable Bool where
  safepeek :: Peeker e Bool
safepeek = Peeker e Bool
forall e. Peeker e Bool
peekBool

instance Peekable CFunction where
  safepeek :: Peeker e CFunction
safepeek = Name
-> (StackIndex -> LuaE e (Maybe CFunction)) -> Peeker e CFunction
forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
"C function" StackIndex -> LuaE e (Maybe CFunction)
forall e. StackIndex -> LuaE e (Maybe CFunction)
tocfunction

instance Peekable (Ptr a) where
  safepeek :: Peeker e (Ptr a)
safepeek = Name -> (StackIndex -> LuaE e (Maybe (Ptr a))) -> Peeker e (Ptr a)
forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
"userdata" StackIndex -> LuaE e (Maybe (Ptr a))
forall e a. StackIndex -> LuaE e (Maybe (Ptr a))
touserdata

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

instance Peekable Text where
  safepeek :: Peeker e Text
safepeek = Peeker e Text
forall e. Peeker e Text
peekText

instance Peekable BL.ByteString where
  safepeek :: Peeker e ByteString
safepeek = Peeker e ByteString
forall e. Peeker e ByteString
peekLazyByteString

instance Peekable Prelude.Integer where
  safepeek :: Peeker e Integer
safepeek = Peeker e Integer
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral

instance Peekable Int where
  safepeek :: Peeker e Int
safepeek = Peeker e Int
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral

instance Peekable Float where
  safepeek :: Peeker e Float
safepeek = Peeker e Float
forall a e. (RealFloat a, Read a) => Peeker e a
peekRealFloat

instance Peekable Double where
  safepeek :: Peeker e Double
safepeek = Peeker e Double
forall a e. (RealFloat a, Read a) => Peeker e a
peekRealFloat

instance {-# OVERLAPS #-} Peekable [Char] where
  safepeek :: Peeker e [Char]
safepeek = Peeker e [Char]
forall e. Peeker e [Char]
peekString

instance Peekable a => Peekable [a] where
  safepeek :: Peeker e [a]
safepeek = Peeker e a -> Peeker e [a]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e a
forall a e. (Peekable a, LuaError e) => Peeker e a
safepeek

instance (Ord a, Peekable a, Peekable b) => Peekable (Map a b) where
  safepeek :: Peeker e (Map a b)
safepeek = Peeker e a -> Peeker e b -> Peeker e (Map a b)
forall e a b.
(LuaError e, Ord a) =>
Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap Peeker e a
forall a e. (Peekable a, LuaError e) => Peeker e a
safepeek Peeker e b
forall a e. (Peekable a, LuaError e) => Peeker e a
safepeek

instance (Ord a, Peekable a) => Peekable (Set a) where
  safepeek :: Peeker e (Set a)
safepeek = Peeker e a -> Peeker e (Set a)
forall e a. (LuaError e, Ord a) => Peeker e a -> Peeker e (Set a)
peekSet Peeker e a
forall a e. (Peekable a, LuaError e) => Peeker e a
safepeek

--
-- Tuples
--

instance {-# OVERLAPPABLE #-}
  (Peekable a, Peekable b) =>
  Peekable (a, b)
 where
  safepeek :: Peeker e (a, b)
safepeek = Peeker e a -> Peeker e b -> Peeker e (a, b)
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e a
forall a e. (Peekable a, LuaError e) => Peeker e a
safepeek Peeker e b
forall a e. (Peekable a, LuaError e) => Peeker e a
safepeek

instance {-# OVERLAPPABLE #-}
  (Peekable a, Peekable b, Peekable c) =>
  Peekable (a, b, c)
 where
  safepeek :: Peeker e (a, b, c)
safepeek = Peeker e a -> Peeker e b -> Peeker e c -> Peeker e (a, b, c)
forall e a b c.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e c -> Peeker e (a, b, c)
peekTriple Peeker e a
forall a e. (Peekable a, LuaError e) => Peeker e a
safepeek Peeker e b
forall a e. (Peekable a, LuaError e) => Peeker e a
safepeek Peeker e c
forall a e. (Peekable a, LuaError e) => Peeker e a
safepeek

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

-- | Helper function to get the nth table value
nthValue :: (LuaError e, Peekable a)
         => StackIndex -> Lua.Integer -> Peek e a
nthValue :: StackIndex -> Integer -> Peek e a
nthValue StackIndex
idx Integer
n = Integer -> Peeker e a -> Peeker e a
forall e a. LuaError e => Integer -> Peeker e a -> Peeker e a
Peekers.peekIndexRaw Integer
n Peeker e a
forall a e. (Peekable a, LuaError e) => Peeker e a
safepeek StackIndex
idx