{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Foreign.Lua.Types.Peekable
( Peekable (..)
, peekKeyValuePairs
, peekList
, reportValueOnFailure
) where
import Data.ByteString (ByteString)
import Data.Map (Map, fromList)
import Data.Set (Set)
import Data.Monoid ((<>))
import Foreign.Lua.Core as Lua
import Foreign.Ptr (Ptr)
import Text.Read (readMaybe)
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 Foreign.Lua.Utf8 as Utf8
typeChecked :: String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua a)
-> StackIndex -> Lua a
typeChecked :: String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua a)
-> StackIndex
-> Lua a
typeChecked expectedType :: String
expectedType test :: StackIndex -> Lua Bool
test peekfn :: StackIndex -> Lua a
peekfn idx :: StackIndex
idx = do
Bool
v <- StackIndex -> Lua Bool
test StackIndex
idx
if Bool
v then StackIndex -> Lua a
peekfn StackIndex
idx else String -> StackIndex -> Lua a
forall a. String -> StackIndex -> Lua a
mismatchError String
expectedType StackIndex
idx
reportValueOnFailure :: String
-> (StackIndex -> Lua (Maybe a))
-> StackIndex -> Lua a
reportValueOnFailure :: String -> (StackIndex -> Lua (Maybe a)) -> StackIndex -> Lua a
reportValueOnFailure expected :: String
expected peekMb :: StackIndex -> Lua (Maybe a)
peekMb idx :: StackIndex
idx = do
Maybe a
res <- StackIndex -> Lua (Maybe a)
peekMb StackIndex
idx
case Maybe a
res of
(Just x :: a
x) -> a -> Lua a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
Nothing -> String -> StackIndex -> Lua a
forall a. String -> StackIndex -> Lua a
mismatchError String
expected StackIndex
idx
mismatchError :: String -> StackIndex -> Lua a
mismatchError :: String -> StackIndex -> Lua a
mismatchError expected :: String
expected idx :: StackIndex
idx = do
String
actualType <- StackIndex -> Lua Type
ltype StackIndex
idx Lua Type -> (Type -> Lua String) -> Lua String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Lua String
typename
String
actualValue <- ByteString -> String
Utf8.toString (ByteString -> String) -> Lua ByteString -> Lua String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua ByteString
tostring' StackIndex
idx Lua String -> Lua () -> Lua String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> Lua ()
pop 1
let msg :: String
msg = "expected " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
expected String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ", got '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
actualValue String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "' (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
actualType String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ")"
String -> Lua a
forall a. String -> Lua a
Lua.throwException String
msg
class Peekable a where
peek :: StackIndex -> Lua a
instance Peekable () where
peek :: StackIndex -> Lua ()
peek = String -> (StackIndex -> Lua (Maybe ())) -> StackIndex -> Lua ()
forall a.
String -> (StackIndex -> Lua (Maybe a)) -> StackIndex -> Lua a
reportValueOnFailure "nil" ((StackIndex -> Lua (Maybe ())) -> StackIndex -> Lua ())
-> (StackIndex -> Lua (Maybe ())) -> StackIndex -> Lua ()
forall a b. (a -> b) -> a -> b
$ \idx :: StackIndex
idx -> do
Bool
isNil <- StackIndex -> Lua Bool
isnil StackIndex
idx
Maybe () -> Lua (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 -> Lua Integer
peek = String
-> (StackIndex -> Lua (Maybe Integer)) -> StackIndex -> Lua Integer
forall a.
String -> (StackIndex -> Lua (Maybe a)) -> StackIndex -> Lua a
reportValueOnFailure "integer" StackIndex -> Lua (Maybe Integer)
tointeger
instance Peekable Lua.Number where
peek :: StackIndex -> Lua Number
peek = String
-> (StackIndex -> Lua (Maybe Number)) -> StackIndex -> Lua Number
forall a.
String -> (StackIndex -> Lua (Maybe a)) -> StackIndex -> Lua a
reportValueOnFailure "number" StackIndex -> Lua (Maybe Number)
tonumber
instance Peekable ByteString where
peek :: StackIndex -> Lua ByteString
peek = String
-> (StackIndex -> Lua (Maybe ByteString))
-> StackIndex
-> Lua ByteString
forall a.
String -> (StackIndex -> Lua (Maybe a)) -> StackIndex -> Lua a
reportValueOnFailure "string" ((StackIndex -> Lua (Maybe ByteString))
-> StackIndex -> Lua ByteString)
-> (StackIndex -> Lua (Maybe ByteString))
-> StackIndex
-> Lua ByteString
forall a b. (a -> b) -> a -> b
$ \idx :: StackIndex
idx -> do
StackIndex -> Lua ()
pushvalue StackIndex
idx
StackIndex -> Lua (Maybe ByteString)
tostring StackIndex
stackTop Lua (Maybe ByteString) -> Lua () -> Lua (Maybe ByteString)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> Lua ()
pop 1
instance Peekable Bool where
peek :: StackIndex -> Lua Bool
peek = StackIndex -> Lua Bool
toboolean
instance Peekable CFunction where
peek :: StackIndex -> Lua CFunction
peek = String
-> (StackIndex -> Lua (Maybe CFunction))
-> StackIndex
-> Lua CFunction
forall a.
String -> (StackIndex -> Lua (Maybe a)) -> StackIndex -> Lua a
reportValueOnFailure "C function" StackIndex -> Lua (Maybe CFunction)
tocfunction
instance Peekable (Ptr a) where
peek :: StackIndex -> Lua (Ptr a)
peek = String
-> (StackIndex -> Lua (Maybe (Ptr a))) -> StackIndex -> Lua (Ptr a)
forall a.
String -> (StackIndex -> Lua (Maybe a)) -> StackIndex -> Lua a
reportValueOnFailure "userdata" StackIndex -> Lua (Maybe (Ptr a))
forall a. StackIndex -> Lua (Maybe (Ptr a))
touserdata
instance Peekable Lua.State where
peek :: StackIndex -> Lua State
peek = String
-> (StackIndex -> Lua (Maybe State)) -> StackIndex -> Lua State
forall a.
String -> (StackIndex -> Lua (Maybe a)) -> StackIndex -> Lua a
reportValueOnFailure "Lua state (i.e., a thread)" StackIndex -> Lua (Maybe State)
tothread
instance Peekable T.Text where
peek :: StackIndex -> Lua Text
peek = (ByteString -> Text) -> Lua ByteString -> Lua Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
Utf8.toText (Lua ByteString -> Lua Text)
-> (StackIndex -> Lua ByteString) -> StackIndex -> Lua Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Lua ByteString
forall a. Peekable a => StackIndex -> Lua a
peek
instance Peekable BL.ByteString where
peek :: StackIndex -> Lua ByteString
peek = (ByteString -> ByteString) -> Lua ByteString -> Lua ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
BL.fromStrict (Lua ByteString -> Lua ByteString)
-> (StackIndex -> Lua ByteString) -> StackIndex -> Lua ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Lua ByteString
forall a. Peekable a => StackIndex -> Lua a
peek
instance Peekable Prelude.Integer where
peek :: StackIndex -> Lua Integer
peek = StackIndex -> Lua Integer
peekInteger
instance Peekable Int where
peek :: StackIndex -> Lua Int
peek = (Integer -> Int) -> Lua Integer -> Lua Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Lua Integer -> Lua Int)
-> (StackIndex -> Lua Integer) -> StackIndex -> Lua Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua Integer
peekInteger
instance Peekable Float where
peek :: StackIndex -> Lua Float
peek = StackIndex -> Lua Float
forall a. (Read a, RealFloat a) => StackIndex -> Lua a
peekRealFloat
instance Peekable Double where
peek :: StackIndex -> Lua Double
peek = StackIndex -> Lua Double
forall a. (Read a, RealFloat a) => StackIndex -> Lua a
peekRealFloat
instance {-# OVERLAPS #-} Peekable [Char] where
peek :: StackIndex -> Lua String
peek = (ByteString -> String) -> Lua ByteString -> Lua String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
Utf8.toString (Lua ByteString -> Lua String)
-> (StackIndex -> Lua ByteString) -> StackIndex -> Lua String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Lua ByteString
forall a. Peekable a => StackIndex -> Lua a
peek
instance Peekable a => Peekable [a] where
peek :: StackIndex -> Lua [a]
peek = StackIndex -> Lua [a]
forall a. Peekable a => StackIndex -> Lua [a]
peekList
instance (Ord a, Peekable a, Peekable b) => Peekable (Map a b) where
peek :: StackIndex -> Lua (Map a b)
peek = ([(a, b)] -> Map a b) -> Lua [(a, b)] -> Lua (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 (Lua [(a, b)] -> Lua (Map a b))
-> (StackIndex -> Lua [(a, b)]) -> StackIndex -> Lua (Map a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Lua [(a, b)]
forall a b. (Peekable a, Peekable b) => StackIndex -> Lua [(a, b)]
peekKeyValuePairs
instance (Ord a, Peekable a) => Peekable (Set a) where
peek :: StackIndex -> Lua (Set a)
peek =
([(a, Bool)] -> Set a) -> Lua [(a, Bool)] -> Lua (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) (Lua [(a, Bool)] -> Lua (Set a))
-> (StackIndex -> Lua [(a, Bool)]) -> StackIndex -> Lua (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Lua [(a, Bool)]
forall a b. (Peekable a, Peekable b) => StackIndex -> Lua [(a, b)]
peekKeyValuePairs
peekInteger :: StackIndex -> Lua Prelude.Integer
peekInteger :: StackIndex -> Lua Integer
peekInteger idx :: StackIndex
idx = StackIndex -> Lua Type
ltype StackIndex
idx Lua Type -> (Type -> Lua Integer) -> Lua Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TypeString -> do
String
s <- StackIndex -> Lua String
forall a. Peekable a => StackIndex -> Lua a
peek StackIndex
idx
case String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe String
s of
Just x :: Integer
x -> Integer -> Lua Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
x
Nothing -> String -> StackIndex -> Lua Integer
forall a. String -> StackIndex -> Lua a
mismatchError "integer" StackIndex
idx
_ -> Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Integer) -> Lua Integer -> Lua Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StackIndex -> Lua Integer
forall a. Peekable a => StackIndex -> Lua a
peek StackIndex
idx :: Lua Lua.Integer)
peekRealFloat :: (Read a, RealFloat a) => StackIndex -> Lua a
peekRealFloat :: StackIndex -> Lua a
peekRealFloat idx :: StackIndex
idx = StackIndex -> Lua Type
ltype StackIndex
idx Lua Type -> (Type -> Lua a) -> Lua a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TypeString -> do
String
s <- StackIndex -> Lua String
forall a. Peekable a => StackIndex -> Lua a
peek StackIndex
idx
case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
s of
Just x :: a
x -> a -> Lua a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
Nothing -> String -> StackIndex -> Lua a
forall a. String -> StackIndex -> Lua a
mismatchError "number" StackIndex
idx
_ -> Number -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Number -> a) -> Lua Number -> Lua a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StackIndex -> Lua Number
forall a. Peekable a => StackIndex -> Lua a
peek StackIndex
idx :: Lua Lua.Number)
peekList :: Peekable a => StackIndex -> Lua [a]
peekList :: StackIndex -> Lua [a]
peekList = String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua [a])
-> StackIndex
-> Lua [a]
forall a.
String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua a)
-> StackIndex
-> Lua a
typeChecked "table" StackIndex -> Lua Bool
istable ((StackIndex -> Lua [a]) -> StackIndex -> Lua [a])
-> (StackIndex -> Lua [a]) -> StackIndex -> Lua [a]
forall a b. (a -> b) -> a -> b
$ \idx :: StackIndex
idx -> do
let elementsAt :: [Integer] -> Lua [a]
elementsAt [] = [a] -> Lua [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
elementsAt (i :: Integer
i : is :: [Integer]
is) = do
a
x <- (StackIndex -> Integer -> Lua ()
rawgeti StackIndex
idx Integer
i Lua () -> Lua a -> Lua a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StackIndex -> Lua a
forall a. Peekable a => StackIndex -> Lua a
peek (CInt -> StackIndex
nthFromTop 1)) Lua a -> Lua () -> Lua a
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`Catch.finally` StackIndex -> Lua ()
pop 1
(a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> Lua [a] -> Lua [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer] -> Lua [a]
elementsAt [Integer]
is
Integer
listLength <- Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Lua Int -> Lua Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua Int
rawlen StackIndex
idx
String -> Lua [a] -> Lua [a]
forall a. String -> Lua a -> Lua a
inContext "Could not read list: " ([Integer] -> Lua [a]
forall a. Peekable a => [Integer] -> Lua [a]
elementsAt [1..Integer
listLength])
peekKeyValuePairs :: (Peekable a, Peekable b)
=> StackIndex -> Lua [(a, b)]
peekKeyValuePairs :: StackIndex -> Lua [(a, b)]
peekKeyValuePairs = String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua [(a, b)])
-> StackIndex
-> Lua [(a, b)]
forall a.
String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua a)
-> StackIndex
-> Lua a
typeChecked "table" StackIndex -> Lua Bool
istable ((StackIndex -> Lua [(a, b)]) -> StackIndex -> Lua [(a, b)])
-> (StackIndex -> Lua [(a, b)]) -> StackIndex -> Lua [(a, b)]
forall a b. (a -> b) -> a -> b
$ \idx :: StackIndex
idx -> do
let remainingPairs :: Lua [(a, b)]
remainingPairs = do
Maybe (a, b)
res <- StackIndex -> Lua (Maybe (a, b))
forall a b.
(Peekable a, Peekable b) =>
StackIndex -> Lua (Maybe (a, b))
nextPair (if StackIndex
idx StackIndex -> StackIndex -> Bool
forall a. Ord a => a -> a -> Bool
< 0 then StackIndex
idx StackIndex -> StackIndex -> StackIndex
forall a. Num a => a -> a -> a
- 1 else StackIndex
idx)
case Maybe (a, b)
res of
Nothing -> [] [(a, b)] -> Lua () -> Lua [(a, b)]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ () -> Lua ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just a :: (a, b)
a -> ((a, b)
a(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:) ([(a, b)] -> [(a, b)]) -> Lua [(a, b)] -> Lua [(a, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua [(a, b)]
remainingPairs
Lua ()
pushnil
Lua [(a, b)]
remainingPairs
Lua [(a, b)] -> Lua () -> Lua [(a, b)]
forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`Catch.onException` StackIndex -> Lua ()
pop 1
nextPair :: (Peekable a, Peekable b)
=> StackIndex -> Lua (Maybe (a, b))
nextPair :: StackIndex -> Lua (Maybe (a, b))
nextPair idx :: StackIndex
idx = do
Bool
hasNext <- StackIndex -> Lua Bool
next StackIndex
idx
if Bool
hasNext
then let pair :: Lua (a, b)
pair = (,) (a -> b -> (a, b)) -> Lua a -> Lua (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Lua a -> Lua a
forall a. String -> Lua a -> Lua a
inContext "Could not read key of key-value pair: "
(StackIndex -> Lua a
forall a. Peekable a => StackIndex -> Lua a
peek (CInt -> StackIndex
nthFromTop 2))
Lua (b -> (a, b)) -> Lua b -> Lua (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Lua b -> Lua b
forall a. String -> Lua a -> Lua a
inContext "Could not read value of key-value pair: "
(StackIndex -> Lua b
forall a. Peekable a => StackIndex -> Lua a
peek (CInt -> StackIndex
nthFromTop 1))
in (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just ((a, b) -> Maybe (a, b)) -> Lua (a, b) -> Lua (Maybe (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua (a, b)
pair Lua (a, b) -> Lua () -> Lua (a, b)
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`Catch.finally` StackIndex -> Lua ()
pop 1
else Maybe (a, b) -> Lua (Maybe (a, b))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, b)
forall a. Maybe a
Nothing
inContext :: String -> Lua a -> Lua a
inContext :: String -> Lua a -> Lua a
inContext ctx :: String
ctx = (String -> String) -> Lua a -> Lua a
forall a. (String -> String) -> Lua a -> Lua a
Lua.withExceptionMessage (String
ctx String -> String -> String
forall a. Semigroup a => a -> a -> a
<>)
instance (Peekable a, Peekable b) => Peekable (a, b) where
peek :: StackIndex -> Lua (a, b)
peek = String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua (a, b))
-> StackIndex
-> Lua (a, b)
forall a.
String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua a)
-> StackIndex
-> Lua a
typeChecked "table" StackIndex -> Lua Bool
istable ((StackIndex -> Lua (a, b)) -> StackIndex -> Lua (a, b))
-> (StackIndex -> Lua (a, b)) -> StackIndex -> Lua (a, b)
forall a b. (a -> b) -> a -> b
$ \idx :: StackIndex
idx ->
(,) (a -> b -> (a, b)) -> Lua a -> Lua (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Integer -> Lua a
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 1 Lua (b -> (a, b)) -> Lua b -> Lua (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua b
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 2
instance (Peekable a, Peekable b, Peekable c) =>
Peekable (a, b, c)
where
peek :: StackIndex -> Lua (a, b, c)
peek = String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua (a, b, c))
-> StackIndex
-> Lua (a, b, c)
forall a.
String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua a)
-> StackIndex
-> Lua a
typeChecked "table" StackIndex -> Lua Bool
istable ((StackIndex -> Lua (a, b, c)) -> StackIndex -> Lua (a, b, c))
-> (StackIndex -> Lua (a, b, c)) -> StackIndex -> Lua (a, b, c)
forall a b. (a -> b) -> a -> b
$ \idx :: StackIndex
idx ->
(,,) (a -> b -> c -> (a, b, c)) -> Lua a -> Lua (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Integer -> Lua a
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 1 Lua (b -> c -> (a, b, c)) -> Lua b -> Lua (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua b
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 2 Lua (c -> (a, b, c)) -> Lua c -> Lua (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua c
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 3
instance (Peekable a, Peekable b, Peekable c, Peekable d) =>
Peekable (a, b, c, d)
where
peek :: StackIndex -> Lua (a, b, c, d)
peek = String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua (a, b, c, d))
-> StackIndex
-> Lua (a, b, c, d)
forall a.
String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua a)
-> StackIndex
-> Lua a
typeChecked "table" StackIndex -> Lua Bool
istable ((StackIndex -> Lua (a, b, c, d))
-> StackIndex -> Lua (a, b, c, d))
-> (StackIndex -> Lua (a, b, c, d))
-> StackIndex
-> Lua (a, b, c, d)
forall a b. (a -> b) -> a -> b
$ \idx :: StackIndex
idx ->
(,,,) (a -> b -> c -> d -> (a, b, c, d))
-> Lua a -> Lua (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Integer -> Lua a
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 1 Lua (b -> c -> d -> (a, b, c, d))
-> Lua b -> Lua (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua b
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 2 Lua (c -> d -> (a, b, c, d)) -> Lua c -> Lua (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua c
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 3
Lua (d -> (a, b, c, d)) -> Lua d -> Lua (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua d
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 4
instance (Peekable a, Peekable b, Peekable c,
Peekable d, Peekable e) =>
Peekable (a, b, c, d, e)
where
peek :: StackIndex -> Lua (a, b, c, d, e)
peek = String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua (a, b, c, d, e))
-> StackIndex
-> Lua (a, b, c, d, e)
forall a.
String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua a)
-> StackIndex
-> Lua a
typeChecked "table" StackIndex -> Lua Bool
istable ((StackIndex -> Lua (a, b, c, d, e))
-> StackIndex -> Lua (a, b, c, d, e))
-> (StackIndex -> Lua (a, b, c, d, e))
-> StackIndex
-> Lua (a, b, c, d, e)
forall a b. (a -> b) -> a -> b
$ \idx :: StackIndex
idx ->
(,,,,) (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> Lua a -> Lua (b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Integer -> Lua a
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 1 Lua (b -> c -> d -> e -> (a, b, c, d, e))
-> Lua b -> Lua (c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua b
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 2 Lua (c -> d -> e -> (a, b, c, d, e))
-> Lua c -> Lua (d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua c
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 3
Lua (d -> e -> (a, b, c, d, e))
-> Lua d -> Lua (e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua d
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 4 Lua (e -> (a, b, c, d, e)) -> Lua e -> Lua (a, b, c, d, e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua e
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 5
instance (Peekable a, Peekable b, Peekable c,
Peekable d, Peekable e, Peekable f) =>
Peekable (a, b, c, d, e, f)
where
peek :: StackIndex -> Lua (a, b, c, d, e, f)
peek = String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua (a, b, c, d, e, f))
-> StackIndex
-> Lua (a, b, c, d, e, f)
forall a.
String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua a)
-> StackIndex
-> Lua a
typeChecked "table" StackIndex -> Lua Bool
istable ((StackIndex -> Lua (a, b, c, d, e, f))
-> StackIndex -> Lua (a, b, c, d, e, f))
-> (StackIndex -> Lua (a, b, c, d, e, f))
-> StackIndex
-> Lua (a, b, c, d, e, f)
forall a b. (a -> b) -> a -> b
$ \idx :: StackIndex
idx ->
(,,,,,) (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> Lua a -> Lua (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 -> Lua a
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 1 Lua (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> Lua b -> Lua (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 -> Lua b
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 2 Lua (c -> d -> e -> f -> (a, b, c, d, e, f))
-> Lua c -> Lua (d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua c
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 3
Lua (d -> e -> f -> (a, b, c, d, e, f))
-> Lua d -> Lua (e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua d
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 4 Lua (e -> f -> (a, b, c, d, e, f))
-> Lua e -> Lua (f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua e
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 5 Lua (f -> (a, b, c, d, e, f)) -> Lua f -> Lua (a, b, c, d, e, f)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua f
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 6
instance (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 -> Lua (a, b, c, d, e, f, g)
peek = String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua (a, b, c, d, e, f, g))
-> StackIndex
-> Lua (a, b, c, d, e, f, g)
forall a.
String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua a)
-> StackIndex
-> Lua a
typeChecked "table" StackIndex -> Lua Bool
istable ((StackIndex -> Lua (a, b, c, d, e, f, g))
-> StackIndex -> Lua (a, b, c, d, e, f, g))
-> (StackIndex -> Lua (a, b, c, d, e, f, g))
-> StackIndex
-> Lua (a, b, c, d, e, f, g)
forall a b. (a -> b) -> a -> b
$ \idx :: StackIndex
idx ->
(,,,,,,) (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Lua a
-> Lua (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 -> Lua a
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 1 Lua (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Lua b -> Lua (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 -> Lua b
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 2 Lua (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Lua c -> Lua (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 -> Lua c
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 3
Lua (d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Lua d -> Lua (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 -> Lua d
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 4 Lua (e -> f -> g -> (a, b, c, d, e, f, g))
-> Lua e -> Lua (f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua e
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 5 Lua (f -> g -> (a, b, c, d, e, f, g))
-> Lua f -> Lua (g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua f
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 6
Lua (g -> (a, b, c, d, e, f, g))
-> Lua g -> Lua (a, b, c, d, e, f, g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua g
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 7
instance (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 -> Lua (a, b, c, d, e, f, g, h)
peek = String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua (a, b, c, d, e, f, g, h))
-> StackIndex
-> Lua (a, b, c, d, e, f, g, h)
forall a.
String
-> (StackIndex -> Lua Bool)
-> (StackIndex -> Lua a)
-> StackIndex
-> Lua a
typeChecked "table" StackIndex -> Lua Bool
istable ((StackIndex -> Lua (a, b, c, d, e, f, g, h))
-> StackIndex -> Lua (a, b, c, d, e, f, g, h))
-> (StackIndex -> Lua (a, b, c, d, e, f, g, h))
-> StackIndex
-> Lua (a, b, c, d, e, f, g, h)
forall a b. (a -> b) -> a -> b
$ \idx :: StackIndex
idx ->
(,,,,,,,) (a -> b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Lua a
-> Lua
(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 -> Lua a
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 1 Lua (b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Lua b
-> Lua (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 -> Lua b
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 2 Lua (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Lua c -> Lua (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 -> Lua c
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 3
Lua (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Lua d -> Lua (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 -> Lua d
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 4 Lua (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Lua e -> Lua (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 -> Lua e
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 5 Lua (f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Lua f -> Lua (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 -> Lua f
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 6
Lua (g -> h -> (a, b, c, d, e, f, g, h))
-> Lua g -> Lua (h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua g
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 7 Lua (h -> (a, b, c, d, e, f, g, h))
-> Lua h -> Lua (a, b, c, d, e, f, g, h)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackIndex -> Integer -> Lua h
forall a. Peekable a => StackIndex -> Integer -> Lua a
nthValue StackIndex
idx 8
nthValue :: Peekable a => StackIndex -> Lua.Integer -> Lua a
nthValue :: StackIndex -> Integer -> Lua a
nthValue idx :: StackIndex
idx n :: Integer
n = do
StackIndex -> Integer -> Lua ()
rawgeti StackIndex
idx Integer
n
StackIndex -> Lua a
forall a. Peekable a => StackIndex -> Lua a
peek (-1) Lua a -> Lua () -> Lua a
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`Catch.finally` StackIndex -> Lua ()
pop 1