    {-# LANGUAGE DeriveGeneric     #-}
    {-# LANGUAGE LambdaCase        #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-|
    Module      : HsLua.Typing
    Copyright   : © 2023-2026 Albert Krewinkel
    License     : MIT
    Maintainer  : Albert Krewinkel <tarleb@hslua.org>

    The module provides Haskell types and values that can be used to
    describe and declare the types of Lua values.
    -}
    module HsLua.Typing
      ( TypeSpec (..)
      , (#|#)
      , typeSpecToString
      , typeSpecFromString
        -- * Types
      , anyType
      , voidType
        -- ** Built-in types
      , booleanType
      , functionType
      , integerType
      , lightUserdataType
      , nilType
      , numberType
      , stringType
      , tableType
      , threadType
      , userdataType
        -- ** Type constructors
      , recType
      , seqType
        -- * Marshalling
      , pushTypeSpec
      , peekTypeSpec
      ) where

    import Control.Monad (when)
    import Data.Char (toLower, toUpper)
    import Data.List (find, intercalate)
    import Data.String (IsString (..))
    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

    -- | Type specification for Lua values.
    data TypeSpec =
        BasicType HsLua.Type              -- ^ Built-in type
      | NamedType Name                    -- ^ A type that's been given a name.
      | SeqType TypeSpec                  -- ^ Sequence of the given type.
      | SumType [TypeSpec]                -- ^ Union type; a sum type.
      | RecType (Map.Map Name TypeSpec)   -- ^ Record type (type product).
      | FunType [TypeSpec] [TypeSpec]     -- ^ Function type.
      | AnyType                           -- ^ Unconstrained type.
      deriving (TypeSpec -> TypeSpec -> Bool
    (TypeSpec -> TypeSpec -> Bool)
    -> (TypeSpec -> TypeSpec -> Bool) -> Eq TypeSpec
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TypeSpec -> TypeSpec -> Bool
    == :: TypeSpec -> TypeSpec -> Bool
    $c/= :: TypeSpec -> TypeSpec -> Bool
    /= :: TypeSpec -> TypeSpec -> Bool
    Eq, (forall x. TypeSpec -> Rep TypeSpec x)
    -> (forall x. Rep TypeSpec x -> TypeSpec) -> Generic TypeSpec
    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
    $cfrom :: forall x. TypeSpec -> Rep TypeSpec x
    from :: forall x. TypeSpec -> Rep TypeSpec x
    $cto :: forall x. Rep TypeSpec x -> TypeSpec
    to :: forall x. Rep TypeSpec x -> TypeSpec
    Generic, Eq TypeSpec
    Eq TypeSpec =>
    (TypeSpec -> TypeSpec -> Ordering)
    -> (TypeSpec -> TypeSpec -> Bool)
    -> (TypeSpec -> TypeSpec -> Bool)
    -> (TypeSpec -> TypeSpec -> Bool)
    -> (TypeSpec -> TypeSpec -> Bool)
    -> (TypeSpec -> TypeSpec -> TypeSpec)
    -> (TypeSpec -> TypeSpec -> TypeSpec)
    -> Ord 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
    $ccompare :: TypeSpec -> TypeSpec -> Ordering
    compare :: TypeSpec -> TypeSpec -> Ordering
    $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
    >= :: TypeSpec -> TypeSpec -> Bool
    $cmax :: TypeSpec -> TypeSpec -> TypeSpec
    max :: TypeSpec -> TypeSpec -> TypeSpec
    $cmin :: TypeSpec -> TypeSpec -> TypeSpec
    min :: TypeSpec -> TypeSpec -> TypeSpec
    Ord, Int -> TypeSpec -> ShowS
    [TypeSpec] -> ShowS
    TypeSpec -> [Char]
    (Int -> TypeSpec -> ShowS)
    -> (TypeSpec -> [Char]) -> ([TypeSpec] -> ShowS) -> Show TypeSpec
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TypeSpec -> ShowS
    showsPrec :: Int -> TypeSpec -> ShowS
    $cshow :: TypeSpec -> [Char]
    show :: TypeSpec -> [Char]
    $cshowList :: [TypeSpec] -> ShowS
    showList :: [TypeSpec] -> ShowS
    Show)

    -- | Returns the sum of two type specifiers, declaring that a Lua value
    -- can have either type.
    (#|#) :: TypeSpec -> TypeSpec -> TypeSpec
    TypeSpec
    AnyType    #|# :: TypeSpec -> TypeSpec -> TypeSpec
    #|# TypeSpec
    _          = TypeSpec
    AnyType
    TypeSpec
    _          #|# TypeSpec
    AnyType    = TypeSpec
    AnyType
    SumType [] #|# TypeSpec
    b          = TypeSpec
    b                   -- `SumType []` is `Void`
    TypeSpec
    a          #|# SumType [] = TypeSpec
    a
    SumType [TypeSpec]
    a  #|# SumType [TypeSpec]
    b  = [TypeSpec] -> TypeSpec
    SumType ([TypeSpec]
    a [TypeSpec] -> [TypeSpec] -> [TypeSpec]
    forall a. [a] -> [a] -> [a]
    ++ [TypeSpec]
    b)
    SumType [TypeSpec]
    a  #|# TypeSpec
    b          = [TypeSpec] -> TypeSpec
    SumType ([TypeSpec]
    a [TypeSpec] -> [TypeSpec] -> [TypeSpec]
    forall a. [a] -> [a] -> [a]
    ++ [TypeSpec
    b])
    TypeSpec
    a          #|# SumType [TypeSpec]
    b  = [TypeSpec] -> TypeSpec
    SumType (TypeSpec
    a TypeSpec -> [TypeSpec] -> [TypeSpec]
    forall a. a -> [a] -> [a]
    : [TypeSpec]
    b)
    TypeSpec
    a          #|# TypeSpec
    b          =
      if TypeSpec
    a TypeSpec -> TypeSpec -> Bool
    forall a. Eq a => a -> a -> Bool
    == TypeSpec
    b
      then TypeSpec
    a
      else [TypeSpec] -> TypeSpec
    SumType [TypeSpec
    a, TypeSpec
    b]

    -- | Generate a string representation of the type specifier.
    typeSpecToString :: TypeSpec -> String
    typeSpecToString :: TypeSpec -> [Char]
    typeSpecToString = \case
      BasicType Type
    t   -> Type -> [Char]
    basicTypeName Type
    t
      NamedType Name
    nt  -> ByteString -> [Char]
    toString (ByteString -> [Char]) -> ByteString -> [Char]
    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
    '{' Char -> ShowS
    forall a. a -> [a] -> [a]
    : TypeSpec -> [Char]
    typeSpecToString TypeSpec
    t [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ",...}"
      SumType [TypeSpec]
    specs -> [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    "|" ((TypeSpec -> [Char]) -> [TypeSpec] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map TypeSpec -> [Char]
    typeSpecToString [TypeSpec]
    specs)

    -- | Creates a 'TypeSpec' value from a string.
    --
    -- The implementation currently handles basic types, sequences, and
    -- alternatives. A string that cannot be parsed is returned as a 'Named'
    -- type with the full string as the name.
    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 ((TypeSpec, [Char]) -> Bool)
    -> [(TypeSpec, [Char])] -> Maybe (TypeSpec, [Char])
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (TypeSpec, [Char]) -> Bool
    forall {a} {a}. (a, [a]) -> Bool
    completeParse (ReadP TypeSpec -> ReadS TypeSpec
    forall a. ReadP a -> ReadS a
    readP_to_S ReadP TypeSpec
    pTypeSpec [Char]
    s) of
                            Maybe (TypeSpec, [Char])
    Nothing -> Name -> TypeSpec
    NamedType ([Char] -> Name
    forall a. IsString a => [Char] -> a
    fromString [Char]
    s)  -- Parsing failed
                            Just (TypeSpec
    x,[Char]
    _) -> TypeSpec
    x
     where completeParse :: (a, [a]) -> Bool
    completeParse = [a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([a] -> Bool) -> ((a, [a]) -> [a]) -> (a, [a]) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, [a]) -> [a]
    forall a b. (a, b) -> b
    snd

    pTypeSpec :: ReadP TypeSpec
    pTypeSpec :: ReadP TypeSpec
    pTypeSpec = (TypeSpec -> TypeSpec -> TypeSpec)
    -> TypeSpec -> [TypeSpec] -> TypeSpec
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr TypeSpec -> TypeSpec -> TypeSpec
    (#|#) TypeSpec
    voidType ([TypeSpec] -> TypeSpec) -> ReadP [TypeSpec] -> ReadP TypeSpec
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReadP TypeSpec -> ReadP Char -> ReadP [TypeSpec]
    forall a sep. ReadP a -> ReadP sep -> ReadP [a]
    sepBy (ReadP TypeSpec
    pAtomic ReadP TypeSpec -> ReadP TypeSpec -> ReadP TypeSpec
    forall a. ReadP a -> ReadP a -> ReadP a
    <++ ReadP TypeSpec
    pSeq) (Char -> ReadP Char
    char Char
    '|')

    -- | Parses an atomic, non-composite type.
    pAtomic :: ReadP TypeSpec
    pAtomic :: ReadP TypeSpec
    pAtomic = do
      str <- ReadP Char -> ReadP [Char]
    forall a. ReadP a -> ReadP [a]
    many1 ((Char -> Bool) -> ReadP Char
    satisfy (Char -> [Char] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Char
    '{', Char
    '}', Char
    '|', Char
    ',']))
      pure $ case 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 ([Char] -> Name
    forall a. IsString a => [Char] -> a
    fromString [Char]
    str)

    -- | Parses a sequence type.
    pSeq :: ReadP TypeSpec
    pSeq :: ReadP TypeSpec
    pSeq = TypeSpec -> TypeSpec
    seqType (TypeSpec -> TypeSpec) -> ReadP TypeSpec -> ReadP TypeSpec
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Char -> ReadP Char
    char Char
    '{' ReadP Char -> ReadP TypeSpec -> ReadP TypeSpec
    forall a b. ReadP a -> ReadP b -> ReadP b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ReadP TypeSpec
    pTypeSpec ReadP TypeSpec -> ReadP Char -> ReadP TypeSpec
    forall a b. ReadP a -> ReadP b -> ReadP a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ReadP Char
    pComma ReadP TypeSpec -> ReadP [Char] -> ReadP TypeSpec
    forall a b. ReadP a -> ReadP b -> ReadP a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ReadP [Char]
    pEllipsis ReadP TypeSpec -> ReadP Char -> ReadP TypeSpec
    forall a b. ReadP a -> ReadP b -> ReadP a
    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 ReadP () -> ReadP Char -> ReadP Char
    forall a b. ReadP a -> ReadP b -> ReadP b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Char -> ReadP Char
    char Char
    ',' ReadP Char -> ReadP () -> ReadP Char
    forall a b. ReadP a -> ReadP b -> ReadP a
    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]
    "..." ReadP [Char] -> ReadP () -> ReadP [Char]
    forall a b. ReadP a -> ReadP b -> ReadP a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ReadP ()
    skipSpaces

    --
    -- Built-in types
    --

    -- | Unconstraint type; any Lua value.
    anyType :: TypeSpec
    anyType :: TypeSpec
    anyType = TypeSpec
    AnyType

    -- | A type for which there cannot be any value.
    voidType :: TypeSpec
    voidType :: TypeSpec
    voidType = [TypeSpec] -> TypeSpec
    SumType []

    -- | The built-in @boolean@ Lua type.
    booleanType :: TypeSpec
    booleanType :: TypeSpec
    booleanType = Type -> TypeSpec
    BasicType Type
    HsLua.TypeBoolean

    -- | The built-in @function@ Lua type.
    functionType :: TypeSpec
    functionType :: TypeSpec
    functionType = Type -> TypeSpec
    BasicType Type
    HsLua.TypeFunction

    -- | The built-in @light userdata@ Lua type.
    lightUserdataType :: TypeSpec
    lightUserdataType :: TypeSpec
    lightUserdataType = Type -> TypeSpec
    BasicType Type
    HsLua.TypeLightUserdata

    -- | The built-in @nil@ Lua type.
    nilType :: TypeSpec
    nilType :: TypeSpec
    nilType = Type -> TypeSpec
    BasicType Type
    HsLua.TypeNil

    -- | The built-in @number@ Lua type.
    numberType :: TypeSpec
    numberType :: TypeSpec
    numberType = Type -> TypeSpec
    BasicType Type
    HsLua.TypeNumber

    -- | The built-in @string@ Lua type.
    stringType :: TypeSpec
    stringType :: TypeSpec
    stringType = Type -> TypeSpec
    BasicType Type
    HsLua.TypeString

    -- | The built-in @table@ Lua type.
    tableType :: TypeSpec
    tableType :: TypeSpec
    tableType = Type -> TypeSpec
    BasicType Type
    HsLua.TypeTable

    -- | The built-in @thread@ Lua type.
    threadType :: TypeSpec
    threadType :: TypeSpec
    threadType = Type -> TypeSpec
    BasicType Type
    HsLua.TypeThread

    -- | The built-in @userdata@ Lua type.
    userdataType :: TypeSpec
    userdataType :: TypeSpec
    userdataType = Type -> TypeSpec
    BasicType Type
    HsLua.TypeUserdata

    -- | A Lua integer type.
    integerType :: TypeSpec
    integerType :: TypeSpec
    integerType = Name -> TypeSpec
    NamedType Name
    "integer"

    -- | For backwards compatibility and convenience, strings can be used as
    -- TypeSpec values.
    instance IsString TypeSpec where
      fromString :: [Char] -> TypeSpec
    fromString = [Char] -> TypeSpec
    typeSpecFromString

    --
    -- Constructors
    --

    -- | Creates a sequence type.
    seqType :: TypeSpec -> TypeSpec
    seqType :: TypeSpec -> TypeSpec
    seqType = TypeSpec -> TypeSpec
    SeqType

    -- | Creates a record type.
    recType :: [(Name, TypeSpec)] -> TypeSpec
    recType :: [(Name, TypeSpec)] -> TypeSpec
    recType = Map Name TypeSpec -> TypeSpec
    RecType (Map Name TypeSpec -> TypeSpec)
    -> ([(Name, TypeSpec)] -> Map Name TypeSpec)
    -> [(Name, TypeSpec)]
    -> TypeSpec
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(Name, TypeSpec)] -> Map Name TypeSpec
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList

    --
    -- Marshalling
    --

    -- | Pushes a table representation of a 'TypeSpec' to the stack.
    pushTypeSpec :: LuaError e
                 => TypeSpec
                 -> LuaE e ()
    pushTypeSpec :: forall e. LuaError e => TypeSpec -> LuaE e ()
    pushTypeSpec TypeSpec
    ts = do
      Int -> [Char] -> LuaE e ()
    forall e. LuaError e => Int -> [Char] -> LuaE e ()
    checkstack' Int
    8 [Char]
    "HsLua.Typing.pushTypeSpec"
      case TypeSpec
    ts of
        BasicType Type
    bt  -> [(Name, Type -> LuaE e ())] -> Type -> LuaE e ()
    forall e a.
    LuaError e =>
    [(Name, a -> LuaE e ())] -> a -> LuaE e ()
    pushAsTable [(Name
    "basic", [Char] -> LuaE e ()
    forall e. [Char] -> LuaE e ()
    pushString ([Char] -> LuaE e ()) -> (Type -> [Char]) -> Type -> LuaE e ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> [Char]
    basicTypeName)] Type
    bt
        NamedType Name
    n   -> [(Name, Name -> LuaE e ())] -> Name -> LuaE e ()
    forall e a.
    LuaError e =>
    [(Name, a -> LuaE e ())] -> a -> LuaE e ()
    pushAsTable [(Name
    "named", Name -> LuaE e ()
    forall e. Name -> LuaE e ()
    pushName)] Name
    n
        SeqType TypeSpec
    seq'  -> [(Name, TypeSpec -> LuaE e ())] -> TypeSpec -> LuaE e ()
    forall e a.
    LuaError e =>
    [(Name, a -> LuaE e ())] -> a -> LuaE e ()
    pushAsTable [(Name
    "sequence", TypeSpec -> LuaE e ()
    forall e. LuaError e => TypeSpec -> LuaE e ()
    pushTypeSpec)] TypeSpec
    seq'
        SumType [TypeSpec]
    st    -> [(Name, [TypeSpec] -> LuaE e ())] -> [TypeSpec] -> LuaE e ()
    forall e a.
    LuaError e =>
    [(Name, a -> LuaE e ())] -> a -> LuaE e ()
    pushAsTable [(Name
    "sum", (TypeSpec -> LuaE e ()) -> [TypeSpec] -> LuaE e ()
    forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
    pushList TypeSpec -> LuaE e ()
    forall e. LuaError e => TypeSpec -> LuaE e ()
    pushTypeSpec)] [TypeSpec]
    st
        RecType Map Name TypeSpec
    rt    -> [(Name, Map Name TypeSpec -> LuaE e ())]
    -> Map Name TypeSpec -> LuaE e ()
    forall e a.
    LuaError e =>
    [(Name, a -> LuaE e ())] -> a -> LuaE e ()
    pushAsTable [(Name
    "record", (Name -> LuaE e ())
    -> (TypeSpec -> LuaE e ()) -> Map Name TypeSpec -> LuaE e ()
    forall e a b.
    LuaError e =>
    Pusher e a -> Pusher e b -> Pusher e (Map a b)
    pushMap Name -> LuaE e ()
    forall e. Name -> LuaE e ()
    pushName TypeSpec -> LuaE e ()
    forall e. LuaError e => TypeSpec -> LuaE e ()
    pushTypeSpec)] Map Name TypeSpec
    rt
        FunType [TypeSpec]
    dt [TypeSpec]
    ct -> [(Name, ([TypeSpec], [TypeSpec]) -> LuaE e ())]
    -> ([TypeSpec], [TypeSpec]) -> LuaE e ()
    forall e a.
    LuaError e =>
    [(Name, a -> LuaE e ())] -> a -> LuaE e ()
    pushAsTable [(Name
    "domain", (TypeSpec -> LuaE e ()) -> [TypeSpec] -> LuaE e ()
    forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
    pushList TypeSpec -> LuaE e ()
    forall e. LuaError e => TypeSpec -> LuaE e ()
    pushTypeSpec ([TypeSpec] -> LuaE e ())
    -> (([TypeSpec], [TypeSpec]) -> [TypeSpec])
    -> ([TypeSpec], [TypeSpec])
    -> LuaE e ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([TypeSpec], [TypeSpec]) -> [TypeSpec]
    forall a b. (a, b) -> a
    fst)
                                     ,(Name
    "codomain", (TypeSpec -> LuaE e ()) -> [TypeSpec] -> LuaE e ()
    forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
    pushList TypeSpec -> LuaE e ()
    forall e. LuaError e => TypeSpec -> LuaE e ()
    pushTypeSpec ([TypeSpec] -> LuaE e ())
    -> (([TypeSpec], [TypeSpec]) -> [TypeSpec])
    -> ([TypeSpec], [TypeSpec])
    -> LuaE e ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([TypeSpec], [TypeSpec]) -> [TypeSpec]
    forall a b. (a, b) -> b
    snd)]
                                     ([TypeSpec]
    dt, [TypeSpec]
    ct)
        TypeSpec
    AnyType       -> [(Name, Bool -> LuaE e ())] -> Bool -> LuaE e ()
    forall e a.
    LuaError e =>
    [(Name, a -> LuaE e ())] -> a -> LuaE e ()
    pushAsTable [(Name
    "any", Bool -> LuaE e ()
    forall e. Pusher e Bool
    pushBool)] Bool
    True
      created <- Name -> LuaE e Bool
    forall e. Name -> LuaE e Bool
    newmetatable Name
    "HsLua.TypeSpec"
      when created $ do
        pushHaskellFunction $ do
          ts' <- forcePeek $ peekTypeSpec (nth 1)
          pushString $ typeSpecToString ts'
          return 1
        setfield (nth 2) "__tostring"
      setmetatable (nth 2)

    -- | String representation of a basic type. This is similar to, but
    -- different from the output of @'typename'@, in that 'TypeNone' is
    -- reported as @none@ (instead of @no value@) and 'TypeLightUserdata' is
    -- represented as @light userdata@ (instead of @userdata@).
    basicTypeName :: Type -> String
    basicTypeName :: Type -> [Char]
    basicTypeName = \case
      Type
    TypeLightUserdata -> [Char]
    "light userdata"
      Type
    t                 -> (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop Int
    4 ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ Type -> [Char]
    forall a. Show a => a -> [Char]
    show Type
    t

    -- | Retrieves a 'TypeSpec' from a table on the stack.
    peekTypeSpec :: LuaError e => Peeker e TypeSpec
    peekTypeSpec :: forall e. LuaError e => Peeker e TypeSpec
    peekTypeSpec = Name
    -> (StackIndex -> LuaE e Bool)
    -> Peeker e TypeSpec
    -> Peeker e TypeSpec
    forall e a.
    Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
    typeChecked Name
    "TypeSpec" StackIndex -> LuaE e Bool
    forall e. StackIndex -> LuaE e Bool
    istable (Peeker e TypeSpec -> Peeker e TypeSpec)
    -> Peeker e TypeSpec -> Peeker e TypeSpec
    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 -> [Char] -> LuaE e ()
    forall e. LuaError e => Int -> [Char] -> LuaE e ()
    checkstack' Int
    8 [Char]
    "HsLua.Typing.peekTypeSpec"
      [Peeker e TypeSpec] -> Peeker e TypeSpec
    forall e a. LuaError e => [Peeker e a] -> Peeker e a
    choice
        [ (Type -> TypeSpec) -> Peek e Type -> Peek e TypeSpec
    forall a b. (a -> b) -> Peek e a -> Peek e b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Type -> TypeSpec
    BasicType (Peek e Type -> Peek e TypeSpec)
    -> (StackIndex -> Peek e Type) -> Peeker e TypeSpec
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StackIndex -> Peek e Type) -> Name -> StackIndex -> Peek e Type
    forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
    peekFieldRaw StackIndex -> Peek e Type
    forall {e}. StackIndex -> Peek e Type
    peekBasicType Name
    "basic"
        , (Name -> TypeSpec) -> Peek e Name -> Peek e TypeSpec
    forall a b. (a -> b) -> Peek e a -> Peek e b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Name -> TypeSpec
    NamedType (Peek e Name -> Peek e TypeSpec)
    -> (StackIndex -> Peek e Name) -> Peeker e TypeSpec
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StackIndex -> Peek e Name) -> Name -> StackIndex -> Peek e Name
    forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
    peekFieldRaw StackIndex -> Peek e Name
    forall e. Peeker e Name
    peekName Name
    "named"
        , (TypeSpec -> TypeSpec) -> Peek e TypeSpec -> Peek e TypeSpec
    forall a b. (a -> b) -> Peek e a -> Peek e b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TypeSpec -> TypeSpec
    SeqType (Peek e TypeSpec -> Peek e TypeSpec)
    -> Peeker e TypeSpec -> Peeker e TypeSpec
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Peeker e TypeSpec -> Name -> Peeker e TypeSpec
    forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
    peekFieldRaw Peeker e TypeSpec
    forall e. LuaError e => Peeker e TypeSpec
    peekTypeSpec Name
    "sequence"
        , ([TypeSpec] -> TypeSpec) -> Peek e [TypeSpec] -> Peek e TypeSpec
    forall a b. (a -> b) -> Peek e a -> Peek e b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [TypeSpec] -> TypeSpec
    SumType (Peek e [TypeSpec] -> Peek e TypeSpec)
    -> (StackIndex -> Peek e [TypeSpec]) -> Peeker e TypeSpec
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StackIndex -> Peek e [TypeSpec])
    -> Name -> StackIndex -> Peek e [TypeSpec]
    forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
    peekFieldRaw (Peeker e TypeSpec -> StackIndex -> Peek e [TypeSpec]
    forall a e. LuaError e => Peeker e a -> Peeker e [a]
    peekList Peeker e TypeSpec
    forall e. LuaError e => Peeker e TypeSpec
    peekTypeSpec) Name
    "sum"
        , (Map Name TypeSpec -> TypeSpec)
    -> Peek e (Map Name TypeSpec) -> Peek e TypeSpec
    forall a b. (a -> b) -> Peek e a -> Peek e b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Map Name TypeSpec -> TypeSpec
    RecType (Peek e (Map Name TypeSpec) -> Peek e TypeSpec)
    -> (StackIndex -> Peek e (Map Name TypeSpec)) -> Peeker e TypeSpec
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StackIndex -> Peek e (Map Name TypeSpec))
    -> Name -> StackIndex -> Peek e (Map Name TypeSpec)
    forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
    peekFieldRaw ((StackIndex -> Peek e Name)
    -> Peeker e TypeSpec -> StackIndex -> Peek e (Map Name TypeSpec)
    forall e a b.
    (LuaError e, Ord a) =>
    Peeker e a -> Peeker e b -> Peeker e (Map a b)
    peekMap StackIndex -> Peek e Name
    forall e. Peeker e Name
    peekName Peeker e TypeSpec
    forall e. LuaError e => Peeker e TypeSpec
    peekTypeSpec) Name
    "record"
        , \StackIndex
    i -> do
            dom <- (StackIndex -> Peek e [TypeSpec])
    -> Name -> StackIndex -> Peek e [TypeSpec]
    forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
    peekFieldRaw (Peeker e TypeSpec -> StackIndex -> Peek e [TypeSpec]
    forall a e. LuaError e => Peeker e a -> Peeker e [a]
    peekList Peeker e TypeSpec
    forall e. LuaError e => Peeker e TypeSpec
    peekTypeSpec) Name
    "domain" StackIndex
    i
            cod <- peekFieldRaw (peekList peekTypeSpec) "codomain" i
            pure $ FunType dom cod
        , Peek e TypeSpec -> Peeker e TypeSpec
    forall a b. a -> b -> a
    const (TypeSpec -> Peek e TypeSpec
    forall a. a -> Peek e a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TypeSpec
    AnyType)
        ] StackIndex
    idx
     where
      peekBasicType :: StackIndex -> Peek e Type
    peekBasicType StackIndex
    idx = Peeker e [Char]
    forall e. Peeker e [Char]
    peekString StackIndex
    idx Peek e [Char] -> ([Char] -> Peek e Type) -> Peek e Type
    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
        [Char]
    "light userdata" -> Type -> Peek e Type
    forall a. a -> Peek e a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Type
    TypeLightUserdata
        (Char
    c:[Char]
    cs)           -> Peek e Type -> (Type -> Peek e Type) -> Maybe Type -> Peek e Type
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Char] -> Peek e Type
    forall a. [Char] -> Peek e a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "unknown type") Type -> Peek e Type
    forall a. a -> Peek e a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe Type -> Peek e Type) -> Maybe Type -> Peek e Type
    forall a b. (a -> b) -> a -> b
    $
                            [Char] -> Maybe Type
    forall a. Read a => [Char] -> Maybe a
    readMaybe ([Char]
    "Type" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char -> Char
    toUpper Char
    c Char -> ShowS
    forall a. a -> [a] -> [a]
    : [Char]
    cs)
        [Char]
    _                -> ByteString -> Peek e Type
    forall a e. ByteString -> Peek e a
    failPeek ByteString
    "invalid type string"