{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module HsLua.Typing
( TypeSpec (..)
, TypeDocs (..)
, (#|#)
, typeSpecToString
, typeSpecFromString
, anyType
, voidType
, booleanType
, functionType
, integerType
, lightUserdataType
, nilType
, numberType
, stringType
, tableType
, threadType
, userdataType
, recType
, seqType
, pushTypeSpec
, peekTypeSpec
, pushTypeDoc
, peekTypeDoc
) where
import Control.Monad (when)
import Data.Char (toLower, toUpper)
import Data.List (find, intercalate)
import Data.String (IsString (..))
import Data.Text (Text)
import GHC.Generics (Generic)
import HsLua.Core
import HsLua.Core.Utf8 (toString)
import HsLua.Marshalling
import Text.Read (readMaybe)
import Text.ParserCombinators.ReadP hiding (choice)
import qualified HsLua.Core as HsLua
import qualified Data.Map as Map
data TypeSpec =
BasicType HsLua.Type
| NamedType Name
| SeqType TypeSpec
| SumType [TypeSpec]
| RecType (Map.Map Name TypeSpec)
| FunType [TypeSpec] [TypeSpec]
| AnyType
deriving (TypeSpec -> TypeSpec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeSpec -> TypeSpec -> Bool
$c/= :: TypeSpec -> TypeSpec -> Bool
== :: TypeSpec -> TypeSpec -> Bool
$c== :: TypeSpec -> TypeSpec -> Bool
Eq, forall x. Rep TypeSpec x -> TypeSpec
forall x. TypeSpec -> Rep TypeSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeSpec x -> TypeSpec
$cfrom :: forall x. TypeSpec -> Rep TypeSpec x
Generic, Eq TypeSpec
TypeSpec -> TypeSpec -> Bool
TypeSpec -> TypeSpec -> Ordering
TypeSpec -> TypeSpec -> TypeSpec
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TypeSpec -> TypeSpec -> TypeSpec
$cmin :: TypeSpec -> TypeSpec -> TypeSpec
max :: TypeSpec -> TypeSpec -> TypeSpec
$cmax :: TypeSpec -> TypeSpec -> TypeSpec
>= :: TypeSpec -> TypeSpec -> Bool
$c>= :: TypeSpec -> TypeSpec -> Bool
> :: TypeSpec -> TypeSpec -> Bool
$c> :: TypeSpec -> TypeSpec -> Bool
<= :: TypeSpec -> TypeSpec -> Bool
$c<= :: TypeSpec -> TypeSpec -> Bool
< :: TypeSpec -> TypeSpec -> Bool
$c< :: TypeSpec -> TypeSpec -> Bool
compare :: TypeSpec -> TypeSpec -> Ordering
$ccompare :: TypeSpec -> TypeSpec -> Ordering
Ord, Int -> TypeSpec -> ShowS
[TypeSpec] -> ShowS
TypeSpec -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TypeSpec] -> ShowS
$cshowList :: [TypeSpec] -> ShowS
show :: TypeSpec -> [Char]
$cshow :: TypeSpec -> [Char]
showsPrec :: Int -> TypeSpec -> ShowS
$cshowsPrec :: Int -> TypeSpec -> ShowS
Show)
data TypeDocs = TypeDocs
{ TypeDocs -> Text
typeDescription :: Text
, TypeDocs -> TypeSpec
typeSpec :: TypeSpec
, TypeDocs -> Maybe Name
typeRegistry :: Maybe Name
}
deriving (TypeDocs -> TypeDocs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeDocs -> TypeDocs -> Bool
$c/= :: TypeDocs -> TypeDocs -> Bool
== :: TypeDocs -> TypeDocs -> Bool
$c== :: TypeDocs -> TypeDocs -> Bool
Eq, forall x. Rep TypeDocs x -> TypeDocs
forall x. TypeDocs -> Rep TypeDocs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeDocs x -> TypeDocs
$cfrom :: forall x. TypeDocs -> Rep TypeDocs x
Generic, Eq TypeDocs
TypeDocs -> TypeDocs -> Bool
TypeDocs -> TypeDocs -> Ordering
TypeDocs -> TypeDocs -> TypeDocs
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TypeDocs -> TypeDocs -> TypeDocs
$cmin :: TypeDocs -> TypeDocs -> TypeDocs
max :: TypeDocs -> TypeDocs -> TypeDocs
$cmax :: TypeDocs -> TypeDocs -> TypeDocs
>= :: TypeDocs -> TypeDocs -> Bool
$c>= :: TypeDocs -> TypeDocs -> Bool
> :: TypeDocs -> TypeDocs -> Bool
$c> :: TypeDocs -> TypeDocs -> Bool
<= :: TypeDocs -> TypeDocs -> Bool
$c<= :: TypeDocs -> TypeDocs -> Bool
< :: TypeDocs -> TypeDocs -> Bool
$c< :: TypeDocs -> TypeDocs -> Bool
compare :: TypeDocs -> TypeDocs -> Ordering
$ccompare :: TypeDocs -> TypeDocs -> Ordering
Ord, Int -> TypeDocs -> ShowS
[TypeDocs] -> ShowS
TypeDocs -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TypeDocs] -> ShowS
$cshowList :: [TypeDocs] -> ShowS
show :: TypeDocs -> [Char]
$cshow :: TypeDocs -> [Char]
showsPrec :: Int -> TypeDocs -> ShowS
$cshowsPrec :: Int -> TypeDocs -> ShowS
Show)
(#|#) :: TypeSpec -> TypeSpec -> TypeSpec
TypeSpec
AnyType #|# :: TypeSpec -> TypeSpec -> TypeSpec
#|# TypeSpec
_ = TypeSpec
AnyType
TypeSpec
_ #|# TypeSpec
AnyType = TypeSpec
AnyType
SumType [] #|# TypeSpec
b = TypeSpec
b
TypeSpec
a #|# SumType [] = TypeSpec
a
SumType [TypeSpec]
a #|# SumType [TypeSpec]
b = [TypeSpec] -> TypeSpec
SumType ([TypeSpec]
a forall a. [a] -> [a] -> [a]
++ [TypeSpec]
b)
SumType [TypeSpec]
a #|# TypeSpec
b = [TypeSpec] -> TypeSpec
SumType ([TypeSpec]
a forall a. [a] -> [a] -> [a]
++ [TypeSpec
b])
TypeSpec
a #|# SumType [TypeSpec]
b = [TypeSpec] -> TypeSpec
SumType (TypeSpec
a forall a. a -> [a] -> [a]
: [TypeSpec]
b)
TypeSpec
a #|# TypeSpec
b =
if TypeSpec
a forall a. Eq a => a -> a -> Bool
== TypeSpec
b
then TypeSpec
a
else [TypeSpec] -> TypeSpec
SumType [TypeSpec
a, TypeSpec
b]
typeSpecToString :: TypeSpec -> String
typeSpecToString :: TypeSpec -> [Char]
typeSpecToString = \case
BasicType Type
t -> Type -> [Char]
basicTypeName Type
t
NamedType Name
nt -> ByteString -> [Char]
toString forall a b. (a -> b) -> a -> b
$ Name -> ByteString
fromName Name
nt
TypeSpec
AnyType -> [Char]
"any"
FunType{} -> [Char]
"function"
RecType{} -> [Char]
"table"
SeqType TypeSpec
t -> Char
'{' forall a. a -> [a] -> [a]
: TypeSpec -> [Char]
typeSpecToString TypeSpec
t forall a. [a] -> [a] -> [a]
++ [Char]
",...}"
SumType [TypeSpec]
specs -> forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"|" (forall a b. (a -> b) -> [a] -> [b]
map TypeSpec -> [Char]
typeSpecToString [TypeSpec]
specs)
typeSpecFromString :: String -> TypeSpec
typeSpecFromString :: [Char] -> TypeSpec
typeSpecFromString = \case
[Char]
"any" -> TypeSpec
anyType
[Char]
"boolean" -> TypeSpec
booleanType
[Char]
"function" -> TypeSpec
functionType
[Char]
"integer" -> TypeSpec
integerType
[Char]
"light userdata" -> TypeSpec
lightUserdataType
[Char]
"nil" -> TypeSpec
nilType
[Char]
"number" -> TypeSpec
numberType
[Char]
"string" -> TypeSpec
stringType
[Char]
"table" -> TypeSpec
tableType
[Char]
"userdata" -> TypeSpec
userdataType
[Char]
s -> case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find forall {a} {a}. (a, [a]) -> Bool
completeParse (forall a. ReadP a -> ReadS a
readP_to_S ReadP TypeSpec
pTypeSpec [Char]
s) of
Maybe (TypeSpec, [Char])
Nothing -> Name -> TypeSpec
NamedType (forall a. IsString a => [Char] -> a
fromString [Char]
s)
Just (TypeSpec
x,[Char]
_) -> TypeSpec
x
where completeParse :: (a, [a]) -> Bool
completeParse = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
pTypeSpec :: ReadP TypeSpec
pTypeSpec :: ReadP TypeSpec
pTypeSpec = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TypeSpec -> TypeSpec -> TypeSpec
(#|#) TypeSpec
voidType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a sep. ReadP a -> ReadP sep -> ReadP [a]
sepBy (ReadP TypeSpec
pAtomic forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP TypeSpec
pSeq) (Char -> ReadP Char
char Char
'|')
pAtomic :: ReadP TypeSpec
pAtomic :: ReadP TypeSpec
pAtomic = do
[Char]
str <- forall a. ReadP a -> ReadP [a]
many1 ((Char -> Bool) -> ReadP Char
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'{', Char
'}', Char
'|', Char
',']))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case [Char]
str of
[Char]
"any" -> TypeSpec
anyType
[Char]
"boolean" -> TypeSpec
booleanType
[Char]
"function" -> TypeSpec
functionType
[Char]
"integer" -> TypeSpec
integerType
[Char]
"light userdata" -> TypeSpec
lightUserdataType
[Char]
"nil" -> TypeSpec
nilType
[Char]
"number" -> TypeSpec
numberType
[Char]
"string" -> TypeSpec
stringType
[Char]
"table" -> TypeSpec
tableType
[Char]
"userdata" -> TypeSpec
userdataType
[Char]
_ -> Name -> TypeSpec
NamedType (forall a. IsString a => [Char] -> a
fromString [Char]
str)
pSeq :: ReadP TypeSpec
pSeq :: ReadP TypeSpec
pSeq = TypeSpec -> TypeSpec
seqType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ReadP Char
char Char
'{' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP TypeSpec
pTypeSpec forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP Char
pComma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP [Char]
pEllipsis forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ReadP Char
char Char
'}')
where
pComma :: ReadP Char
pComma :: ReadP Char
pComma = ReadP ()
skipSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ReadP Char
char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
skipSpaces
pEllipsis :: ReadP String
pEllipsis :: ReadP [Char]
pEllipsis = [Char] -> ReadP [Char]
string [Char]
"..." forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
skipSpaces
anyType :: TypeSpec
anyType :: TypeSpec
anyType = TypeSpec
AnyType
voidType :: TypeSpec
voidType :: TypeSpec
voidType = [TypeSpec] -> TypeSpec
SumType []
booleanType :: TypeSpec
booleanType :: TypeSpec
booleanType = Type -> TypeSpec
BasicType Type
HsLua.TypeBoolean
functionType :: TypeSpec
functionType :: TypeSpec
functionType = Type -> TypeSpec
BasicType Type
HsLua.TypeFunction
lightUserdataType :: TypeSpec
lightUserdataType :: TypeSpec
lightUserdataType = Type -> TypeSpec
BasicType Type
HsLua.TypeLightUserdata
nilType :: TypeSpec
nilType :: TypeSpec
nilType = Type -> TypeSpec
BasicType Type
HsLua.TypeNil
numberType :: TypeSpec
numberType :: TypeSpec
numberType = Type -> TypeSpec
BasicType Type
HsLua.TypeNumber
stringType :: TypeSpec
stringType :: TypeSpec
stringType = Type -> TypeSpec
BasicType Type
HsLua.TypeString
tableType :: TypeSpec
tableType :: TypeSpec
tableType = Type -> TypeSpec
BasicType Type
HsLua.TypeTable
threadType :: TypeSpec
threadType :: TypeSpec
threadType = Type -> TypeSpec
BasicType Type
HsLua.TypeThread
userdataType :: TypeSpec
userdataType :: TypeSpec
userdataType = Type -> TypeSpec
BasicType Type
HsLua.TypeUserdata
integerType :: TypeSpec
integerType :: TypeSpec
integerType = Name -> TypeSpec
NamedType Name
"integer"
instance IsString TypeSpec where
fromString :: [Char] -> TypeSpec
fromString = [Char] -> TypeSpec
typeSpecFromString
seqType :: TypeSpec -> TypeSpec
seqType :: TypeSpec -> TypeSpec
seqType = TypeSpec -> TypeSpec
SeqType
recType :: [(Name, TypeSpec)] -> TypeSpec
recType :: [(Name, TypeSpec)] -> TypeSpec
recType = Map Name TypeSpec -> TypeSpec
RecType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
pushTypeDoc :: LuaError e => Pusher e TypeDocs
pushTypeDoc :: forall e. LuaError e => Pusher e TypeDocs
pushTypeDoc TypeDocs
td = do
forall e. LuaError e => Int -> [Char] -> LuaE e ()
checkstack' Int
8 [Char]
"HsLua.Typing.pushTypeDoc"
forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
[ (Name
"description", forall e. Pusher e Text
pushText forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDocs -> Text
typeDescription)
, (Name
"typespec", forall e. LuaError e => TypeSpec -> LuaE e ()
pushTypeSpec forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDocs -> TypeSpec
typeSpec)
, (Name
"registry", forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall e. LuaE e ()
pushnil forall e. Name -> LuaE e ()
pushName forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDocs -> Maybe Name
typeRegistry)
] TypeDocs
td
peekTypeDoc :: LuaError e => Peeker e TypeDocs
peekTypeDoc :: forall e. LuaError e => Peeker e TypeDocs
peekTypeDoc = forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"TypeDoc" forall e. StackIndex -> LuaE e Bool
istable forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> do
forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Int -> [Char] -> LuaE e ()
checkstack' Int
8 [Char]
"HsLua.Typing.peekTypeDoc"
Text
desc <- forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. Peeker e Text
peekText Name
"description" StackIndex
idx
TypeSpec
spec <- forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. LuaError e => Peeker e TypeSpec
peekTypeSpec Name
"typespec" StackIndex
idx
Maybe Name
regn <- forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (forall (m :: * -> *) e a.
Alternative m =>
Peeker e a -> Peeker e (m a)
peekNilOr forall e. Peeker e Name
peekName) Name
"registry" StackIndex
idx
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> TypeSpec -> Maybe Name -> TypeDocs
TypeDocs Text
desc TypeSpec
spec Maybe Name
regn
pushTypeSpec :: LuaError e
=> TypeSpec
-> LuaE e ()
pushTypeSpec :: forall e. LuaError e => TypeSpec -> LuaE e ()
pushTypeSpec TypeSpec
ts = do
forall e. LuaError e => Int -> [Char] -> LuaE e ()
checkstack' Int
8 [Char]
"HsLua.Typing.pushTypeSpec"
case TypeSpec
ts of
BasicType Type
bt -> forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable [(Name
"basic", forall e. [Char] -> LuaE e ()
pushString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> [Char]
basicTypeName)] Type
bt
NamedType Name
n -> forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable [(Name
"named", forall e. Name -> LuaE e ()
pushName)] Name
n
SeqType TypeSpec
seq' -> forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable [(Name
"sequence", forall e. LuaError e => TypeSpec -> LuaE e ()
pushTypeSpec)] TypeSpec
seq'
SumType [TypeSpec]
st -> forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable [(Name
"sum", forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList forall e. LuaError e => TypeSpec -> LuaE e ()
pushTypeSpec)] [TypeSpec]
st
RecType Map Name TypeSpec
rt -> forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable [(Name
"record", forall e a b.
LuaError e =>
Pusher e a -> Pusher e b -> Pusher e (Map a b)
pushMap forall e. Name -> LuaE e ()
pushName forall e. LuaError e => TypeSpec -> LuaE e ()
pushTypeSpec)] Map Name TypeSpec
rt
FunType [TypeSpec]
dt [TypeSpec]
ct -> forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable [(Name
"domain", forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList forall e. LuaError e => TypeSpec -> LuaE e ()
pushTypeSpec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
,(Name
"codomain", forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList forall e. LuaError e => TypeSpec -> LuaE e ()
pushTypeSpec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)]
([TypeSpec]
dt, [TypeSpec]
ct)
TypeSpec
AnyType -> forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable [(Name
"any", forall e. Pusher e Bool
pushBool)] Bool
True
Bool
created <- forall e. Name -> LuaE e Bool
newmetatable Name
"HsLua.TypeSpec"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
created forall a b. (a -> b) -> a -> b
$ do
forall e. LuaError e => HaskellFunction e -> LuaE e ()
pushHaskellFunction forall a b. (a -> b) -> a -> b
$ do
TypeSpec
ts' <- forall e a. LuaError e => Peek e a -> LuaE e a
forcePeek forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Peeker e TypeSpec
peekTypeSpec (CInt -> StackIndex
nth CInt
1)
forall e. [Char] -> LuaE e ()
pushString forall a b. (a -> b) -> a -> b
$ TypeSpec -> [Char]
typeSpecToString TypeSpec
ts'
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield (CInt -> StackIndex
nth CInt
2) Name
"__tostring"
forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)
basicTypeName :: Type -> String
basicTypeName :: Type -> [Char]
basicTypeName = \case
Type
TypeLightUserdata -> [Char]
"light userdata"
Type
t -> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
4 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Type
t
peekTypeSpec :: LuaError e => Peeker e TypeSpec
peekTypeSpec :: forall e. LuaError e => Peeker e TypeSpec
peekTypeSpec = forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"TypeSpec" forall e. StackIndex -> LuaE e Bool
istable forall a b. (a -> b) -> a -> b
$ \StackIndex
idx -> do
forall e a. LuaE e a -> Peek e a
liftLua forall a b. (a -> b) -> a -> b
$ forall e. LuaError e => Int -> [Char] -> LuaE e ()
checkstack' Int
8 [Char]
"HsLua.Typing.peekTypeSpec"
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice
[ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> TypeSpec
BasicType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall {e}. StackIndex -> Peek e Type
peekBasicType Name
"basic"
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> TypeSpec
NamedType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. Peeker e Name
peekName Name
"named"
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeSpec -> TypeSpec
SeqType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. LuaError e => Peeker e TypeSpec
peekTypeSpec Name
"sequence"
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [TypeSpec] -> TypeSpec
SumType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e TypeSpec
peekTypeSpec) Name
"sum"
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Name TypeSpec -> TypeSpec
RecType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (forall e a b.
(LuaError e, Ord a) =>
Peeker e a -> Peeker e b -> Peeker e (Map a b)
peekMap forall e. Peeker e Name
peekName forall e. LuaError e => Peeker e TypeSpec
peekTypeSpec) Name
"record"
, \StackIndex
i -> do
[TypeSpec]
dom <- forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e TypeSpec
peekTypeSpec) Name
"domain" StackIndex
i
[TypeSpec]
cod <- forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e TypeSpec
peekTypeSpec) Name
"codomain" StackIndex
i
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [TypeSpec] -> [TypeSpec] -> TypeSpec
FunType [TypeSpec]
dom [TypeSpec]
cod
, forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSpec
AnyType)
] StackIndex
idx
where
peekBasicType :: StackIndex -> Peek e Type
peekBasicType StackIndex
idx = forall e. Peeker e [Char]
peekString StackIndex
idx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[Char]
"light userdata" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
TypeLightUserdata
(Char
c:[Char]
cs) -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"unknown type") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char]
"Type" forall a. [a] -> [a] -> [a]
++ Char -> Char
toUpper Char
c forall a. a -> [a] -> [a]
: [Char]
cs)
[Char]
_ -> forall a e. ByteString -> Peek e a
failPeek ByteString
"invalid type string"