-- editorconfig-checker-disable-file
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeApplications  #-}

module PlutusCore.Parser.Type where

import PlutusPrelude

import PlutusCore.Annotation
import PlutusCore.Core.Type
import PlutusCore.Crypto.BLS12_381.G1 as BLS12_381.G1
import PlutusCore.Crypto.BLS12_381.G2 as BLS12_381.G2
import PlutusCore.Crypto.BLS12_381.Pairing as BLS12_381.Pairing
import PlutusCore.Data
import PlutusCore.Default
import PlutusCore.MkPlc (mkIterTyApp)
import PlutusCore.Name.Unique
import PlutusCore.Parser.ParserCommon

import Control.Monad
import Data.ByteString (ByteString)
import Data.Text (Text)
import Text.Megaparsec hiding (ParseError, State, many, parse, some)

-- | A PLC @Type@ to be parsed. ATM the parser only works
-- for types in the @DefaultUni@ with @DefaultFun@.
type PType = Type TyName DefaultUni SrcSpan

varType :: Parser PType
varType :: Parser PType
varType = (SrcSpan -> Parser PType) -> Parser PType
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PType) -> Parser PType)
-> (SrcSpan -> Parser PType) -> Parser PType
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
    SrcSpan -> TyName -> PType
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
TyVar SrcSpan
sp (TyName -> PType)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     TyName
-> Parser PType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  TyName
tyName

funType :: Parser PType
funType :: Parser PType
funType = (SrcSpan -> Parser PType) -> Parser PType
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PType) -> Parser PType)
-> (SrcSpan -> Parser PType) -> Parser PType
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
    Parser PType -> Parser PType
forall a. Parser a -> Parser a
inParens (Parser PType -> Parser PType) -> Parser PType -> Parser PType
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PType -> PType -> PType
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
TyFun SrcSpan
sp (PType -> PType -> PType)
-> Parser PType
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (PType -> PType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
"fun" Parser Text -> Parser PType -> Parser PType
forall a b.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser PType
pType) ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (PType -> PType)
-> Parser PType -> Parser PType
forall a b.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (a -> b)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PType
pType

allType :: Parser PType
allType :: Parser PType
allType = (SrcSpan -> Parser PType) -> Parser PType
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PType) -> Parser PType)
-> (SrcSpan -> Parser PType) -> Parser PType
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
    Parser PType -> Parser PType
forall a. Parser a -> Parser a
inParens (Parser PType -> Parser PType) -> Parser PType -> Parser PType
forall a b. (a -> b) -> a -> b
$ SrcSpan -> TyName -> Kind SrcSpan -> PType -> PType
forall tyname (uni :: * -> *) ann.
ann
-> tyname -> Kind ann -> Type tyname uni ann -> Type tyname uni ann
TyForall SrcSpan
sp (TyName -> Kind SrcSpan -> PType -> PType)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     TyName
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan -> PType -> PType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
"all" Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     TyName
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     TyName
forall a b.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  TyName
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     TyName
forall a. Parser a -> Parser a
trailingWhitespace ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  TyName
tyName) ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Kind SrcSpan -> PType -> PType)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (PType -> PType)
forall a b.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (a -> b)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Kind SrcSpan)
kind ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (PType -> PType)
-> Parser PType -> Parser PType
forall a b.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (a -> b)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PType
pType

lamType :: Parser PType
lamType :: Parser PType
lamType = (SrcSpan -> Parser PType) -> Parser PType
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PType) -> Parser PType)
-> (SrcSpan -> Parser PType) -> Parser PType
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
    Parser PType -> Parser PType
forall a. Parser a -> Parser a
inParens (Parser PType -> Parser PType) -> Parser PType -> Parser PType
forall a b. (a -> b) -> a -> b
$ SrcSpan -> TyName -> Kind SrcSpan -> PType -> PType
forall tyname (uni :: * -> *) ann.
ann
-> tyname -> Kind ann -> Type tyname uni ann -> Type tyname uni ann
TyLam SrcSpan
sp (TyName -> Kind SrcSpan -> PType -> PType)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     TyName
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan -> PType -> PType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
"lam" Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     TyName
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     TyName
forall a b.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  TyName
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     TyName
forall a. Parser a -> Parser a
trailingWhitespace ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  TyName
tyName) ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Kind SrcSpan -> PType -> PType)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (PType -> PType)
forall a b.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (a -> b)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Kind SrcSpan)
kind ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (PType -> PType)
-> Parser PType -> Parser PType
forall a b.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (a -> b)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PType
pType

ifixType :: Parser PType
ifixType :: Parser PType
ifixType = (SrcSpan -> Parser PType) -> Parser PType
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PType) -> Parser PType)
-> (SrcSpan -> Parser PType) -> Parser PType
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
    Parser PType -> Parser PType
forall a. Parser a -> Parser a
inParens (Parser PType -> Parser PType) -> Parser PType -> Parser PType
forall a b. (a -> b) -> a -> b
$ SrcSpan -> PType -> PType -> PType
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
TyIFix SrcSpan
sp (PType -> PType -> PType)
-> Parser PType
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (PType -> PType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
"ifix" Parser Text -> Parser PType -> Parser PType
forall a b.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser PType
pType) ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (PType -> PType)
-> Parser PType -> Parser PType
forall a b.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (a -> b)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PType
pType

builtinType :: Parser PType
builtinType :: Parser PType
builtinType = (SrcSpan -> Parser PType) -> Parser PType
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PType) -> Parser PType)
-> (SrcSpan -> Parser PType) -> Parser PType
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp -> Parser PType -> Parser PType
forall a. Parser a -> Parser a
inParens (Parser PType -> Parser PType) -> Parser PType -> Parser PType
forall a b. (a -> b) -> a -> b
$ do
    SomeTypeIn (Kinded DefaultUni (Esc a)
uni) <- Text -> Parser Text
symbol Text
"con" Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a b.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (SomeTypeIn (Kinded DefaultUni))
defaultUni
    PType -> Parser PType
forall a.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PType -> Parser PType) -> PType -> Parser PType
forall a b. (a -> b) -> a -> b
$ SrcSpan -> SomeTypeIn DefaultUni -> PType
forall tyname (uni :: * -> *) ann.
ann -> SomeTypeIn uni -> Type tyname uni ann
TyBuiltin SrcSpan
sp (DefaultUni (Esc a) -> SomeTypeIn DefaultUni
forall (uni :: * -> *) k (a :: k). uni (Esc a) -> SomeTypeIn uni
SomeTypeIn DefaultUni (Esc a)
uni)

sopType :: Parser PType
sopType :: Parser PType
sopType = (SrcSpan -> Parser PType) -> Parser PType
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PType) -> Parser PType)
-> (SrcSpan -> Parser PType) -> Parser PType
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp -> Parser PType -> Parser PType
forall a. Parser a -> Parser a
inParens (Parser PType -> Parser PType) -> Parser PType -> Parser PType
forall a b. (a -> b) -> a -> b
$ SrcSpan -> [[PType]] -> PType
forall tyname (uni :: * -> *) ann.
ann -> [[Type tyname uni ann]] -> Type tyname uni ann
TySOP SrcSpan
sp ([[PType]] -> PType)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [[PType]]
-> Parser PType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
"sop" Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [[PType]]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [[PType]]
forall a b.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  [PType]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [[PType]]
forall a.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  [PType]
tyList)
  where
    tyList :: Parser [PType]
    tyList :: ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  [PType]
tyList = (ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  [PType]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [PType]
forall a. Parser a -> Parser a
inBrackets (ParsecT
   ParserError
   Text
   (StateT ParserState (ReaderT (Maybe Version) Quote))
   [PType]
 -> ParsecT
      ParserError
      Text
      (StateT ParserState (ReaderT (Maybe Version) Quote))
      [PType])
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [PType]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [PType]
forall a b. (a -> b) -> a -> b
$ Parser PType
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [PType]
forall a.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser PType
pType) ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  [PType]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     ()
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [PType]
forall a b.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  ()
whitespace

appType :: Parser PType
appType :: Parser PType
appType = (SrcSpan -> Parser PType) -> Parser PType
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PType) -> Parser PType)
-> (SrcSpan -> Parser PType) -> Parser PType
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp -> Parser PType -> Parser PType
forall a. Parser a -> Parser a
inBrackets (Parser PType -> Parser PType) -> Parser PType -> Parser PType
forall a b. (a -> b) -> a -> b
$ do
    PType
fn   <- Parser PType
pType
    [PType]
args <- Parser PType
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [PType]
forall a.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser PType
pType
    -- TODO: should not use the same `sp` for all arguments.
    PType -> Parser PType
forall a.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PType -> Parser PType) -> PType -> Parser PType
forall a b. (a -> b) -> a -> b
$ PType -> [(SrcSpan, PType)] -> PType
forall tyname (uni :: * -> *) ann.
Type tyname uni ann
-> [(ann, Type tyname uni ann)] -> Type tyname uni ann
mkIterTyApp PType
fn ((SrcSpan
sp,) (PType -> (SrcSpan, PType)) -> [PType] -> [(SrcSpan, PType)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PType]
args)

kind :: Parser (Kind SrcSpan)
kind :: ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Kind SrcSpan)
kind = (SrcSpan
 -> ParsecT
      ParserError
      Text
      (StateT ParserState (ReaderT (Maybe Version) Quote))
      (Kind SrcSpan))
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan)
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan
  -> ParsecT
       ParserError
       Text
       (StateT ParserState (ReaderT (Maybe Version) Quote))
       (Kind SrcSpan))
 -> ParsecT
      ParserError
      Text
      (StateT ParserState (ReaderT (Maybe Version) Quote))
      (Kind SrcSpan))
-> (SrcSpan
    -> ParsecT
         ParserError
         Text
         (StateT ParserState (ReaderT (Maybe Version) Quote))
         (Kind SrcSpan))
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan)
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
    let typeKind :: ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Kind SrcSpan)
typeKind = SrcSpan -> Kind SrcSpan
forall ann. ann -> Kind ann
Type SrcSpan
sp Kind SrcSpan
-> Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan)
forall a b.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"type"
        funKind :: ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Kind SrcSpan)
funKind = SrcSpan -> Kind SrcSpan -> Kind SrcSpan -> Kind SrcSpan
forall ann. ann -> Kind ann -> Kind ann -> Kind ann
KindArrow SrcSpan
sp (Kind SrcSpan -> Kind SrcSpan -> Kind SrcSpan)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan -> Kind SrcSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
"fun" Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan)
forall a b.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Kind SrcSpan)
kind) ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Kind SrcSpan -> Kind SrcSpan)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan)
forall a b.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (a -> b)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Kind SrcSpan)
kind
     in ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Kind SrcSpan)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan)
forall a. Parser a -> Parser a
inParens (ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Kind SrcSpan)
typeKind ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Kind SrcSpan)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Kind SrcSpan)
forall a.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Kind SrcSpan)
funKind)

-- | Parser for @PType@.
pType :: Parser PType
pType :: Parser PType
pType = [Parser PType] -> Parser PType
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser PType] -> Parser PType) -> [Parser PType] -> Parser PType
forall a b. (a -> b) -> a -> b
$ (Parser PType -> Parser PType) -> [Parser PType] -> [Parser PType]
forall a b. (a -> b) -> [a] -> [b]
map Parser PType -> Parser PType
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
    [ Parser PType
funType
    , Parser PType
ifixType
    , Parser PType
allType
    , Parser PType
builtinType
    , Parser PType
lamType
    , Parser PType
appType
    , Parser PType
varType
    , Parser PType
sopType
    ]

-- | Parser for built-in type applications.  The textual names here should match
-- the ones in the PrettyBy instance for DefaultUni in PlutusCore.Default.Universe.
defaultUniApplication :: Parser (SomeTypeIn (Kinded DefaultUni))
defaultUniApplication :: ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (SomeTypeIn (Kinded DefaultUni))
defaultUniApplication = do
    -- Parse the head of the application.
    SomeTypeIn (Kinded DefaultUni)
f <- ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (SomeTypeIn (Kinded DefaultUni))
defaultUni
    -- Parse the arguments.
    [SomeTypeIn (Kinded DefaultUni)]
as <- ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (SomeTypeIn (Kinded DefaultUni))
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [SomeTypeIn (Kinded DefaultUni)]
forall a.
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (SomeTypeIn (Kinded DefaultUni))
defaultUni
    -- Iteratively apply the head to the arguments checking that the kinds match and
    -- failing otherwise.
    (SomeTypeIn (Kinded DefaultUni)
 -> SomeTypeIn (Kinded DefaultUni)
 -> ParsecT
      ParserError
      Text
      (StateT ParserState (ReaderT (Maybe Version) Quote))
      (SomeTypeIn (Kinded DefaultUni)))
-> SomeTypeIn (Kinded DefaultUni)
-> [SomeTypeIn (Kinded DefaultUni)]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM SomeTypeIn (Kinded DefaultUni)
-> SomeTypeIn (Kinded DefaultUni)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall (m :: * -> *) (uni :: * -> *).
(MonadPlus m, HasUniApply uni) =>
SomeTypeIn (Kinded uni)
-> SomeTypeIn (Kinded uni) -> m (SomeTypeIn (Kinded uni))
tryUniApply SomeTypeIn (Kinded DefaultUni)
f [SomeTypeIn (Kinded DefaultUni)]
as

-- | Parser for built-in types (the ones from 'DefaultUni' specifically).
--
-- 'Kinded' is needed for checking that a type function can be applied to its argument.
-- I.e. we do Plutus kind checking of builtin type applications during parsing, which is
-- unfortunate, but there's no way we could construct a 'DefaultUni' otherwise.
--
-- In case of kind error no sensible message is shown, only an overly general one:
--
-- >>> :set -XTypeApplications
-- >>> :set -XOverloadedStrings
-- >>> import PlutusCore.Error
-- >>> import PlutusCore.Quote
-- >>> let runP = putStrLn . either display display . runQuoteT . parseGen @ParserErrorBundle defaultUni
-- >>> runP "(list integer)"
-- (list integer)
-- >>> runP "(bool integer)"
-- test:1:14:
--   |
-- 1 | (bool integer)
--   |              ^
-- expecting "bool", "bytestring", "data", "integer", "list", "pair", "string", "unit", or '('
--
-- This is to be fixed.
--
-- One thing we could do to avoid doing kind checking during parsing is to parse into
--
--     data TextualUni a where
--         TextualUni :: TextualUni (Esc (Tree Text))
--
-- i.e. parse into @Tree Text@ and do the kind checking afterwards, but given that we'll still need
-- to do the kind checking of builtins regardless (even for UPLC), we don't win much by deferring
-- doing it.
defaultUni :: Parser (SomeTypeIn (Kinded DefaultUni))
defaultUni :: ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (SomeTypeIn (Kinded DefaultUni))
defaultUni = [ParsecT
   ParserError
   Text
   (StateT ParserState (ReaderT (Maybe Version) Quote))
   (SomeTypeIn (Kinded DefaultUni))]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT
    ParserError
    Text
    (StateT ParserState (ReaderT (Maybe Version) Quote))
    (SomeTypeIn (Kinded DefaultUni))]
 -> ParsecT
      ParserError
      Text
      (StateT ParserState (ReaderT (Maybe Version) Quote))
      (SomeTypeIn (Kinded DefaultUni)))
-> [ParsecT
      ParserError
      Text
      (StateT ParserState (ReaderT (Maybe Version) Quote))
      (SomeTypeIn (Kinded DefaultUni))]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a b. (a -> b) -> a -> b
$ (ParsecT
   ParserError
   Text
   (StateT ParserState (ReaderT (Maybe Version) Quote))
   (SomeTypeIn (Kinded DefaultUni))
 -> ParsecT
      ParserError
      Text
      (StateT ParserState (ReaderT (Maybe Version) Quote))
      (SomeTypeIn (Kinded DefaultUni)))
-> [ParsecT
      ParserError
      Text
      (StateT ParserState (ReaderT (Maybe Version) Quote))
      (SomeTypeIn (Kinded DefaultUni))]
-> [ParsecT
      ParserError
      Text
      (StateT ParserState (ReaderT (Maybe Version) Quote))
      (SomeTypeIn (Kinded DefaultUni))]
forall a b. (a -> b) -> [a] -> [b]
map ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (SomeTypeIn (Kinded DefaultUni))
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
    [ ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (SomeTypeIn (Kinded DefaultUni))
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a. Parser a -> Parser a
trailingWhitespace (ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (SomeTypeIn (Kinded DefaultUni))
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a. Parser a -> Parser a
inParens ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (SomeTypeIn (Kinded DefaultUni))
defaultUniApplication)
    , forall k (a :: k) (uni :: * -> *). Contains uni a => SomeTypeIn uni
someType @_ @Integer                    SomeTypeIn (Kinded DefaultUni)
-> Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a b.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"integer"
    , forall k (a :: k) (uni :: * -> *). Contains uni a => SomeTypeIn uni
someType @_ @ByteString                 SomeTypeIn (Kinded DefaultUni)
-> Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a b.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"bytestring"
    , forall k (a :: k) (uni :: * -> *). Contains uni a => SomeTypeIn uni
someType @_ @Text                       SomeTypeIn (Kinded DefaultUni)
-> Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a b.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"string"
    , forall k (a :: k) (uni :: * -> *). Contains uni a => SomeTypeIn uni
someType @_ @()                         SomeTypeIn (Kinded DefaultUni)
-> Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a b.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"unit"
    , forall k (a :: k) (uni :: * -> *). Contains uni a => SomeTypeIn uni
someType @_ @Bool                       SomeTypeIn (Kinded DefaultUni)
-> Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a b.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"bool"
    , forall k (a :: k) (uni :: * -> *). Contains uni a => SomeTypeIn uni
someType @_ @[]                         SomeTypeIn (Kinded DefaultUni)
-> Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a b.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"list"
    , forall k (a :: k) (uni :: * -> *). Contains uni a => SomeTypeIn uni
someType @_ @(,)                        SomeTypeIn (Kinded DefaultUni)
-> Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a b.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"pair"
    , forall k (a :: k) (uni :: * -> *). Contains uni a => SomeTypeIn uni
someType @_ @Data                       SomeTypeIn (Kinded DefaultUni)
-> Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a b.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"data"
    , forall k (a :: k) (uni :: * -> *). Contains uni a => SomeTypeIn uni
someType @_ @BLS12_381.G1.Element       SomeTypeIn (Kinded DefaultUni)
-> Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a b.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"bls12_381_G1_element"
    , forall k (a :: k) (uni :: * -> *). Contains uni a => SomeTypeIn uni
someType @_ @BLS12_381.G2.Element       SomeTypeIn (Kinded DefaultUni)
-> Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a b.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"bls12_381_G2_element"
    , forall k (a :: k) (uni :: * -> *). Contains uni a => SomeTypeIn uni
someType @_ @BLS12_381.Pairing.MlResult SomeTypeIn (Kinded DefaultUni)
-> Parser Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (SomeTypeIn (Kinded DefaultUni))
forall a b.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     b
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"bls12_381_mlresult"
    ]

tyName :: Parser TyName
tyName :: ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  TyName
tyName = Name -> TyName
TyName (Name -> TyName)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Name
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     TyName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Name
name