{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module HsLua.Marshalling.Peekers
(
peekNil
, peekNoneOrNil
, peekBool
, peekIntegral
, peekRealFloat
, peekByteString
, peekLazyByteString
, peekString
, peekText
, peekStringy
, peekName
, peekRead
, peekKeyValuePairs
, peekList
, peekNonEmpty
, peekMap
, peekSet
, choice
, peekFieldRaw
, peekIndexRaw
, peekNilOr
, peekNoneOr
, peekNoneOrNilOr
, peekPair
, peekTriple
, 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
typeChecked :: Name
-> (StackIndex -> LuaE e Bool)
-> 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
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 v
then peekfn idx
else typeMismatchMessage expectedType idx >>= failPeek
typeMismatchMessage :: Name
-> StackIndex
-> Peek e ByteString
typeMismatchMessage :: forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage (Name ByteString
expected) StackIndex
idx = LuaE e ByteString -> Peek e ByteString
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e ByteString -> Peek e ByteString)
-> LuaE e ByteString -> Peek e ByteString
forall a b. (a -> b) -> a -> b
$ do
ByteString -> StackIndex -> LuaE e ()
forall e. ByteString -> StackIndex -> LuaE e ()
pushTypeMismatchError ByteString
expected StackIndex
idx
(StackIndex -> LuaE e (Maybe ByteString)
forall e. StackIndex -> LuaE e (Maybe ByteString)
tostring StackIndex
top LuaE e (Maybe ByteString) -> LuaE e () -> LuaE e (Maybe ByteString)
forall a b. LuaE e a -> LuaE e b -> LuaE e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1) LuaE e (Maybe ByteString)
-> (Maybe ByteString -> LuaE e ByteString) -> LuaE e ByteString
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just !ByteString
msg -> ByteString -> LuaE e ByteString
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
msg
Maybe ByteString
Nothing -> ByteString -> LuaE e ByteString
forall a. a -> LuaE e a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> LuaE e ByteString)
-> ByteString -> LuaE e ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
[ ByteString
"Unknown type mismatch for "
, ByteString
expected
, ByteString
" at stack index "
, String -> ByteString
Utf8.fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ CInt -> String
forall a. Show a => a -> String
show (StackIndex -> CInt
fromStackIndex StackIndex
idx)
]
reportValueOnFailure :: Name
-> (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
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 res of
Just a
x -> a -> Peek e a
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Peek e a) -> a -> Peek e a
forall a b. (a -> b) -> a -> b
$! a
x
Maybe a
Nothing -> Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
expected StackIndex
idx Peek e ByteString -> (ByteString -> Peek e a) -> Peek e a
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Peek e a
forall a e. ByteString -> Peek e a
failPeek
peekNil :: Peeker e ()
peekNil :: forall e. Peeker e ()
peekNil = Name -> (StackIndex -> LuaE e Bool) -> Peeker e () -> Peeker e ()
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"nil" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Lua.isnil (Peeker e () -> Peeker e ()) -> Peeker e () -> Peeker e ()
forall a b. (a -> b) -> a -> b
$ Peek e () -> Peeker e ()
forall a b. a -> b -> a
const (() -> Peek e ()
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINABLE peekNil #-}
peekNoneOrNil :: Peeker e ()
peekNoneOrNil :: forall e. Peeker e ()
peekNoneOrNil = Name -> (StackIndex -> LuaE e Bool) -> Peeker e () -> Peeker e ()
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"none or nil" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Lua.isnoneornil (Peeker e () -> Peeker e ()) -> Peeker e () -> Peeker e ()
forall a b. (a -> b) -> a -> b
$ Peek e () -> Peeker e ()
forall a b. a -> b -> a
const (() -> Peek e ()
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINABLE peekNoneOrNil #-}
peekBool :: Peeker e Bool
peekBool :: forall e. Peeker e Bool
peekBool = LuaE e Bool -> Peek e Bool
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e Bool -> Peek e Bool)
-> (StackIndex -> LuaE e Bool) -> StackIndex -> Peek e Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
toboolean
toByteString :: StackIndex -> LuaE e (Maybe ByteString)
toByteString :: forall e. StackIndex -> LuaE e (Maybe ByteString)
toByteString StackIndex
idx = do
StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx LuaE e Type
-> (Type -> LuaE e (Maybe ByteString)) -> LuaE e (Maybe ByteString)
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeString -> StackIndex -> LuaE e (Maybe ByteString)
forall e. StackIndex -> LuaE e (Maybe ByteString)
tostring StackIndex
idx
Type
_ -> Int -> LuaE e Bool
forall e. Int -> LuaE e Bool
checkstack Int
1 LuaE e Bool
-> (Bool -> LuaE e (Maybe ByteString)) -> LuaE e (Maybe ByteString)
forall a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
False -> Maybe ByteString -> LuaE e (Maybe ByteString)
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
Bool
True -> do
StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
idx
StackIndex -> LuaE e (Maybe ByteString)
forall e. StackIndex -> LuaE e (Maybe ByteString)
tostring StackIndex
top LuaE e (Maybe ByteString) -> LuaE e () -> LuaE e (Maybe ByteString)
forall a b. LuaE e a -> LuaE e b -> LuaE e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
{-# INLINABLE toByteString #-}
peekByteString :: Peeker e ByteString
peekByteString :: forall e. Peeker e ByteString
peekByteString = Name
-> (StackIndex -> LuaE e (Maybe ByteString)) -> Peeker e ByteString
forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
"string" StackIndex -> LuaE e (Maybe ByteString)
forall e. StackIndex -> LuaE e (Maybe ByteString)
toByteString
{-# INLINABLE peekByteString #-}
peekLazyByteString :: Peeker e BL.ByteString
peekLazyByteString :: forall e. Peeker e ByteString
peekLazyByteString = (ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> Peek e ByteString -> Peek e ByteString
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) (Peek e ByteString -> Peek e ByteString)
-> (StackIndex -> Peek e ByteString)
-> StackIndex
-> Peek e ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e ByteString
forall e. Peeker e ByteString
peekByteString
{-# INLINABLE peekLazyByteString #-}
peekString :: Peeker e String
peekString :: forall e. Peeker e String
peekString = Peeker e String
forall a e. IsString a => Peeker e a
peekStringy
{-# INLINABLE peekString #-}
peekStringy :: forall a e. IsString a => Peeker e a
peekStringy :: forall a e. IsString a => Peeker e a
peekStringy = (ByteString -> a) -> Peek e ByteString -> Peek e a
forall a b. (a -> b) -> Peek e a -> Peek e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> (ByteString -> String) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Utf8.toString) (Peek e ByteString -> Peek e a)
-> (StackIndex -> Peek e ByteString) -> StackIndex -> Peek e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e ByteString
forall e. Peeker e ByteString
peekByteString
{-# INLINABLE peekStringy #-}
peekText :: Peeker e T.Text
peekText :: forall e. Peeker e Text
peekText = (ByteString -> Text
Utf8.toText (ByteString -> Text) -> Peek e ByteString -> Peek e Text
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) (Peek e ByteString -> Peek e Text)
-> (StackIndex -> Peek e ByteString) -> StackIndex -> Peek e Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e ByteString
forall e. Peeker e ByteString
peekByteString
{-# INLINABLE peekText #-}
peekName :: Peeker e Name
peekName :: forall e. Peeker e Name
peekName = (ByteString -> Name
Name (ByteString -> Name) -> Peek e ByteString -> Peek e Name
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) (Peek e ByteString -> Peek e Name)
-> (StackIndex -> Peek e ByteString) -> StackIndex -> Peek e Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e ByteString
forall e. Peeker e ByteString
peekByteString
{-# INLINABLE peekName #-}
peekRead :: forall a e. Read a => Peeker e a
peekRead :: forall a e. Read a => Peeker e a
peekRead = Peeker e String
forall e. Peeker e String
peekString Peeker e String -> (String -> Peek e a) -> StackIndex -> Peek e a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> Peek e a
forall {a} {e}. Read a => String -> Peek e a
readValue
where
readValue :: String -> Peek e a
readValue String
s = case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
s of
Just a
x -> a -> Peek e a
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
Maybe a
Nothing -> ByteString -> Peek e a
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek e a) -> ByteString -> Peek e a
forall a b. (a -> b) -> a -> b
$ ByteString
"Could not read: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
Utf8.fromString String
s
peekIntegral :: forall a e. (Integral a, Read a) => Peeker e a
peekIntegral :: forall a e. (Integral a, Read a) => Peeker e a
peekIntegral StackIndex
idx = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e a) -> Peek e a
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeNumber -> Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> a) -> Peek e Integer -> Peek e a
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>
Name -> (StackIndex -> LuaE e (Maybe Integer)) -> Peeker e Integer
forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
"Integral" StackIndex -> LuaE e (Maybe Integer)
forall e. StackIndex -> LuaE e (Maybe Integer)
tointeger StackIndex
idx
Type
TypeString -> do
Just 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 readMaybe (Utf8.toString str) of
Maybe a
Nothing -> Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Integral" StackIndex
idx Peek e ByteString -> (ByteString -> Peek e a) -> Peek e a
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Peek e a
forall a e. ByteString -> Peek e a
failPeek
Just a
x -> a -> Peek e a
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
Type
_ -> Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"Integral" StackIndex
idx Peek e ByteString -> (ByteString -> Peek e a) -> Peek e a
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Peek e a
forall a e. ByteString -> Peek e a
failPeek
peekRealFloat :: forall a e. (RealFloat a, Read a) => Peeker e a
peekRealFloat :: forall a e. (RealFloat a, Read a) => Peeker e a
peekRealFloat StackIndex
idx = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e a) -> Peek e a
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeString -> do
Just 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 readMaybe (Utf8.toString str) of
Maybe a
Nothing -> Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"RealFloat" StackIndex
idx Peek e ByteString -> (ByteString -> Peek e a) -> Peek e a
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Peek e a
forall a e. ByteString -> Peek e a
failPeek
Just a
x -> a -> Peek e a
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
Type
_ -> Number -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Number -> a) -> Peek e Number -> Peek e a
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Name -> (StackIndex -> LuaE e (Maybe Number)) -> Peeker e Number
forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
reportValueOnFailure Name
"RealFloat" StackIndex -> LuaE e (Maybe Number)
forall e. StackIndex -> LuaE e (Maybe Number)
tonumber StackIndex
idx
peekList :: forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList :: forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e a
peekElement = Name -> Peek e [a] -> Peek e [a]
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"list" (Peek e [a] -> Peek e [a])
-> (StackIndex -> Peek e [a]) -> StackIndex -> Peek e [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e a -> StackIndex -> Peek e [a]
forall e a. LuaError e => Peeker e a -> Peeker e [a]
peekList' Peeker e a
peekElement
peekNonEmpty :: LuaError e => Peeker e a -> Peeker e (NonEmpty a)
peekNonEmpty :: forall e a. LuaError e => Peeker e a -> Peeker e (NonEmpty a)
peekNonEmpty Peeker e a
peekElement = Name -> Peek e (NonEmpty a) -> Peek e (NonEmpty a)
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"NonEmpty" (Peek e (NonEmpty a) -> Peek e (NonEmpty a))
-> (StackIndex -> Peek e (NonEmpty a))
-> StackIndex
-> Peek e (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Peeker e a -> Peeker e [a]
forall e a. LuaError e => Peeker e a -> Peeker e [a]
peekList' Peeker e a
peekElement Peeker e [a]
-> ([a] -> Peek e (NonEmpty a))
-> StackIndex
-> Peek e (NonEmpty a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
(a
x:[a]
xs) -> NonEmpty a -> Peek e (NonEmpty a)
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs)
[] -> ByteString -> Peek e (NonEmpty a)
forall a e. ByteString -> Peek e a
failPeek ByteString
"empty list")
peekList' :: LuaError e => Peeker e a -> Peeker e [a]
peekList' :: forall e a. LuaError e => Peeker e a -> Peeker e [a]
peekList' Peeker e a
peekElement = Name -> (StackIndex -> LuaE e Bool) -> Peeker e [a] -> Peeker e [a]
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
istable (Peeker e [a] -> Peeker e [a]) -> Peeker e [a] -> Peeker e [a]
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> do
LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e () -> Peek e ()) -> LuaE e () -> Peek e ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> LuaE e ()
forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
1 String
"retrieving a list"
let elementsAt :: [Integer] -> Peek e [a]
elementsAt [] = [a] -> Peek e [a]
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return []
elementsAt (Integer
i : [Integer]
is) = do
x <- Name -> Peek e a -> Peek e a
forall e a. Name -> Peek e a -> Peek e a
retrieving (Name
"index " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Integer -> Name
forall {a}. IsString a => Integer -> a
showInt Integer
i) (Peek e a -> Peek e a) -> Peek e a -> Peek e a
forall a b. (a -> b) -> a -> b
$
LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e Type
forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx Integer
i) Peek e Type -> Peek e a -> Peek e a
forall a b. Peek e a -> Peek e b -> Peek e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Peeker e a
peekElement StackIndex
top Peek e a -> LuaE e () -> Peek e a
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1
xs <- elementsAt is
return (x: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
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)
elementsAt [1..fromIntegral listLength]
peekMap :: (LuaError e, Ord a)
=> Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap :: forall e a b.
(LuaError e, Ord a) =>
Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap Peeker e a
keyPeeker Peeker e b
valuePeeker = Name -> Peek e (Map a b) -> Peek e (Map a b)
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Map"
(Peek e (Map a b) -> Peek e (Map a b))
-> (StackIndex -> Peek e (Map a b))
-> StackIndex
-> Peek e (Map a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, b)] -> Map a b) -> Peek e [(a, b)] -> Peek e (Map a b)
forall a b. (a -> b) -> Peek e a -> Peek e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(a, b)] -> Map a b
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
(Peek e [(a, b)] -> Peek e (Map a b))
-> (StackIndex -> Peek e [(a, b)])
-> StackIndex
-> Peek e (Map a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e a -> Peeker e b -> StackIndex -> Peek e [(a, b)]
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs Peeker e a
keyPeeker Peeker e b
valuePeeker
peekKeyValuePairs :: LuaError e
=> Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs :: forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs Peeker e a
keyPeeker Peeker e b
valuePeeker =
Name
-> (StackIndex -> LuaE e Bool)
-> Peeker e [(a, b)]
-> Peeker e [(a, b)]
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
istable (Peeker e [(a, b)] -> Peeker e [(a, b)])
-> Peeker e [(a, b)] -> Peeker e [(a, b)]
forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> Peek e [(a, b)] -> Peek e [(a, b)]
forall e a. Peek e a -> Peek e a
cleanup (Peek e [(a, b)] -> Peek e [(a, b)])
-> Peek e [(a, b)] -> Peek e [(a, b)]
forall a b. (a -> b) -> a -> b
$ do
LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e () -> Peek e ()) -> LuaE e () -> Peek e ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> LuaE e ()
forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
2 String
"retrieving key-value pairs"
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 = Peeker e a -> Peeker e b -> Peeker e (Maybe (a, b))
forall e a b. Peeker e a -> Peeker e b -> Peeker e (Maybe (a, b))
nextPair Peeker e a
keyPeeker Peeker e b
valuePeeker StackIndex
idx' Peek e (Maybe (a, b))
-> (Maybe (a, b) -> Peek e [(a, b)]) -> Peek e [(a, b)]
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (a, b)
Nothing -> [(a, b)] -> Peek e [(a, b)]
forall a. a -> Peek e a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just (a, b)
a -> ((a, b)
a(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:) ([(a, b)] -> [(a, b)]) -> Peek e [(a, b)] -> Peek e [(a, b)]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peek e [(a, b)]
remainingPairs
liftLua pushnil
remainingPairs
nextPair :: Peeker e a -> Peeker e b -> Peeker e (Maybe (a, b))
nextPair :: forall e a b. Peeker e a -> Peeker e b -> Peeker e (Maybe (a, b))
nextPair Peeker e a
keyPeeker Peeker e b
valuePeeker StackIndex
idx = Name -> Peek e (Maybe (a, b)) -> Peek e (Maybe (a, b))
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"key-value pair" (Peek e (Maybe (a, b)) -> Peek e (Maybe (a, b)))
-> Peek e (Maybe (a, b)) -> Peek e (Maybe (a, b))
forall a b. (a -> b) -> a -> b
$ do
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 not hasNext
then return Nothing
else do
key <- retrieving "key" $ keyPeeker (nth 2)
value <- retrieving "value" $ valuePeeker (nth 1)
return (Just (key, value))
`lastly` pop 1
peekSet :: (LuaError e, Ord a) => Peeker e a -> Peeker e (Set a)
peekSet :: forall e a. (LuaError e, Ord a) => Peeker e a -> Peeker e (Set a)
peekSet Peeker e a
elementPeeker = Name -> Peek e (Set a) -> Peek e (Set a)
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Set"
(Peek e (Set a) -> Peek e (Set a))
-> (StackIndex -> Peek e (Set a)) -> StackIndex -> Peek e (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, Bool)] -> Set a) -> Peek e [(a, Bool)] -> Peek e (Set a)
forall a b. (a -> b) -> Peek e a -> Peek e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> ([(a, Bool)] -> [a]) -> [(a, Bool)] -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Bool) -> a) -> [(a, Bool)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Bool) -> a
forall a b. (a, b) -> a
fst ([(a, Bool)] -> [a])
-> ([(a, Bool)] -> [(a, Bool)]) -> [(a, Bool)] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Bool) -> Bool) -> [(a, Bool)] -> [(a, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (a, Bool) -> Bool
forall a b. (a, b) -> b
snd)
(Peek e [(a, Bool)] -> Peek e (Set a))
-> (StackIndex -> Peek e [(a, Bool)])
-> StackIndex
-> Peek e (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e a -> Peeker e Bool -> StackIndex -> Peek e [(a, Bool)]
forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e [(a, b)]
peekKeyValuePairs Peeker e a
elementPeeker Peeker e Bool
forall e. Peeker e Bool
peekBool
peekFieldRaw :: LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw :: forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e a
peeker Name
name StackIndex
idx =
Name -> Peek e a -> Peek e a
forall e a. Name -> Peek e a -> Peek e a
retrieving (Name
"raw field '" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
name Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"'") (Peek e a -> Peek e a) -> Peek e a -> Peek e a
forall a b. (a -> b) -> a -> b
$! do
LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e () -> Peek e ()) -> LuaE e () -> Peek e ()
forall a b. (a -> b) -> a -> b
$ do
Int -> String -> LuaE e ()
forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
1 String
"peekFieldRaw"
absidx <- StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
Lua.absindex StackIndex
idx
pushstring $ fromName name
void (rawget 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 #-}
peekIndexRaw :: LuaError e => Lua.Integer -> Peeker e a -> Peeker e a
peekIndexRaw :: forall e a. LuaError e => Integer -> Peeker e a -> Peeker e a
peekIndexRaw Integer
i Peeker e a
peeker StackIndex
idx = do
let showInt :: Integer -> a
showInt (Lua.Integer Int64
x) = String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ Int64 -> String
forall a. Show a => a -> String
show Int64
x
Name -> Peek e a -> Peek e a
forall e a. Name -> Peek e a -> Peek e a
retrieving (String -> Name
forall a. IsString a => String -> a
fromString (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"raw index '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall {a}. IsString a => Integer -> a
showInt Integer
i String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'") (Peek e a -> Peek e a) -> Peek e a -> Peek e a
forall a b. (a -> b) -> a -> b
$! do
LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e () -> Peek e ())
-> (LuaE e Type -> LuaE e ()) -> LuaE e Type -> Peek e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LuaE e Type -> LuaE e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LuaE e Type -> Peek e ()) -> LuaE e Type -> Peek e ()
forall a b. (a -> b) -> a -> b
$ StackIndex -> Integer -> LuaE e Type
forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx Integer
i
Peeker e a
peeker StackIndex
top Peek e a -> LuaE e () -> Peek e a
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
1
{-# INLINABLE peekIndexRaw #-}
peekNilOr :: Alternative m
=> Peeker e a
-> Peeker e (m a)
peekNilOr :: forall (m :: * -> *) e a.
Alternative m =>
Peeker e a -> Peeker e (m a)
peekNilOr Peeker e a
p StackIndex
idx = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e (m a)) -> Peek e (m a)
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeNil -> m a -> Peek e (m a)
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
Type
_ -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> Peek e a -> Peek e (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker e a
p StackIndex
idx
peekNoneOr :: Alternative m
=> Peeker e a
-> Peeker e (m a)
peekNoneOr :: forall (m :: * -> *) e a.
Alternative m =>
Peeker e a -> Peeker e (m a)
peekNoneOr Peeker e a
p StackIndex
idx = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e (m a)) -> Peek e (m a)
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeNone -> m a -> Peek e (m a)
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
Type
_ -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> Peek e a -> Peek e (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker e a
p StackIndex
idx
peekNoneOrNilOr :: Alternative m
=> Peeker e a
-> Peeker e (m a)
peekNoneOrNilOr :: forall (m :: * -> *) e a.
Alternative m =>
Peeker e a -> Peeker e (m a)
peekNoneOrNilOr Peeker e a
p StackIndex
idx = LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e (m a)) -> Peek e (m a)
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeNil -> m a -> Peek e (m a)
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
Type
TypeNone -> m a -> Peek e (m a)
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
Type
_ -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> Peek e a -> Peek e (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peeker e a
p StackIndex
idx
peekPair :: LuaError e
=> Peeker e a -> Peeker e b
-> Peeker e (a, b)
peekPair :: forall e a b.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e (a, b)
peekPair Peeker e a
peekA Peeker e b
peekB StackIndex
idx = Peek e (a, b) -> Peek e (a, b)
forall e a. Peek e a -> Peek e a
cleanup (Peek e (a, b) -> Peek e (a, b)) -> Peek e (a, b) -> Peek e (a, b)
forall a b. (a -> b) -> a -> b
$ do
LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e () -> Peek e ()) -> LuaE e () -> Peek e ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> LuaE e ()
forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
2 String
"retrieving a pair"
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 <- liftLua (rawgeti idx' 1) *> peekA top
b <- liftLua (rawgeti idx' 2) *> peekB top
return (a, b)
peekTriple :: LuaError e
=> Peeker e a -> Peeker e b -> Peeker e c
-> Peeker e (a, b, c)
peekTriple :: forall e a b c.
LuaError e =>
Peeker e a -> Peeker e b -> Peeker e c -> Peeker e (a, b, c)
peekTriple Peeker e a
peekA Peeker e b
peekB Peeker e c
peekC StackIndex
idx = Peek e (a, b, c) -> Peek e (a, b, c)
forall e a. Peek e a -> Peek e a
cleanup (Peek e (a, b, c) -> Peek e (a, b, c))
-> Peek e (a, b, c) -> Peek e (a, b, c)
forall a b. (a -> b) -> a -> b
$ do
LuaE e () -> Peek e ()
forall e a. LuaE e a -> Peek e a
liftLua (LuaE e () -> Peek e ()) -> LuaE e () -> Peek e ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> LuaE e ()
forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
3 String
"retrieving a triple"
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 <- liftLua (rawgeti idx' 1) *> peekA top
b <- liftLua (rawgeti idx' 2) *> peekB top
c <- liftLua (rawgeti idx' 3) *> peekC top
return (a,b,c)
choice :: LuaError e
=> [Peeker e a]
-> Peeker e a
choice :: forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice [Peeker e a]
peekers StackIndex
idx = case [Peeker e a]
peekers of
[] -> ByteString -> Peek e a
forall a e. ByteString -> Peek e a
failPeek ByteString
"all choices failed"
Peeker e a
p:[Peeker e a]
ps -> Peeker e a
p StackIndex
idx Peek e a -> Peek e a -> Peek e a
forall a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Peeker e a] -> Peeker e a
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice [Peeker e a]
ps StackIndex
idx
{-# INLINABLE choice #-}