{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module      : HsLua.Marshalling.Peekers
Copyright   : © 2020-2021 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 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
  , peekMap
  , peekSet
  -- ** Combinators
  , choice
  , peekFieldRaw
  , peekIndexRaw
  , peekPair
  , peekTriple
  -- ** Building peek functions
  , typeChecked
  , reportValueOnFailure
  , typeMismatchMessage
  ) where

import Control.Applicative (Alternative (..))
import Control.Monad ((<$!>), (>=>))
import Data.ByteString (ByteString)
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)

#if !MIN_VERSION_base(4,12,0)
import Data.Semigroup (Semigroup ((<>)))
#endif

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 :: 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 (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 :: 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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just !ByteString
msg -> ByteString -> LuaE e ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
msg
    Maybe ByteString
Nothing  -> ByteString -> LuaE e ByteString
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 :: 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 (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 (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 :: 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 (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 :: 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 (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINABLE peekNoneOrNil #-}

-- | Retrieves a 'Bool' as a Lua boolean.
peekBool :: Peeker e Bool
peekBool :: 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) -> Peeker 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.
toByteString :: StackIndex -> LuaE e (Maybe ByteString)
toByteString :: StackIndex -> LuaE e (Maybe ByteString)
toByteString StackIndex
idx = do
  -- copy value, as tostring converts numbers to strings *in-place*.
  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 (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 :: 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 :: 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) -> Peeker 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 :: 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 :: Peeker e a
peekStringy = (ByteString -> a) -> Peek e ByteString -> Peek e a
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) -> Peeker 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 :: 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) -> Peeker 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 :: 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) -> Peeker 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 :: Peeker e a
peekRead = Peeker e String
forall e. Peeker e String
peekString Peeker e String -> (String -> Peek e a) -> Peeker 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 (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 :: 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 (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 (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 (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 (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 :: 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 (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 (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 (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 :: Peeker e a -> Peeker e [a]
peekList Peeker e a
peekElement = (Peek e [a] -> Peek e [a]) -> Peeker e [a] -> Peeker e [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> Peek e [a] -> Peek e [a]
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"list") (Peeker e [a] -> Peeker e [a])
-> (Peeker e [a] -> Peeker e [a]) -> Peeker e [a] -> Peeker e [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  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
  let elementsAt :: [Integer] -> Peek e [a]
elementsAt [] = [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 () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx Integer
i) Peek e () -> Peek e a -> Peek e a
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 (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 :: Ord a => Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap :: 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))
-> Peeker e (Map a b) -> Peeker 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 (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)]) -> Peeker 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. 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 :: Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs :: 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
    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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe (a, b)
Nothing -> [(a, b)] -> Peek e [(a, b)]
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 :: 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 (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 (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 :: Ord a => Peeker e a -> Peeker e (Set a)
peekSet :: 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
withContext Name
"Set"
  (Peek e (Set a) -> Peek e (Set a))
-> Peeker e (Set a) -> Peeker 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 (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)]) -> Peeker 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. 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 :: 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
      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
      StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
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 :: 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 () -> Peek e ()
forall a b. (a -> b) -> a -> b
$ StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
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 #-}

-- | 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 :: 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
  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 () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx' Integer
1) Peek e () -> Peek e a -> Peek e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e a
peekA StackIndex
top
  b
b <- LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx' Integer
2) Peek e () -> 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 (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 :: 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
  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 () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx' Integer
1) Peek e () -> Peek e a -> Peek e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e a
peekA StackIndex
top
  b
b <- LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx' Integer
2) Peek e () -> 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 () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e ()
forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
rawgeti StackIndex
idx' Integer
3) Peek e () -> Peek e c -> Peek e c
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 (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 :: [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 (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 #-}