{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module      : HsLua.Marshalling.Peekers
Copyright   : © 2020-2024 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>
Stability   : beta
Portability : Portable

Functions which unmarshal and retrieve Haskell values from Lua's stack.
-}
module HsLua.Marshalling.Peekers
  ( -- * Peeking values from the stack
    -- ** Primitives
    peekNil
  , peekNoneOrNil
  , peekBool
  , peekIntegral
  , peekRealFloat
    -- ** Strings
  , peekByteString
  , peekLazyByteString
  , peekString
  , peekText
  , peekStringy
  , peekName
  -- ** Readable types
  , peekRead
  -- ** Collections
  , peekKeyValuePairs
  , peekList
  , peekNonEmpty
  , peekMap
  , peekSet
  -- ** Combinators
  , choice
  , peekFieldRaw
  , peekIndexRaw
  , peekNilOr
  , peekNoneOr
  , peekNoneOrNilOr
  , peekPair
  , peekTriple
  -- ** Building peek functions
  , typeChecked
  , reportValueOnFailure
  , typeMismatchMessage
  ) where

import Control.Applicative (Alternative (..))
import Control.Monad ((<$!>), (>=>), void)
import Data.ByteString (ByteString)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Map (Map)
import Data.Set (Set)
import Data.String (IsString (fromString))
import HsLua.Core as Lua
import HsLua.Marshalling.Peek
import Text.Read (readMaybe)

import qualified Data.ByteString.Lazy as BL
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified HsLua.Core.Unsafe as Unsafe
import qualified HsLua.Core.Utf8 as Utf8

-- | 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. A successfully received value is wrapped
-- using the 'Right' constructor, while a type mismatch results
-- in @Left PeekError@ with the given error message.
typeChecked :: Name                         -- ^ expected type
            -> (StackIndex -> LuaE e Bool)  -- ^ pre-condition checker
            -> Peeker e a
            -> Peeker e a
typeChecked :: forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
expectedType StackIndex -> LuaE e Bool
test Peeker e a
peekfn StackIndex
idx = do
  Bool
v <- LuaE e Bool -> Peek e Bool
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Bool -> Peek e Bool) -> LuaE e Bool -> Peek e Bool
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e Bool
test StackIndex
idx
  if Bool
v
    then Peeker e a
peekfn StackIndex
idx
    else Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
expectedType StackIndex
idx Peek e ByteString -> (ByteString -> Peek e a) -> Peek e a
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Peek e a
forall a e. ByteString -> Peek e a
failPeek

-- | Generate a type mismatch error.
typeMismatchMessage :: Name       -- ^ expected type
                    -> StackIndex -- ^ index of offending value
                    -> Peek e ByteString
typeMismatchMessage :: forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage (Name ByteString
expected) StackIndex
idx = LuaE e ByteString -> Peek e ByteString
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e ByteString -> Peek e ByteString)
-> LuaE e ByteString -> Peek e ByteString
forall a b. (a -> b) -> a -> b
$ do
  ByteString -> StackIndex -> LuaE e ()
forall e. ByteString -> StackIndex -> LuaE e ()
pushTypeMismatchError ByteString
expected StackIndex
idx
  (StackIndex -> LuaE e (Maybe ByteString)
forall e. StackIndex -> LuaE e (Maybe ByteString)
tostring StackIndex
top LuaE e (Maybe ByteString) -> LuaE e () -> LuaE e (Maybe ByteString)
forall a b. LuaE e a -> LuaE e b -> LuaE e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1) LuaE e (Maybe ByteString)
-> (Maybe ByteString -> LuaE e ByteString) -> LuaE e ByteString
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just !ByteString
msg -> ByteString -> LuaE e ByteString
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
msg
    Maybe ByteString
Nothing  -> ByteString -> LuaE e ByteString
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> LuaE e ByteString)
-> ByteString -> LuaE e ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
      [ ByteString
"Unknown type mismatch for "
      , ByteString
expected
      , ByteString
" at stack index "
      , String -> ByteString
Utf8.fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ CInt -> String
forall a. Show a => a -> String
show (StackIndex -> CInt
fromStackIndex StackIndex
idx)
      ]

-- | Report the expected and actual type of the value under the given
-- index if conversion failed.
reportValueOnFailure :: Name         -- ^ expected type
                     -> (StackIndex -> LuaE e (Maybe a))
                     -> Peeker e a
reportValueOnFailure :: forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
expected StackIndex -> LuaE e (Maybe a)
peekMb StackIndex
idx = do
  Maybe a
res <- LuaE e (Maybe a) -> Peek e (Maybe a)
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e (Maybe a) -> Peek e (Maybe a))
-> LuaE e (Maybe a) -> Peek e (Maybe a)
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e (Maybe a)
peekMb StackIndex
idx
  case Maybe a
res of
    Just a
x  -> a -> Peek e a
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Peek e a) -> a -> Peek e a
forall a b. (a -> b) -> a -> b
$! a
x
    Maybe a
Nothing -> Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
expected StackIndex
idx Peek e ByteString -> (ByteString -> Peek e a) -> Peek e a
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Peek e a
forall a e. ByteString -> Peek e a
failPeek

--
-- Primitives
--

-- | Succeeds if the value at the given index is @nil@.
peekNil :: Peeker e ()
peekNil :: forall e. Peeker e ()
peekNil = Name -> (StackIndex -> LuaE e Bool) -> Peeker e () -> Peeker e ()
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"nil" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Lua.isnil (Peeker e () -> Peeker e ()) -> Peeker e () -> Peeker e ()
forall a b. (a -> b) -> a -> b
$ Peek e () -> Peeker e ()
forall a b. a -> b -> a
const (() -> Peek e ()
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINABLE peekNil #-}

-- | Succeeds if the given index is not valid or if the value at this
-- index is @nil@.
peekNoneOrNil :: Peeker e ()
peekNoneOrNil :: forall e. Peeker e ()
peekNoneOrNil = Name -> (StackIndex -> LuaE e Bool) -> Peeker e () -> Peeker e ()
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"none or nil" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Lua.isnoneornil (Peeker e () -> Peeker e ()) -> Peeker e () -> Peeker e ()
forall a b. (a -> b) -> a -> b
$ Peek e () -> Peeker e ()
forall a b. a -> b -> a
const (() -> Peek e ()
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINABLE peekNoneOrNil #-}

-- | Retrieves a 'Bool' as a Lua boolean.
peekBool :: Peeker e Bool
peekBool :: forall e. Peeker e Bool
peekBool = LuaE e Bool -> Peek e Bool
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Bool -> Peek e Bool)
-> (StackIndex -> LuaE e Bool) -> StackIndex -> Peek e Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
toboolean

--
-- Strings
--

-- | Like 'tostring', but ensures that the value at the given index is
-- not silently converted to a string, as would happen with numbers.
-- Also returns 'Nothing' if the value is a number and there is no stack
-- slot left on the Lua stack, which would be needed to convert the
-- number to a string without changing the original slot.
toByteString :: StackIndex -> LuaE e (Maybe ByteString)
toByteString :: forall e. StackIndex -> LuaE e (Maybe ByteString)
toByteString StackIndex
idx = do
  -- Do an explicit type check, as @tostring@ converts numbers strings
  -- /in-place/, which we need to avoid.
  StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx LuaE e Type
-> (Type -> LuaE e (Maybe ByteString)) -> LuaE e (Maybe ByteString)
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeString -> StackIndex -> LuaE e (Maybe ByteString)
forall e. StackIndex -> LuaE e (Maybe ByteString)
tostring StackIndex
idx
    Type
_          -> Int -> LuaE e Bool
forall e. Int -> LuaE e Bool
checkstack Int
1 LuaE e Bool
-> (Bool -> LuaE e (Maybe ByteString)) -> LuaE e (Maybe ByteString)
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
False -> Maybe ByteString -> LuaE e (Maybe ByteString)
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
      Bool
True  ->  do
        StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
idx
        StackIndex -> LuaE e (Maybe ByteString)
forall e. StackIndex -> LuaE e (Maybe ByteString)
tostring StackIndex
top LuaE e (Maybe ByteString) -> LuaE e () -> LuaE e (Maybe ByteString)
forall a b. LuaE e a -> LuaE e b -> LuaE e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
{-# INLINABLE toByteString #-}

-- | Retrieves a 'ByteString' as a raw string.
peekByteString :: Peeker e ByteString
peekByteString :: forall e. Peeker e ByteString
peekByteString = Name
-> (StackIndex -> LuaE e (Maybe ByteString)) -> Peeker e ByteString
forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
"string" StackIndex -> LuaE e (Maybe ByteString)
forall e. StackIndex -> LuaE e (Maybe ByteString)
toByteString
{-# INLINABLE peekByteString #-}

-- | Retrieves a lazy 'BL.ByteString' as a raw string.
peekLazyByteString :: Peeker e BL.ByteString
peekLazyByteString :: forall e. Peeker e ByteString
peekLazyByteString = (ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> Peek e ByteString -> Peek e ByteString
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) (Peek e ByteString -> Peek e ByteString)
-> (StackIndex -> Peek e ByteString)
-> StackIndex
-> Peek e ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e ByteString
forall e. Peeker e ByteString
peekByteString
{-# INLINABLE peekLazyByteString #-}

-- | Retrieves a 'String' from an UTF-8 encoded Lua string.
peekString :: Peeker e String
peekString :: forall e. Peeker e String
peekString = Peeker e String
forall a e. IsString a => Peeker e a
peekStringy
{-# INLINABLE peekString #-}

-- | Retrieves a String-like value from an UTF-8 encoded Lua string.
--
-- This should not be used to peek 'ByteString' values or other values
-- for which construction via 'fromString' can result in loss of
-- information.
peekStringy :: forall a e. IsString a => Peeker e a
peekStringy :: forall a e. IsString a => Peeker e a
peekStringy = (ByteString -> a) -> Peek e ByteString -> Peek e a
forall a b. (a -> b) -> Peek e a -> Peek e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> (ByteString -> String) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Utf8.toString) (Peek e ByteString -> Peek e a)
-> (StackIndex -> Peek e ByteString) -> StackIndex -> Peek e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e ByteString
forall e. Peeker e ByteString
peekByteString
{-# INLINABLE peekStringy #-}

-- | Retrieves a 'T.Text' value as an UTF-8 encoded string.
peekText :: Peeker e T.Text
peekText :: forall e. Peeker e Text
peekText = (ByteString -> Text
Utf8.toText (ByteString -> Text) -> Peek e ByteString -> Peek e Text
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) (Peek e ByteString -> Peek e Text)
-> (StackIndex -> Peek e ByteString) -> StackIndex -> Peek e Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e ByteString
forall e. Peeker e ByteString
peekByteString
{-# INLINABLE peekText #-}

-- | Retrieves a Lua string as 'Name'.
peekName :: Peeker e Name
peekName :: forall e. Peeker e Name
peekName = (ByteString -> Name
Name (ByteString -> Name) -> Peek e ByteString -> Peek e Name
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) (Peek e ByteString -> Peek e Name)
-> (StackIndex -> Peek e ByteString) -> StackIndex -> Peek e Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e ByteString
forall e. Peeker e ByteString
peekByteString
{-# INLINABLE peekName #-}

--
-- Arbitrary values
--

-- | Retrieves a value by getting a String from Lua, then using
-- 'readMaybe' to convert the String into a Haskell value.
peekRead :: forall a e. Read a => Peeker e a
peekRead :: forall a e. Read a => Peeker e a
peekRead = Peeker e String
forall e. Peeker e String
peekString Peeker e String -> (String -> Peek e a) -> StackIndex -> Peek e a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> Peek e a
forall {a} {e}. Read a => String -> Peek e a
readValue
  where
    readValue :: String -> Peek e a
readValue String
s = case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
s of
      Just a
x  -> a -> Peek e a
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
      Maybe a
Nothing -> ByteString -> Peek e a
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek e a) -> ByteString -> Peek e a
forall a b. (a -> b) -> a -> b
$ ByteString
"Could not read: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
Utf8.fromString String
s

--
-- Numbers
--

-- | Retrieves an 'Integral' value from the Lua stack.
peekIntegral :: forall a e. (Integral a, Read a) => Peeker e a
peekIntegral :: forall a e. (Integral a, Read a) => Peeker e a
peekIntegral StackIndex
idx = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e a) -> Peek e a
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeNumber  -> Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> a) -> Peek e Integer -> Peek e a
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>
                 Name -> (StackIndex -> LuaE e (Maybe Integer)) -> Peeker e Integer
forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
"Integral" StackIndex -> LuaE e (Maybe Integer)
forall e. StackIndex -> LuaE e (Maybe Integer)
tointeger StackIndex
idx
  Type
TypeString  -> do
    Just ByteString
str <- LuaE e (Maybe ByteString) -> Peek e (Maybe ByteString)
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e (Maybe ByteString) -> Peek e (Maybe ByteString))
-> LuaE e (Maybe ByteString) -> Peek e (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e (Maybe ByteString)
forall e. StackIndex -> LuaE e (Maybe ByteString)
tostring StackIndex
idx
    case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (ByteString -> String
Utf8.toString ByteString
str) of
      Maybe a
Nothing -> Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Integral" StackIndex
idx Peek e ByteString -> (ByteString -> Peek e a) -> Peek e a
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Peek e a
forall a e. ByteString -> Peek e a
failPeek
      Just a
x  -> a -> Peek e a
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
  Type
_ -> Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Integral" StackIndex
idx Peek e ByteString -> (ByteString -> Peek e a) -> Peek e a
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Peek e a
forall a e. ByteString -> Peek e a
failPeek

-- | Retrieve a 'RealFloat' (e.g., 'Float' or 'Double') from the stack.
peekRealFloat :: forall a e. (RealFloat a, Read a) => Peeker e a
peekRealFloat :: forall a e. (RealFloat a, Read a) => Peeker e a
peekRealFloat StackIndex
idx = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e a) -> Peek e a
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeString  -> do
    Just ByteString
str <- LuaE e (Maybe ByteString) -> Peek e (Maybe ByteString)
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e (Maybe ByteString) -> Peek e (Maybe ByteString))
-> LuaE e (Maybe ByteString) -> Peek e (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e (Maybe ByteString)
forall e. StackIndex -> LuaE e (Maybe ByteString)
tostring StackIndex
idx
    case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (ByteString -> String
Utf8.toString ByteString
str) of
      Maybe a
Nothing -> Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"RealFloat" StackIndex
idx Peek e ByteString -> (ByteString -> Peek e a) -> Peek e a
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Peek e a
forall a e. ByteString -> Peek e a
failPeek
      Just a
x  -> a -> Peek e a
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
  Type
_ -> Number -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Number -> a) -> Peek e Number -> Peek e a
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Name -> (StackIndex -> LuaE e (Maybe Number)) -> Peeker e Number
forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
"RealFloat" StackIndex -> LuaE e (Maybe Number)
forall e. StackIndex -> LuaE e (Maybe Number)
tonumber StackIndex
idx

-- | Reads a numerically indexed table @t@ into a list, where the 'length' of
-- the list is equal to @rawlen(t)@. The operation will fail unless all
-- numerical fields between @1@ and @rawlen(t)@ can be retrieved.
peekList :: forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList :: forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e a
peekElement = Name -> Peek e [a] -> Peek e [a]
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"list" (Peek e [a] -> Peek e [a])
-> (StackIndex -> Peek e [a]) -> StackIndex -> Peek e [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e a -> StackIndex -> Peek e [a]
forall e a. LuaError e => Peeker e a -> Peeker e [a]
peekList' Peeker e a
peekElement

-- | Like 'peekList', but fails if the list is empty.
peekNonEmpty :: LuaError e => Peeker e a -> Peeker e (NonEmpty a)
peekNonEmpty :: forall e a. LuaError e => Peeker e a -> Peeker e (NonEmpty a)
peekNonEmpty Peeker e a
peekElement = Name -> Peek e (NonEmpty a) -> Peek e (NonEmpty a)
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"NonEmpty" (Peek e (NonEmpty a) -> Peek e (NonEmpty a))
-> (StackIndex -> Peek e (NonEmpty a))
-> StackIndex
-> Peek e (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Peeker e a -> Peeker e [a]
forall e a. LuaError e => Peeker e a -> Peeker e [a]
peekList' Peeker e a
peekElement Peeker e [a]
-> ([a] -> Peek e (NonEmpty a))
-> StackIndex
-> Peek e (NonEmpty a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
    (a
x:[a]
xs) -> NonEmpty a -> Peek e (NonEmpty a)
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs)
    []     -> ByteString -> Peek e (NonEmpty a)
forall a e. ByteString -> Peek e a
failPeek ByteString
"empty list")

-- | Helper function that retrieves a list, but doesn't set a context.
peekList' :: LuaError e => Peeker e a -> Peeker e [a]
peekList' :: forall e a. LuaError e => Peeker e a -> Peeker e [a]
peekList' Peeker e a
peekElement = Name -> (StackIndex -> LuaE e Bool) -> Peeker e [a] -> Peeker e [a]
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] -> Peeker e [a]) -> Peeker e [a] -> Peeker e [a]
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> do
  LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e () -> Peek e ()) -> LuaE e () -> Peek e ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> LuaE e ()
forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
1 String
"retrieving a list"
  let elementsAt :: [Integer] -> Peek e [a]
elementsAt [] = [a] -> Peek e [a]
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      elementsAt (Integer
i : [Integer]
is) = do
        a
x  <- Name -> Peek e a -> Peek e a
forall e a. Name -> Peek e a -> Peek e a
retrieving (Name
"index " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Integer -> Name
forall {a}. IsString a => Integer -> a
showInt Integer
i) (Peek e a -> Peek e a) -> Peek e a -> Peek e a
forall a b. (a -> b) -> a -> b
$
              LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e Type
forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx Integer
i) Peek e Type -> Peek e a -> Peek e a
forall a b. Peek e a -> Peek e b -> Peek e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e a
peekElement StackIndex
top Peek e a -> LuaE e () -> Peek e a
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
        [a]
xs <- [Integer] -> Peek e [a]
elementsAt [Integer]
is
        [a] -> Peek e [a]
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
      showInt :: Integer -> a
showInt (Lua.Integer Int64
x) = String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ Int64 -> String
forall a. Show a => a -> String
show Int64
x
  Int
listLength <- LuaE e Int -> Peek e Int
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Int
forall e. StackIndex -> LuaE e Int
rawlen StackIndex
idx)
  [Integer] -> Peek e [a]
elementsAt [Integer
1..Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
listLength]

-- | Retrieves a key-value Lua table as 'Map'.
peekMap :: (LuaError e, Ord a)
        => Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap :: forall e a b.
(LuaError e, Ord a) =>
Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap Peeker e a
keyPeeker Peeker e b
valuePeeker = Name -> Peek e (Map a b) -> Peek e (Map a b)
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Map"
  (Peek e (Map a b) -> Peek e (Map a b))
-> (StackIndex -> Peek e (Map a b))
-> StackIndex
-> Peek e (Map a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, b)] -> Map a b) -> Peek e [(a, b)] -> Peek e (Map a b)
forall a b. (a -> b) -> Peek e a -> Peek e 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
Map.fromList
  (Peek e [(a, b)] -> Peek e (Map a b))
-> (StackIndex -> Peek e [(a, b)])
-> StackIndex
-> Peek e (Map a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e a -> Peeker e b -> StackIndex -> Peek e [(a, b)]
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs Peeker e a
keyPeeker Peeker e b
valuePeeker

-- | Read a table into a list of pairs.
peekKeyValuePairs :: LuaError e
                  => Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs :: forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs Peeker e a
keyPeeker Peeker e b
valuePeeker =
  Name
-> (StackIndex -> LuaE e Bool)
-> Peeker e [(a, b)]
-> Peeker e [(a, b)]
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)] -> Peeker e [(a, b)])
-> Peeker e [(a, b)] -> Peeker e [(a, b)]
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> Peek e [(a, b)] -> Peek e [(a, b)]
forall e a. Peek e a -> Peek e a
cleanup (Peek e [(a, b)] -> Peek e [(a, b)])
-> Peek e [(a, b)] -> Peek e [(a, b)]
forall a b. (a -> b) -> a -> b
$ do
    LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e () -> Peek e ()) -> LuaE e () -> Peek e ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> LuaE e ()
forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
2 String
"retrieving key-value pairs"
    StackIndex
idx' <- LuaE e StackIndex -> Peek e StackIndex
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e StackIndex -> Peek e StackIndex)
-> LuaE e StackIndex -> Peek e StackIndex
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
    let remainingPairs :: Peek e [(a, b)]
remainingPairs = Peeker e a -> Peeker e b -> Peeker e (Maybe (a, b))
forall e a b. Peeker e a -> Peeker e b -> Peeker e (Maybe (a, b))
nextPair Peeker e a
keyPeeker Peeker e b
valuePeeker StackIndex
idx' Peek e (Maybe (a, b))
-> (Maybe (a, b) -> Peek e [(a, b)]) -> Peek e [(a, b)]
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe (a, b)
Nothing -> [(a, b)] -> Peek e [(a, b)]
forall a. a -> Peek e a
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)]) -> Peek e [(a, b)] -> Peek e [(a, b)]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peek e [(a, b)]
remainingPairs
    LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua LuaE e ()
forall e. LuaE e ()
pushnil
    Peek e [(a, b)]
remainingPairs

-- | 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@. The next key, if it exists, is left at the top of
-- the stack.
--
-- The key must be either nil or must exist in the table, or this
-- function will crash with an unrecoverable error.
nextPair :: Peeker e a -> Peeker e b -> Peeker e (Maybe (a, b))
nextPair :: forall e a b. Peeker e a -> Peeker e b -> Peeker e (Maybe (a, b))
nextPair Peeker e a
keyPeeker Peeker e b
valuePeeker StackIndex
idx = Name -> Peek e (Maybe (a, b)) -> Peek e (Maybe (a, b))
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"key-value pair" (Peek e (Maybe (a, b)) -> Peek e (Maybe (a, b)))
-> Peek e (Maybe (a, b)) -> Peek e (Maybe (a, b))
forall a b. (a -> b) -> a -> b
$ do
  Bool
hasNext <- LuaE e Bool -> Peek e Bool
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Bool -> Peek e Bool) -> LuaE e Bool -> Peek e Bool
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Unsafe.next StackIndex
idx
  if Bool -> Bool
not Bool
hasNext
    then Maybe (a, b) -> Peek e (Maybe (a, b))
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, b)
forall a. Maybe a
Nothing
    else do
      a
key   <- Name -> Peek e a -> Peek e a
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"key"   (Peek e a -> Peek e a) -> Peek e a -> Peek e a
forall a b. (a -> b) -> a -> b
$ Peeker e a
keyPeeker   (CInt -> StackIndex
nth CInt
2)
      b
value <- Name -> Peek e b -> Peek e b
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"value" (Peek e b -> Peek e b) -> Peek e b -> Peek e b
forall a b. (a -> b) -> a -> b
$ Peeker e b
valuePeeker (CInt -> StackIndex
nth CInt
1)
      Maybe (a, b) -> Peek e (Maybe (a, b))
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
key, b
value))
        Peek e (Maybe (a, b)) -> LuaE e () -> Peek e (Maybe (a, b))
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1  -- remove value, leave the key

-- | Retrieves a 'Set' from an idiomatic Lua representation. A
-- set in Lua is idiomatically represented as a table with the
-- elements as keys. Elements with falsy values are omitted.
peekSet :: (LuaError e, Ord a) => Peeker e a -> Peeker e (Set a)
peekSet :: forall e a. (LuaError e, Ord a) => Peeker e a -> Peeker e (Set a)
peekSet Peeker e a
elementPeeker = Name -> Peek e (Set a) -> Peek e (Set a)
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Set"
  (Peek e (Set a) -> Peek e (Set a))
-> (StackIndex -> Peek e (Set a)) -> StackIndex -> Peek e (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, Bool)] -> Set a) -> Peek e [(a, Bool)] -> Peek e (Set a)
forall a b. (a -> b) -> Peek e a -> Peek e b
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)
  (Peek e [(a, Bool)] -> Peek e (Set a))
-> (StackIndex -> Peek e [(a, Bool)])
-> StackIndex
-> Peek e (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e a -> Peeker e Bool -> StackIndex -> Peek e [(a, Bool)]
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs Peeker e a
elementPeeker Peeker e Bool
forall e. Peeker e Bool
peekBool

--
-- Combinators
--

-- | Get value at key from a table.
peekFieldRaw :: LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw :: forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e a
peeker Name
name StackIndex
idx =
  Name -> Peek e a -> Peek e a
forall e a. Name -> Peek e a -> Peek e a
retrieving (Name
"raw field '" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
name Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"'") (Peek e a -> Peek e a) -> Peek e a -> Peek e a
forall a b. (a -> b) -> a -> b
$! do
    LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e () -> Peek e ()) -> LuaE e () -> Peek e ()
forall a b. (a -> b) -> a -> b
$ do
      Int -> String -> LuaE e ()
forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
1 String
"peekFieldRaw"
      StackIndex
absidx <- StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
Lua.absindex StackIndex
idx
      ByteString -> LuaE e ()
forall e. ByteString -> LuaE e ()
pushstring (ByteString -> LuaE e ()) -> ByteString -> LuaE e ()
forall a b. (a -> b) -> a -> b
$ Name -> ByteString
fromName Name
name
      LuaE e Type -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StackIndex -> LuaE e Type
forall e. LuaError e => StackIndex -> LuaE e Type
rawget StackIndex
absidx)
    Peeker e a
peeker StackIndex
top Peek e a -> LuaE e () -> Peek e a
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
1
{-# INLINABLE peekFieldRaw #-}

-- | Get value at integer index key from a table.
peekIndexRaw :: LuaError e => Lua.Integer -> Peeker e a -> Peeker e a
peekIndexRaw :: forall e a. LuaError e => Integer -> Peeker e a -> Peeker e a
peekIndexRaw Integer
i Peeker e a
peeker StackIndex
idx = do
  let showInt :: Integer -> a
showInt (Lua.Integer Int64
x) = String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ Int64 -> String
forall a. Show a => a -> String
show Int64
x
  Name -> Peek e a -> Peek e a
forall e a. Name -> Peek e a -> Peek e a
retrieving (String -> Name
forall a. IsString a => String -> a
fromString (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"raw index '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall {a}. IsString a => Integer -> a
showInt Integer
i String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'") (Peek e a -> Peek e a) -> Peek e a -> Peek e a
forall a b. (a -> b) -> a -> b
$! do
    LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e () -> Peek e ())
-> (LuaE e Type -> LuaE e ()) -> LuaE e Type -> Peek e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LuaE e Type -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e Type -> Peek e ()) -> LuaE e Type -> Peek e ()
forall a b. (a -> b) -> a -> b
$ StackIndex -> Integer -> LuaE e Type
forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx Integer
i
    Peeker e a
peeker StackIndex
top Peek e a -> LuaE e () -> Peek e a
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
1
{-# INLINABLE peekIndexRaw #-}


-- | Returns 'empty' if the value at the given index is @nil@;
-- otherwise returns the result of peeker @p@.
peekNilOr :: Alternative m
          => Peeker e a          -- ^ p
          -> Peeker e (m a)
peekNilOr :: forall (m :: * -> *) e a.
Alternative m =>
Peeker e a -> Peeker e (m a)
peekNilOr Peeker e a
p StackIndex
idx = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e (m a)) -> Peek e (m a)
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeNil  -> m a -> Peek e (m a)
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
  Type
_        -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> Peek e a -> Peek e (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker e a
p StackIndex
idx

-- | Returns 'empty' if the value at the given index is @none@;
-- otherwise returns the result of peeker @p@.
peekNoneOr :: Alternative m
           => Peeker e a          -- ^ p
           -> Peeker e (m a)
peekNoneOr :: forall (m :: * -> *) e a.
Alternative m =>
Peeker e a -> Peeker e (m a)
peekNoneOr Peeker e a
p StackIndex
idx = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e (m a)) -> Peek e (m a)
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeNone -> m a -> Peek e (m a)
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
  Type
_        -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> Peek e a -> Peek e (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker e a
p StackIndex
idx

-- | Returns 'empty' if the value at the given index is @none@ or
-- @nil@; otherwise returns the result of peeker @p@.
peekNoneOrNilOr :: Alternative m
                => Peeker e a          -- ^ p
                -> Peeker e (m a)
peekNoneOrNilOr :: forall (m :: * -> *) e a.
Alternative m =>
Peeker e a -> Peeker e (m a)
peekNoneOrNilOr Peeker e a
p StackIndex
idx = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e (m a)) -> Peek e (m a)
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeNil  -> m a -> Peek e (m a)
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
  Type
TypeNone -> m a -> Peek e (m a)
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
  Type
_        -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> Peek e a -> Peek e (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker e a
p StackIndex
idx

-- | Retrieves a value pair from a table. Expects the values to be
-- stored in a numerically indexed table; does not access metamethods.
peekPair :: LuaError e
         => Peeker e a -> Peeker e b
         -> Peeker e (a, b)
peekPair :: forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e a
peekA Peeker e b
peekB StackIndex
idx = Peek e (a, b) -> Peek e (a, b)
forall e a. Peek e a -> Peek e a
cleanup (Peek e (a, b) -> Peek e (a, b)) -> Peek e (a, b) -> Peek e (a, b)
forall a b. (a -> b) -> a -> b
$ do
  LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e () -> Peek e ()) -> LuaE e () -> Peek e ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> LuaE e ()
forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
2 String
"retrieving a pair"
  StackIndex
idx' <- LuaE e StackIndex -> Peek e StackIndex
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e StackIndex -> Peek e StackIndex)
-> LuaE e StackIndex -> Peek e StackIndex
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
  a
a <- LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e Type
forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx' Integer
1) Peek e Type -> Peek e a -> Peek e a
forall a b. Peek e a -> Peek e b -> Peek e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e a
peekA StackIndex
top
  b
b <- LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e Type
forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx' Integer
2) Peek e Type -> Peek e b -> Peek e b
forall a b. Peek e a -> Peek e b -> Peek e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e b
peekB StackIndex
top
  (a, b) -> Peek e (a, b)
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)

-- | Retrieves a value triple from a table. Expects the values to be
-- stored in a numerically indexed table, with no metamethods.
peekTriple :: LuaError e
           => Peeker e a -> Peeker e b -> Peeker e c
           -> Peeker e (a, b, c)
peekTriple :: 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
peekA Peeker e b
peekB Peeker e c
peekC StackIndex
idx = Peek e (a, b, c) -> Peek e (a, b, c)
forall e a. Peek e a -> Peek e a
cleanup (Peek e (a, b, c) -> Peek e (a, b, c))
-> Peek e (a, b, c) -> Peek e (a, b, c)
forall a b. (a -> b) -> a -> b
$ do
  LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e () -> Peek e ()) -> LuaE e () -> Peek e ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> LuaE e ()
forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
3 String
"retrieving a triple"
  StackIndex
idx' <- LuaE e StackIndex -> Peek e StackIndex
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e StackIndex -> Peek e StackIndex)
-> LuaE e StackIndex -> Peek e StackIndex
forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
  a
a <- LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e Type
forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx' Integer
1) Peek e Type -> Peek e a -> Peek e a
forall a b. Peek e a -> Peek e b -> Peek e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e a
peekA StackIndex
top
  b
b <- LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e Type
forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx' Integer
2) Peek e Type -> Peek e b -> Peek e b
forall a b. Peek e a -> Peek e b -> Peek e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e b
peekB StackIndex
top
  c
c <- LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e Type
forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx' Integer
3) Peek e Type -> Peek e c -> Peek e c
forall a b. Peek e a -> Peek e b -> Peek e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e c
peekC StackIndex
top
  (a, b, c) -> Peek e (a, b, c)
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b,c
c)

-- | Try all peekers and return the result of the first to succeed.
choice :: LuaError e
       => [Peeker e a]
       -> Peeker e a
choice :: forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice [Peeker e a]
peekers StackIndex
idx = case [Peeker e a]
peekers of
  [] -> ByteString -> Peek e a
forall a e. ByteString -> Peek e a
failPeek ByteString
"all choices failed"
  Peeker e a
p:[Peeker e a]
ps -> Peeker e a
p StackIndex
idx Peek e a -> Peek e a -> Peek e a
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Peeker e a] -> Peeker e a
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice [Peeker e a]
ps StackIndex
idx
{-# INLINABLE choice #-}