{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Foreign.Lua.Peek
Copyright   : © 2020 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability   : beta
Portability : Portable

Functions which unmarshal and retrieve Haskell values from Lua's stack.
-}
module Foreign.Lua.Peek
  ( Peeker
  , PeekError (..)
  , errorMsg
  , force
  , formatPeekError
  , pushMsg
  , toPeeker
  -- * Primitives
  , peekBool
  , peekIntegral
  , peekRealFloat
  -- * Strings
  , peekByteString
  , peekLazyByteString
  , peekString
  , peekText
  , peekStringy
  -- * Collections
  , peekKeyValuePairs
  , peekList
  , peekMap
  , peekSet
  -- * Combinators
  , optional
  ) where

import Control.Applicative ((<|>))
import Data.Bifunctor (first, second)
import Data.ByteString (ByteString)
import Data.List.NonEmpty (NonEmpty (..), (<|))
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import Data.String (IsString (fromString))
import Data.Text (Text)
import Foreign.Lua.Core as Lua
import Text.Read (readMaybe)

import qualified Data.ByteString.Lazy as BL
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Foreign.Lua.Utf8 as Utf8

-- | List of errors which occurred while retrieving a value from
-- the stack.
newtype PeekError = PeekError { PeekError -> NonEmpty Text
fromPeekError :: NonEmpty Text }
  deriving (PeekError -> PeekError -> Bool
(PeekError -> PeekError -> Bool)
-> (PeekError -> PeekError -> Bool) -> Eq PeekError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PeekError -> PeekError -> Bool
$c/= :: PeekError -> PeekError -> Bool
== :: PeekError -> PeekError -> Bool
$c== :: PeekError -> PeekError -> Bool
Eq, Int -> PeekError -> ShowS
[PeekError] -> ShowS
PeekError -> String
(Int -> PeekError -> ShowS)
-> (PeekError -> String)
-> ([PeekError] -> ShowS)
-> Show PeekError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PeekError] -> ShowS
$cshowList :: [PeekError] -> ShowS
show :: PeekError -> String
$cshow :: PeekError -> String
showsPrec :: Int -> PeekError -> ShowS
$cshowsPrec :: Int -> PeekError -> ShowS
Show)

formatPeekError :: PeekError -> String
formatPeekError :: PeekError -> String
formatPeekError (PeekError msgs :: NonEmpty Text
msgs) = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
  Text -> [Text] -> Text
T.intercalate "\n\t" (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Text
msgs)

-- | Function to retrieve a value from Lua's stack.
type Peeker a = StackIndex -> Lua (Either PeekError a)

-- | Create a peek error from an error message.
errorMsg :: Text -> PeekError
errorMsg :: Text -> PeekError
errorMsg  = NonEmpty Text -> PeekError
PeekError (NonEmpty Text -> PeekError)
-> (Text -> NonEmpty Text) -> Text -> PeekError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Add a message to the peek traceback stack.
pushMsg :: Text -> PeekError -> PeekError
pushMsg :: Text -> PeekError -> PeekError
pushMsg msg :: Text
msg (PeekError lst :: NonEmpty Text
lst) = NonEmpty Text -> PeekError
PeekError (NonEmpty Text -> PeekError) -> NonEmpty Text -> PeekError
forall a b. (a -> b) -> a -> b
$ Text
msg Text -> NonEmpty Text -> NonEmpty Text
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Text
lst

-- | Add context information to the peek traceback stack.
retrieving :: Text -> Either PeekError a -> Either PeekError a
retrieving :: Text -> Either PeekError a -> Either PeekError a
retrieving msg :: Text
msg = (PeekError -> PeekError)
-> Either PeekError a -> Either PeekError a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((PeekError -> PeekError)
 -> Either PeekError a -> Either PeekError a)
-> (PeekError -> PeekError)
-> Either PeekError a
-> Either PeekError a
forall a b. (a -> b) -> a -> b
$ Text -> PeekError -> PeekError
pushMsg ("retrieving " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg)

-- | Force creation of a result, throwing an exception if that's
-- not possible.
force :: Either PeekError a -> Lua a
force :: Either PeekError a -> Lua a
force = (PeekError -> Lua a) -> (a -> Lua a) -> Either PeekError a -> Lua a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Lua a
forall a. String -> Lua a
throwMessage (String -> Lua a) -> (PeekError -> String) -> PeekError -> Lua a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeekError -> String
formatPeekError) a -> Lua a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Convert an old peek funtion to a 'Peeker'.
toPeeker :: (StackIndex -> Lua a)
         -> Peeker a
toPeeker :: (StackIndex -> Lua a) -> Peeker a
toPeeker op :: StackIndex -> Lua a
op idx :: StackIndex
idx =
  (a -> Either PeekError a
forall a b. b -> Either a b
Right (a -> Either PeekError a) -> Lua a -> Lua (Either PeekError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua a
op StackIndex
idx) Lua (Either PeekError a)
-> Lua (Either PeekError a) -> Lua (Either PeekError a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Either PeekError a -> Lua (Either PeekError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (PeekError -> Either PeekError a
forall a b. a -> Either a b
Left (PeekError -> Either PeekError a)
-> PeekError -> Either PeekError a
forall a b. (a -> b) -> a -> b
$ Text -> PeekError
errorMsg "retrieving failed")

-- | 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 :: Text                      -- ^ expected type
            -> (StackIndex -> Lua Bool)  -- ^ pre-condition checker
            -> Peeker a
            -> Peeker a
typeChecked :: Text -> (StackIndex -> Lua Bool) -> Peeker a -> Peeker a
typeChecked expectedType :: Text
expectedType test :: StackIndex -> Lua Bool
test peekfn :: Peeker a
peekfn idx :: StackIndex
idx = do
  Bool
v <- StackIndex -> Lua Bool
test StackIndex
idx
  if Bool
v
    then Peeker a
peekfn StackIndex
idx
    else PeekError -> Either PeekError a
forall a b. a -> Either a b
Left (PeekError -> Either PeekError a)
-> Lua PeekError -> Lua (Either PeekError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> StackIndex -> Lua PeekError
mismatchError Text
expectedType StackIndex
idx

-- | Report the expected and actual type of the value under the given index if
-- conversion failed.
reportValueOnFailure :: Text
                     -> (StackIndex -> Lua (Maybe a))
                     -> Peeker a
reportValueOnFailure :: Text -> (StackIndex -> Lua (Maybe a)) -> Peeker a
reportValueOnFailure expected :: Text
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  -> Either PeekError a -> Lua (Either PeekError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PeekError a -> Lua (Either PeekError a))
-> Either PeekError a -> Lua (Either PeekError a)
forall a b. (a -> b) -> a -> b
$ a -> Either PeekError a
forall a b. b -> Either a b
Right a
x
    Nothing -> PeekError -> Either PeekError a
forall a b. a -> Either a b
Left  (PeekError -> Either PeekError a)
-> Lua PeekError -> Lua (Either PeekError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> StackIndex -> Lua PeekError
mismatchError Text
expected StackIndex
idx

-- | Return a Result error containing a message about the assertion failure.
mismatchError :: Text -> StackIndex -> Lua PeekError
mismatchError :: Text -> StackIndex -> Lua PeekError
mismatchError expected :: Text
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
  Text
actualValue <- ByteString -> Text
Utf8.toText (ByteString -> Text) -> Lua ByteString -> Lua Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua ByteString
tostring' StackIndex
idx Lua Text -> Lua () -> Lua Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> Lua ()
pop 1
  PeekError -> Lua PeekError
forall (m :: * -> *) a. Monad m => a -> m a
return (PeekError -> Lua PeekError)
-> (Text -> PeekError) -> Text -> Lua PeekError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PeekError
errorMsg (Text -> Lua PeekError) -> Text -> Lua PeekError
forall a b. (a -> b) -> a -> b
$
    "expected " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
expected Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", got '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    Text
actualValue Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
actualType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"

-- | Retrieves a 'Bool' as a Lua boolean.
peekBool :: Peeker Bool
peekBool :: Peeker Bool
peekBool = (Bool -> Either PeekError Bool)
-> Lua Bool -> Lua (Either PeekError Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Either PeekError Bool
forall a b. b -> Either a b
Right (Lua Bool -> Lua (Either PeekError Bool))
-> (StackIndex -> Lua Bool) -> Peeker Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Lua 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.
toByteString :: StackIndex -> Lua (Maybe ByteString)
toByteString :: StackIndex -> Lua (Maybe ByteString)
toByteString idx :: StackIndex
idx = do
  -- copy value, as tostring converts numbers to strings *in-place*.
  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

-- | Retrieves a 'ByteString' as a raw string.
peekByteString :: Peeker ByteString
peekByteString :: Peeker ByteString
peekByteString = Text -> (StackIndex -> Lua (Maybe ByteString)) -> Peeker ByteString
forall a. Text -> (StackIndex -> Lua (Maybe a)) -> Peeker a
reportValueOnFailure "string" StackIndex -> Lua (Maybe ByteString)
toByteString

-- | Retrieves a lazy 'BL.ByteString' as a raw string.
peekLazyByteString :: Peeker BL.ByteString
peekLazyByteString :: Peeker ByteString
peekLazyByteString = (Either PeekError ByteString -> Either PeekError ByteString)
-> Lua (Either PeekError ByteString)
-> Lua (Either PeekError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> ByteString)
-> Either PeekError ByteString -> Either PeekError ByteString
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ByteString -> ByteString
BL.fromStrict) (Lua (Either PeekError ByteString)
 -> Lua (Either PeekError ByteString))
-> Peeker ByteString -> Peeker ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker ByteString
peekByteString

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

-- | 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 :: IsString a => Peeker a
peekStringy :: Peeker a
peekStringy = (Either PeekError ByteString -> Either PeekError a)
-> Lua (Either PeekError ByteString) -> Lua (Either PeekError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> a)
-> Either PeekError ByteString -> Either PeekError a
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((ByteString -> a)
 -> Either PeekError ByteString -> Either PeekError a)
-> (ByteString -> a)
-> Either PeekError ByteString
-> Either PeekError a
forall a b. (a -> b) -> a -> b
$ 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) (Lua (Either PeekError ByteString) -> Lua (Either PeekError a))
-> Peeker ByteString -> Peeker a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker ByteString
peekByteString

-- | Retrieves a 'T.Text' value as an UTF-8 encoded string.
peekText :: Peeker T.Text
peekText :: Peeker Text
peekText = (Either PeekError ByteString -> Either PeekError Text)
-> Lua (Either PeekError ByteString) -> Lua (Either PeekError Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> Text)
-> Either PeekError ByteString -> Either PeekError Text
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ByteString -> Text
Utf8.toText) (Lua (Either PeekError ByteString) -> Lua (Either PeekError Text))
-> Peeker ByteString -> Peeker Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker ByteString
peekByteString

--
-- Numbers
--

-- | Retrieves an 'Integral' value from the Lua stack.
peekIntegral :: (Integral a, Read a) => Peeker a
peekIntegral :: Peeker a
peekIntegral idx :: StackIndex
idx =
  StackIndex -> Lua Type
ltype StackIndex
idx Lua Type
-> (Type -> Lua (Either PeekError a)) -> Lua (Either PeekError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    TypeNumber  -> (Integer -> a) -> Either PeekError Integer -> Either PeekError a
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Either PeekError Integer -> Either PeekError a)
-> Lua (Either PeekError Integer) -> Lua (Either PeekError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   Text -> (StackIndex -> Lua (Maybe Integer)) -> Peeker Integer
forall a. Text -> (StackIndex -> Lua (Maybe a)) -> Peeker a
reportValueOnFailure "Integral" StackIndex -> Lua (Maybe Integer)
tointeger StackIndex
idx
    TypeString  -> do
      String
str <- ByteString -> String
Utf8.toString (ByteString -> String)
-> (Maybe ByteString -> ByteString) -> Maybe ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe (String -> ByteString
forall a. HasCallStack => String -> a
Prelude.error "programming error in peekIntegral")
             (Maybe ByteString -> String)
-> Lua (Maybe ByteString) -> Lua String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua (Maybe ByteString)
tostring StackIndex
idx
      let msg :: Text
msg = "expected Integral, got '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' (string)"
      Either PeekError a -> Lua (Either PeekError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PeekError a -> Lua (Either PeekError a))
-> Either PeekError a -> Lua (Either PeekError a)
forall a b. (a -> b) -> a -> b
$ Either PeekError a
-> (a -> Either PeekError a) -> Maybe a -> Either PeekError a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PeekError -> Either PeekError a
forall a b. a -> Either a b
Left (PeekError -> Either PeekError a)
-> PeekError -> Either PeekError a
forall a b. (a -> b) -> a -> b
$ Text -> PeekError
errorMsg Text
msg) a -> Either PeekError a
forall a b. b -> Either a b
Right (Maybe a -> Either PeekError a) -> Maybe a -> Either PeekError a
forall a b. (a -> b) -> a -> b
$ String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
str
    _ -> PeekError -> Either PeekError a
forall a b. a -> Either a b
Left (PeekError -> Either PeekError a)
-> Lua PeekError -> Lua (Either PeekError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> StackIndex -> Lua PeekError
mismatchError "Integral" StackIndex
idx

-- | Retrieve a 'RealFloat' (e.g., 'Float' or 'Double') from the stack.
peekRealFloat :: (RealFloat a, Read a) => Peeker a
peekRealFloat :: Peeker a
peekRealFloat idx :: StackIndex
idx =
  StackIndex -> Lua Type
ltype StackIndex
idx Lua Type
-> (Type -> Lua (Either PeekError a)) -> Lua (Either PeekError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    TypeString  -> do
      String
str <- ByteString -> String
Utf8.toString (ByteString -> String)
-> (Maybe ByteString -> ByteString) -> Maybe ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe (String -> ByteString
forall a. HasCallStack => String -> a
Prelude.error "programming error in peekRealFloat")
             (Maybe ByteString -> String)
-> Lua (Maybe ByteString) -> Lua String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua (Maybe ByteString)
tostring StackIndex
idx
      let msg :: Text
msg = "expected RealFloat, got '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' (string)"
      Either PeekError a -> Lua (Either PeekError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PeekError a -> Lua (Either PeekError a))
-> Either PeekError a -> Lua (Either PeekError a)
forall a b. (a -> b) -> a -> b
$ Either PeekError a
-> (a -> Either PeekError a) -> Maybe a -> Either PeekError a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PeekError -> Either PeekError a
forall a b. a -> Either a b
Left (PeekError -> Either PeekError a)
-> PeekError -> Either PeekError a
forall a b. (a -> b) -> a -> b
$ Text -> PeekError
errorMsg Text
msg) a -> Either PeekError a
forall a b. b -> Either a b
Right (Maybe a -> Either PeekError a) -> Maybe a -> Either PeekError a
forall a b. (a -> b) -> a -> b
$ String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
str
    _ -> (Number -> a) -> Either PeekError Number -> Either PeekError a
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Number -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Either PeekError Number -> Either PeekError a)
-> Lua (Either PeekError Number) -> Lua (Either PeekError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         Text -> (StackIndex -> Lua (Maybe Number)) -> Peeker Number
forall a. Text -> (StackIndex -> Lua (Maybe a)) -> Peeker a
reportValueOnFailure "RealFloat" StackIndex -> Lua (Maybe Number)
tonumber StackIndex
idx

-- | Reads a numerically indexed table @t@ into a list, where the 'length' of
-- the list is equal to @#t@. The operation will fail if a numerical field @n@
-- with @1 ≤ n < #t@ is missing.
peekList :: Peeker a -> Peeker [a]
peekList :: Peeker a -> Peeker [a]
peekList peekElement :: Peeker a
peekElement = Text -> (StackIndex -> Lua Bool) -> Peeker [a] -> Peeker [a]
forall a. Text -> (StackIndex -> Lua Bool) -> Peeker a -> Peeker a
typeChecked "table" StackIndex -> Lua Bool
istable (Peeker [a] -> Peeker [a]) -> Peeker [a] -> Peeker [a]
forall a b. (a -> b) -> a -> b
$ \idx :: StackIndex
idx -> do
  let elementsAt :: [Integer] -> Lua (Either PeekError [a])
elementsAt [] = Either PeekError [a] -> Lua (Either PeekError [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Either PeekError [a]
forall a b. b -> Either a b
Right [])
      elementsAt (i :: Integer
i : is :: [Integer]
is) = do
        Either PeekError a
eitherX <- StackIndex -> Integer -> Lua ()
rawgeti StackIndex
idx Integer
i Lua () -> Lua (Either PeekError a) -> Lua (Either PeekError a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker a
peekElement (CInt -> StackIndex
nthFromTop 1) Lua (Either PeekError a) -> Lua () -> Lua (Either PeekError a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> Lua ()
pop 1
        case Either PeekError a
eitherX of
          Right x :: a
x  -> ([a] -> [a]) -> Either PeekError [a] -> Either PeekError [a]
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (Either PeekError [a] -> Either PeekError [a])
-> Lua (Either PeekError [a]) -> Lua (Either PeekError [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer] -> Lua (Either PeekError [a])
elementsAt [Integer]
is
          Left err :: PeekError
err -> Either PeekError [a] -> Lua (Either PeekError [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PeekError [a] -> Lua (Either PeekError [a]))
-> (PeekError -> Either PeekError [a])
-> PeekError
-> Lua (Either PeekError [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeekError -> Either PeekError [a]
forall a b. a -> Either a b
Left (PeekError -> Lua (Either PeekError [a]))
-> PeekError -> Lua (Either PeekError [a])
forall a b. (a -> b) -> a -> b
$
                      Text -> PeekError -> PeekError
pushMsg ("in field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
i)) PeekError
err
  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
  [Integer] -> Lua (Either PeekError [a])
elementsAt [1..Integer
listLength]

-- | Retrieves a key-value Lua table as 'Map'.
peekMap :: Ord a => Peeker a -> Peeker b -> Peeker (Map a b)
peekMap :: Peeker a -> Peeker b -> Peeker (Map a b)
peekMap keyPeeker :: Peeker a
keyPeeker valuePeeker :: Peeker b
valuePeeker =
    (Either PeekError [(a, b)] -> Either PeekError (Map a b))
-> Lua (Either PeekError [(a, b)])
-> Lua (Either PeekError (Map a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Either PeekError (Map a b) -> Either PeekError (Map a b)
forall a. Text -> Either PeekError a -> Either PeekError a
retrieving "Map" (Either PeekError (Map a b) -> Either PeekError (Map a b))
-> (Either PeekError [(a, b)] -> Either PeekError (Map a b))
-> Either PeekError [(a, b)]
-> Either PeekError (Map a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, b)] -> Map a b)
-> Either PeekError [(a, b)] -> Either PeekError (Map a b)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(a, b)] -> Map a b
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList)
  (Lua (Either PeekError [(a, b)])
 -> Lua (Either PeekError (Map a b)))
-> (StackIndex -> Lua (Either PeekError [(a, b)]))
-> Peeker (Map a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker a
-> Peeker b -> StackIndex -> Lua (Either PeekError [(a, b)])
forall a b. Peeker a -> Peeker b -> Peeker [(a, b)]
peekKeyValuePairs Peeker a
keyPeeker Peeker b
valuePeeker

-- | Read a table into a list of pairs.
peekKeyValuePairs :: Peeker a -> Peeker b -> Peeker [(a, b)]
peekKeyValuePairs :: Peeker a -> Peeker b -> Peeker [(a, b)]
peekKeyValuePairs keyPeeker :: Peeker a
keyPeeker valuePeeker :: Peeker b
valuePeeker =
  Text
-> (StackIndex -> Lua Bool) -> Peeker [(a, b)] -> Peeker [(a, b)]
forall a. Text -> (StackIndex -> Lua Bool) -> Peeker a -> Peeker a
typeChecked "table" StackIndex -> Lua Bool
istable (Peeker [(a, b)] -> Peeker [(a, b)])
-> Peeker [(a, b)] -> Peeker [(a, b)]
forall a b. (a -> b) -> a -> b
$ \idx :: StackIndex
idx -> do
    StackIndex
idx' <- StackIndex -> Lua StackIndex
absindex StackIndex
idx
    let remainingPairs :: Lua (Either PeekError [(a, b)])
remainingPairs = do
          Either PeekError (Maybe (a, b))
res <- Peeker a -> Peeker b -> Peeker (Maybe (a, b))
forall a b. Peeker a -> Peeker b -> Peeker (Maybe (a, b))
nextPair Peeker a
keyPeeker Peeker b
valuePeeker StackIndex
idx'
          case Either PeekError (Maybe (a, b))
res of
            Left err :: PeekError
err       -> Either PeekError [(a, b)] -> Lua (Either PeekError [(a, b)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PeekError [(a, b)] -> Lua (Either PeekError [(a, b)]))
-> Either PeekError [(a, b)] -> Lua (Either PeekError [(a, b)])
forall a b. (a -> b) -> a -> b
$ PeekError -> Either PeekError [(a, b)]
forall a b. a -> Either a b
Left PeekError
err
            Right Nothing  -> Either PeekError [(a, b)] -> Lua (Either PeekError [(a, b)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PeekError [(a, b)] -> Lua (Either PeekError [(a, b)]))
-> Either PeekError [(a, b)] -> Lua (Either PeekError [(a, b)])
forall a b. (a -> b) -> a -> b
$ [(a, b)] -> Either PeekError [(a, b)]
forall a b. b -> Either a b
Right []
            Right (Just a :: (a, b)
a) -> ([(a, b)] -> [(a, b)])
-> Either PeekError [(a, b)] -> Either PeekError [(a, b)]
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((a, b)
a(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:) (Either PeekError [(a, b)] -> Either PeekError [(a, b)])
-> Lua (Either PeekError [(a, b)])
-> Lua (Either PeekError [(a, b)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua (Either PeekError [(a, b)])
remainingPairs
    Lua ()
pushnil
    Lua (Either PeekError [(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.
nextPair :: Peeker a -> Peeker b -> Peeker (Maybe (a, b))
nextPair :: Peeker a -> Peeker b -> Peeker (Maybe (a, b))
nextPair keyPeeker :: Peeker a
keyPeeker valuePeeker :: Peeker b
valuePeeker idx :: StackIndex
idx = Text
-> Either PeekError (Maybe (a, b))
-> Either PeekError (Maybe (a, b))
forall a. Text -> Either PeekError a -> Either PeekError a
retrieving "key-value pair" (Either PeekError (Maybe (a, b))
 -> Either PeekError (Maybe (a, b)))
-> Lua (Either PeekError (Maybe (a, b)))
-> Lua (Either PeekError (Maybe (a, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Bool
hasNext <- StackIndex -> Lua Bool
next StackIndex
idx
  if Bool -> Bool
not Bool
hasNext
    then Either PeekError (Maybe (a, b))
-> Lua (Either PeekError (Maybe (a, b)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PeekError (Maybe (a, b))
 -> Lua (Either PeekError (Maybe (a, b))))
-> Either PeekError (Maybe (a, b))
-> Lua (Either PeekError (Maybe (a, b)))
forall a b. (a -> b) -> a -> b
$ Maybe (a, b) -> Either PeekError (Maybe (a, b))
forall a b. b -> Either a b
Right Maybe (a, b)
forall a. Maybe a
Nothing
    else do
      Either PeekError a
key   <- Text -> Either PeekError a -> Either PeekError a
forall a. Text -> Either PeekError a -> Either PeekError a
retrieving "key"   (Either PeekError a -> Either PeekError a)
-> Lua (Either PeekError a) -> Lua (Either PeekError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker a
keyPeeker   (CInt -> StackIndex
nthFromTop 2)
      Either PeekError b
value <- Text -> Either PeekError b -> Either PeekError b
forall a. Text -> Either PeekError a -> Either PeekError a
retrieving "value" (Either PeekError b -> Either PeekError b)
-> Lua (Either PeekError b) -> Lua (Either PeekError b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker b
valuePeeker (CInt -> StackIndex
nthFromTop 1)
      StackIndex -> Lua ()
pop 1    -- remove value, leave the key
      Either PeekError (Maybe (a, b))
-> Lua (Either PeekError (Maybe (a, b)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PeekError (Maybe (a, b))
 -> Lua (Either PeekError (Maybe (a, b))))
-> Either PeekError (Maybe (a, b))
-> Lua (Either PeekError (Maybe (a, b)))
forall a b. (a -> b) -> a -> b
$ ((a, b) -> Maybe (a, b)) -> a -> b -> Maybe (a, b)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a -> b -> Maybe (a, b))
-> Either PeekError a -> Either PeekError (b -> Maybe (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either PeekError a
key Either PeekError (b -> Maybe (a, b))
-> Either PeekError b -> Either PeekError (Maybe (a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either PeekError b
value

-- | 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 :: Ord a => Peeker a -> Peeker (Set a)
peekSet :: Peeker a -> Peeker (Set a)
peekSet elementPeeker :: Peeker a
elementPeeker =
    (Either PeekError [(a, Bool)] -> Either PeekError (Set a))
-> Lua (Either PeekError [(a, Bool)])
-> Lua (Either PeekError (Set a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Either PeekError (Set a) -> Either PeekError (Set a)
forall a. Text -> Either PeekError a -> Either PeekError a
retrieving "Set" (Either PeekError (Set a) -> Either PeekError (Set a))
-> (Either PeekError [(a, Bool)] -> Either PeekError (Set a))
-> Either PeekError [(a, Bool)]
-> Either PeekError (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          ([(a, Bool)] -> Set a)
-> Either PeekError [(a, Bool)] -> Either PeekError (Set a)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([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 (Either PeekError [(a, Bool)])
 -> Lua (Either PeekError (Set a)))
-> (StackIndex -> Lua (Either PeekError [(a, Bool)]))
-> Peeker (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker a
-> Peeker Bool -> StackIndex -> Lua (Either PeekError [(a, Bool)])
forall a b. Peeker a -> Peeker b -> Peeker [(a, b)]
peekKeyValuePairs Peeker a
elementPeeker Peeker Bool
peekBool

--
-- Combinators
--

-- | Makes a result optional. Returns 'Nothing' if the Lua value
-- is @nil@; otherwise applies the peeker and returns its result.
optional :: Peeker a -- ^ peeker
         -> Peeker (Maybe a)
optional :: Peeker a -> Peeker (Maybe a)
optional peeker :: Peeker a
peeker idx :: StackIndex
idx = do
  Bool
noValue <- StackIndex -> Lua Bool
Lua.isnoneornil StackIndex
idx
  if Bool
noValue
    then Either PeekError (Maybe a) -> Lua (Either PeekError (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PeekError (Maybe a) -> Lua (Either PeekError (Maybe a)))
-> Either PeekError (Maybe a) -> Lua (Either PeekError (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either PeekError (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
    else (a -> Maybe a) -> Either PeekError a -> Either PeekError (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Either PeekError a -> Either PeekError (Maybe a))
-> Lua (Either PeekError a) -> Lua (Either PeekError (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker a
peeker StackIndex
idx