{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module      : HsLua.Marshalling.Peekers
Copyright   : © 2020-2023 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 <- forall e a. LuaE e a -> Peek e a
liftLua 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 forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
expectedType StackIndex
idx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 = forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ do
  forall e. ByteString -> StackIndex -> LuaE e ()
pushTypeMismatchError ByteString
expected StackIndex
idx
  (forall e. StackIndex -> LuaE e (Maybe ByteString)
tostring StackIndex
top forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e. Int -> LuaE e ()
pop Int
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just !ByteString
msg -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
msg
    Maybe ByteString
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [ ByteString
"Unknown type mismatch for "
      , ByteString
expected
      , ByteString
" at stack index "
      , String -> ByteString
Utf8.fromString forall a b. (a -> b) -> a -> b
$ 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 <- forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ StackIndex -> LuaE e (Maybe a)
peekMb StackIndex
idx
  case Maybe a
res of
    Just a
x  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a
x
    Maybe a
Nothing -> forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
expected StackIndex
idx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 = forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"nil" forall e. StackIndex -> LuaE e Bool
Lua.isnil forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (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 = forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"none or nil" forall e. StackIndex -> LuaE e Bool
Lua.isnoneornil forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (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 = forall e a. LuaE e a -> Peek e a
liftLua forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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.
  forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeString -> forall e. StackIndex -> LuaE e (Maybe ByteString)
tostring StackIndex
idx
    Type
_          -> forall e. Int -> LuaE e Bool
checkstack Int
1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
      Bool
True  ->  do
        forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
idx
        forall e. StackIndex -> LuaE e (Maybe ByteString)
tostring StackIndex
top forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 = forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
"string" 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 forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Utf8.toString) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall e. Peeker e String
peekString forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall {a} {e}. Read a => String -> Peek e a
readValue
  where
    readValue :: String -> Peek e a
readValue String
s = case forall a. Read a => String -> Maybe a
readMaybe String
s of
      Just a
x  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
      Maybe a
Nothing -> forall a e. ByteString -> Peek e a
failPeek forall a b. (a -> b) -> a -> b
$ ByteString
"Could not read: " 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 = forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeNumber  -> forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>
                 forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
"Integral" forall e. StackIndex -> LuaE e (Maybe Integer)
tointeger StackIndex
idx
  Type
TypeString  -> do
    Just ByteString
str <- forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. StackIndex -> LuaE e (Maybe ByteString)
tostring StackIndex
idx
    case forall a. Read a => String -> Maybe a
readMaybe (ByteString -> String
Utf8.toString ByteString
str) of
      Maybe a
Nothing -> forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Integral" StackIndex
idx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a e. ByteString -> Peek e a
failPeek
      Just a
x  -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
  Type
_ -> forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Integral" StackIndex
idx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 = forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeString  -> do
    Just ByteString
str <- forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. StackIndex -> LuaE e (Maybe ByteString)
tostring StackIndex
idx
    case forall a. Read a => String -> Maybe a
readMaybe (ByteString -> String
Utf8.toString ByteString
str) of
      Maybe a
Nothing -> forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"RealFloat" StackIndex
idx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a e. ByteString -> Peek e a
failPeek
      Just a
x  -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
  Type
_ -> forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
"RealFloat" 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 = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"list" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"NonEmpty" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (forall e a. LuaError e => Peeker e a -> Peeker e [a]
peekList' Peeker e a
peekElement forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
    (a
x:[a]
xs) -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
x forall a. a -> [a] -> NonEmpty a
:| [a]
xs)
    []     -> 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 = forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" forall e. StackIndex -> LuaE e Bool
istable forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> do
  forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
1 String
"retrieving a list"
  let elementsAt :: [Integer] -> Peek e [a]
elementsAt [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
      elementsAt (Integer
i : [Integer]
is) = do
        a
x  <- forall e a. Name -> Peek e a -> Peek e a
retrieving (Name
"index " forall a. Semigroup a => a -> a -> a
<> forall {a}. IsString a => Integer -> a
showInt Integer
i) forall a b. (a -> b) -> a -> b
$
              forall e a. LuaE e a -> Peek e a
liftLua (forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx Integer
i) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e a
peekElement StackIndex
top forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` forall e. Int -> LuaE e ()
pop Int
1
        [a]
xs <- [Integer] -> Peek e [a]
elementsAt [Integer]
is
        forall (m :: * -> *) a. Monad m => a -> m a
return (a
xforall a. a -> [a] -> [a]
:[a]
xs)
      showInt :: Integer -> a
showInt (Lua.Integer Int64
x) = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int64
x
  Int
listLength <- forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Int
rawlen StackIndex
idx)
  [Integer] -> Peek e [a]
elementsAt [Integer
1..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 = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Map"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
  forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" forall e. StackIndex -> LuaE e Bool
istable forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> forall e a. Peek e a -> Peek e a
cleanup forall a b. (a -> b) -> a -> b
$ do
    forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
2 String
"retrieving key-value pairs"
    StackIndex
idx' <- forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
    let remainingPairs :: Peek e [(a, b)]
remainingPairs = 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' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe (a, b)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
          Just (a, b)
a  -> ((a, b)
aforall a. a -> [a] -> [a]
:) forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peek e [(a, b)]
remainingPairs
    forall e a. LuaE e a -> Peek e a
liftLua 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 = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"key-value pair" forall a b. (a -> b) -> a -> b
$ do
  Bool
hasNext <- forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. StackIndex -> LuaE e Bool
Unsafe.next StackIndex
idx
  if Bool -> Bool
not Bool
hasNext
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    else do
      a
key   <- forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"key"   forall a b. (a -> b) -> a -> b
$ Peeker e a
keyPeeker   (CInt -> StackIndex
nth CInt
2)
      b
value <- forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"value" forall a b. (a -> b) -> a -> b
$ Peeker e b
valuePeeker (CInt -> StackIndex
nth CInt
1)
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (a
key, b
value))
        forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` 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 = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Set"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a, b) -> b
snd)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs Peeker e a
elementPeeker 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 =
  forall e a. Name -> Peek e a -> Peek e a
retrieving (Name
"raw field '" forall a. Semigroup a => a -> a -> a
<> Name
name forall a. Semigroup a => a -> a -> a
<> Name
"'") forall a b. (a -> b) -> a -> b
$! do
    forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ do
      forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
1 String
"peekFieldRaw"
      StackIndex
absidx <- forall e. StackIndex -> LuaE e StackIndex
Lua.absindex StackIndex
idx
      forall e. ByteString -> LuaE e ()
pushstring forall a b. (a -> b) -> a -> b
$ Name -> ByteString
fromName Name
name
      forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e. LuaError e => StackIndex -> LuaE e Type
rawget StackIndex
absidx)
    Peeker e a
peeker StackIndex
top forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` 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) = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int64
x
  forall e a. Name -> Peek e a -> Peek e a
retrieving (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"raw index '" forall a. Semigroup a => a -> a -> a
<> forall {a}. IsString a => Integer -> a
showInt Integer
i forall a. Semigroup a => a -> a -> a
<> String
"'") forall a b. (a -> b) -> a -> b
$! do
    forall e a. LuaE e a -> Peek e a
liftLua forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx Integer
i
    Peeker e a
peeker StackIndex
top forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` 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 = forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeNil  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a. Alternative f => f a
empty
  Type
_        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeNone -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a. Alternative f => f a
empty
  Type
_        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
TypeNil  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a. Alternative f => f a
empty
  Type
TypeNone -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a. Alternative f => f a
empty
  Type
_        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall e a. Peek e a -> Peek e a
cleanup forall a b. (a -> b) -> a -> b
$ do
  forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
2 String
"retrieving a pair"
  StackIndex
idx' <- forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
  a
a <- forall e a. LuaE e a -> Peek e a
liftLua (forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx' Integer
1) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e a
peekA StackIndex
top
  b
b <- forall e a. LuaE e a -> Peek e a
liftLua (forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx' Integer
2) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e b
peekB StackIndex
top
  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 = forall e a. Peek e a -> Peek e a
cleanup forall a b. (a -> b) -> a -> b
$ do
  forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
3 String
"retrieving a triple"
  StackIndex
idx' <- forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
  a
a <- forall e a. LuaE e a -> Peek e a
liftLua (forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx' Integer
1) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e a
peekA StackIndex
top
  b
b <- forall e a. LuaE e a -> Peek e a
liftLua (forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx' Integer
2) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e b
peekB StackIndex
top
  c
c <- forall e a. LuaE e a -> Peek e a
liftLua (forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx' Integer
3) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e c
peekC StackIndex
top
  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
  [] -> 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice [Peeker e a]
ps StackIndex
idx
{-# INLINABLE choice #-}