{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
-- | Common functions for parsers of UPLC, PLC, and PIR.

module PlutusCore.Parser.ParserCommon where

import Data.Char (isAlphaNum)
import Data.Map qualified as M
import Data.Text qualified as T
import Data.Text.Internal.Read (hexDigitToInt)
import PlutusPrelude
import Text.Megaparsec hiding (ParseError, State, parse, some)
import Text.Megaparsec.Char (char, hexDigitChar, letterChar, space1)
import Text.Megaparsec.Char.Lexer qualified as Lex hiding (hexadecimal)

import Control.Monad.State (MonadState (get, put), StateT, evalStateT)
import Data.ByteString (pack)
import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Lazy.Internal (unpackChars)
import PlutusCore.Core.Type
import PlutusCore.Default
import PlutusCore.Error
import PlutusCore.MkPlc (mkIterTyApp)
import PlutusCore.Name
import PlutusCore.Quote

newtype ParserState = ParserState { ParserState -> Map Text Unique
identifiers :: M.Map T.Text Unique }
    deriving stock (Int -> ParserState -> ShowS
[ParserState] -> ShowS
ParserState -> String
(Int -> ParserState -> ShowS)
-> (ParserState -> String)
-> ([ParserState] -> ShowS)
-> Show ParserState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParserState] -> ShowS
$cshowList :: [ParserState] -> ShowS
show :: ParserState -> String
$cshow :: ParserState -> String
showsPrec :: Int -> ParserState -> ShowS
$cshowsPrec :: Int -> ParserState -> ShowS
Show)

type Parser =
    ParsecT ParseError T.Text (StateT ParserState Quote)

instance (Stream s, MonadQuote m) => MonadQuote (ParsecT e s m)

initial :: ParserState
initial :: ParserState
initial = Map Text Unique -> ParserState
ParserState Map Text Unique
forall k a. Map k a
M.empty

-- | Return the unique identifier of a name.
-- If it's not in the current parser state, map the name to a fresh id
-- and add it to the state. Used in the Name parser.
intern :: (MonadState ParserState m, MonadQuote m)
    => T.Text -> m Unique
intern :: Text -> m Unique
intern Text
n = do
    ParserState
st <- m ParserState
forall s (m :: * -> *). MonadState s m => m s
get
    case Text -> Map Text Unique -> Maybe Unique
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
n (ParserState -> Map Text Unique
identifiers ParserState
st) of
        Just Unique
u -> Unique -> m Unique
forall (m :: * -> *) a. Monad m => a -> m a
return Unique
u
        Maybe Unique
Nothing -> do
            Unique
fresh <- m Unique
forall (m :: * -> *). MonadQuote m => m Unique
freshUnique
            let identifiers' :: Map Text Unique
identifiers' = Text -> Unique -> Map Text Unique -> Map Text Unique
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
n Unique
fresh (Map Text Unique -> Map Text Unique)
-> Map Text Unique -> Map Text Unique
forall a b. (a -> b) -> a -> b
$ ParserState -> Map Text Unique
identifiers ParserState
st
            ParserState -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState -> m ()) -> ParserState -> m ()
forall a b. (a -> b) -> a -> b
$ Map Text Unique -> ParserState
ParserState Map Text Unique
identifiers'
            Unique -> m Unique
forall (m :: * -> *) a. Monad m => a -> m a
return Unique
fresh

parse :: Parser a -> String -> T.Text -> Either (ParseErrorBundle T.Text ParseError) a
parse :: Parser a
-> String -> Text -> Either (ParseErrorBundle Text ParseError) a
parse Parser a
p String
file Text
str = Quote (Either (ParseErrorBundle Text ParseError) a)
-> Either (ParseErrorBundle Text ParseError) a
forall a. Quote a -> a
runQuote (Quote (Either (ParseErrorBundle Text ParseError) a)
 -> Either (ParseErrorBundle Text ParseError) a)
-> Quote (Either (ParseErrorBundle Text ParseError) a)
-> Either (ParseErrorBundle Text ParseError) a
forall a b. (a -> b) -> a -> b
$ Parser a
-> String
-> Text
-> Quote (Either (ParseErrorBundle Text ParseError) a)
forall a.
Parser a
-> String
-> Text
-> Quote (Either (ParseErrorBundle Text ParseError) a)
parseQuoted Parser a
p String
file Text
str

-- | Generic parser function.
parseGen :: Parser a -> ByteString -> Either (ParseErrorBundle T.Text ParseError) a
parseGen :: Parser a
-> ByteString -> Either (ParseErrorBundle Text ParseError) a
parseGen Parser a
stuff ByteString
bs = Parser a
-> String -> Text -> Either (ParseErrorBundle Text ParseError) a
forall a.
Parser a
-> String -> Text -> Either (ParseErrorBundle Text ParseError) a
parse Parser a
stuff String
"test" (Text -> Either (ParseErrorBundle Text ParseError) a)
-> Text -> Either (ParseErrorBundle Text ParseError) a
forall a b. (a -> b) -> a -> b
$ (String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
unpackChars) ByteString
bs

parseQuoted ::
    Parser a -> String -> T.Text ->
        Quote (Either (ParseErrorBundle T.Text ParseError) a)
parseQuoted :: Parser a
-> String
-> Text
-> Quote (Either (ParseErrorBundle Text ParseError) a)
parseQuoted Parser a
p String
file Text
str = (StateT
   ParserState Quote (Either (ParseErrorBundle Text ParseError) a)
 -> ParserState
 -> Quote (Either (ParseErrorBundle Text ParseError) a))
-> ParserState
-> StateT
     ParserState Quote (Either (ParseErrorBundle Text ParseError) a)
-> Quote (Either (ParseErrorBundle Text ParseError) a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  ParserState Quote (Either (ParseErrorBundle Text ParseError) a)
-> ParserState
-> Quote (Either (ParseErrorBundle Text ParseError) a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ParserState
initial (StateT
   ParserState Quote (Either (ParseErrorBundle Text ParseError) a)
 -> Quote (Either (ParseErrorBundle Text ParseError) a))
-> StateT
     ParserState Quote (Either (ParseErrorBundle Text ParseError) a)
-> Quote (Either (ParseErrorBundle Text ParseError) a)
forall a b. (a -> b) -> a -> b
$ Parser a
-> String
-> Text
-> StateT
     ParserState Quote (Either (ParseErrorBundle Text ParseError) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
runParserT Parser a
p String
file Text
str

-- | Space consumer.
whitespace :: Parser ()
whitespace :: Parser ()
whitespace = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
Lex.space Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 (Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
Lex.skipLineComment Tokens Text
"--") (Tokens Text -> Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> Tokens s -> m ()
Lex.skipBlockCommentNested Tokens Text
"{-" Tokens Text
"-}")

lexeme :: Parser a -> Parser a
lexeme :: Parser a -> Parser a
lexeme = Parser () -> Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
Lex.lexeme Parser ()
whitespace

symbol :: T.Text -> Parser T.Text
symbol :: Text -> Parser Text
symbol = Parser ()
-> Tokens Text
-> ParsecT ParseError Text (StateT ParserState Quote) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
Lex.symbol Parser ()
whitespace

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

varType :: Parser PType
varType :: Parser PType
varType = SourcePos -> TyName -> PType
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
TyVar (SourcePos -> TyName -> PType)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
     ParseError Text (StateT ParserState Quote) (TyName -> PType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos ParsecT
  ParseError Text (StateT ParserState Quote) (TyName -> PType)
-> ParsecT ParseError Text (StateT ParserState Quote) TyName
-> Parser PType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ParseError Text (StateT ParserState Quote) TyName
tyName

funType :: Parser PType
funType :: Parser PType
funType = 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
$ SourcePos -> PType -> PType -> PType
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
TyFun (SourcePos -> PType -> PType -> PType)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
     ParseError
     Text
     (StateT ParserState Quote)
     (PType -> PType -> PType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
"fun" ParsecT
  ParseError
  Text
  (StateT ParserState Quote)
  (PType -> PType -> PType)
-> Parser PType
-> ParsecT
     ParseError Text (StateT ParserState Quote) (PType -> PType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PType
pType ParsecT ParseError Text (StateT ParserState Quote) (PType -> PType)
-> Parser PType -> Parser PType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PType
pType

allType :: Parser PType
allType :: Parser PType
allType = 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
$ SourcePos -> TyName -> Kind SourcePos -> PType -> PType
forall tyname (uni :: * -> *) ann.
ann
-> tyname -> Kind ann -> Type tyname uni ann -> Type tyname uni ann
TyForall (SourcePos -> TyName -> Kind SourcePos -> PType -> PType)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
     ParseError
     Text
     (StateT ParserState Quote)
     (TyName -> Kind SourcePos -> PType -> PType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
"all" ParsecT
  ParseError
  Text
  (StateT ParserState Quote)
  (TyName -> Kind SourcePos -> PType -> PType)
-> ParsecT ParseError Text (StateT ParserState Quote) TyName
-> ParsecT
     ParseError
     Text
     (StateT ParserState Quote)
     (Kind SourcePos -> PType -> PType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ParseError Text (StateT ParserState Quote) TyName
tyName ParsecT
  ParseError
  Text
  (StateT ParserState Quote)
  (Kind SourcePos -> PType -> PType)
-> ParsecT
     ParseError Text (StateT ParserState Quote) (Kind SourcePos)
-> ParsecT
     ParseError Text (StateT ParserState Quote) (PType -> PType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ParseError Text (StateT ParserState Quote) (Kind SourcePos)
kind ParsecT ParseError Text (StateT ParserState Quote) (PType -> PType)
-> Parser PType -> Parser PType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PType
pType

lamType :: Parser PType
lamType :: Parser PType
lamType = 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
$ SourcePos -> TyName -> Kind SourcePos -> PType -> PType
forall tyname (uni :: * -> *) ann.
ann
-> tyname -> Kind ann -> Type tyname uni ann -> Type tyname uni ann
TyLam (SourcePos -> TyName -> Kind SourcePos -> PType -> PType)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
     ParseError
     Text
     (StateT ParserState Quote)
     (TyName -> Kind SourcePos -> PType -> PType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
"lam" ParsecT
  ParseError
  Text
  (StateT ParserState Quote)
  (TyName -> Kind SourcePos -> PType -> PType)
-> ParsecT ParseError Text (StateT ParserState Quote) TyName
-> ParsecT
     ParseError
     Text
     (StateT ParserState Quote)
     (Kind SourcePos -> PType -> PType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ParseError Text (StateT ParserState Quote) TyName
tyName ParsecT
  ParseError
  Text
  (StateT ParserState Quote)
  (Kind SourcePos -> PType -> PType)
-> ParsecT
     ParseError Text (StateT ParserState Quote) (Kind SourcePos)
-> ParsecT
     ParseError Text (StateT ParserState Quote) (PType -> PType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ParseError Text (StateT ParserState Quote) (Kind SourcePos)
kind ParsecT ParseError Text (StateT ParserState Quote) (PType -> PType)
-> Parser PType -> Parser PType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PType
pType

ifixType :: Parser PType
ifixType :: Parser PType
ifixType = 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
$ SourcePos -> PType -> PType -> PType
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
TyIFix (SourcePos -> PType -> PType -> PType)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
     ParseError
     Text
     (StateT ParserState Quote)
     (PType -> PType -> PType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
"ifix" ParsecT
  ParseError
  Text
  (StateT ParserState Quote)
  (PType -> PType -> PType)
-> Parser PType
-> ParsecT
     ParseError Text (StateT ParserState Quote) (PType -> PType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PType
pType ParsecT ParseError Text (StateT ParserState Quote) (PType -> PType)
-> Parser PType -> Parser PType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PType
pType

builtinType :: Parser PType
builtinType :: Parser PType
builtinType = 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
$ SourcePos -> SomeTypeIn DefaultUni -> PType
forall tyname (uni :: * -> *) ann.
ann -> SomeTypeIn uni -> Type tyname uni ann
TyBuiltin (SourcePos -> SomeTypeIn DefaultUni -> PType)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
     ParseError
     Text
     (StateT ParserState Quote)
     (SomeTypeIn DefaultUni -> PType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
"con" ParsecT
  ParseError
  Text
  (StateT ParserState Quote)
  (SomeTypeIn DefaultUni -> PType)
-> ParsecT
     ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
-> Parser PType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT
  ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
defaultUniType

appType :: Parser PType
appType :: Parser PType
appType = 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
    SourcePos
pos  <- ParsecT ParseError Text (StateT ParserState Quote) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
    PType
fn   <- Parser PType
pType
    [PType]
args <- Parser PType
-> ParsecT ParseError Text (StateT ParserState Quote) [PType]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser PType
pType
    PType -> Parser PType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PType -> Parser PType) -> PType -> Parser PType
forall a b. (a -> b) -> a -> b
$ SourcePos -> PType -> [PType] -> PType
forall ann tyname (uni :: * -> *).
ann
-> Type tyname uni ann
-> [Type tyname uni ann]
-> Type tyname uni ann
mkIterTyApp SourcePos
pos PType
fn [PType]
args

kind :: Parser (Kind SourcePos)
kind :: ParsecT ParseError Text (StateT ParserState Quote) (Kind SourcePos)
kind = ParsecT ParseError Text (StateT ParserState Quote) (Kind SourcePos)
-> ParsecT
     ParseError Text (StateT ParserState Quote) (Kind SourcePos)
forall a. Parser a -> Parser a
inParens (ParsecT ParseError Text (StateT ParserState Quote) (Kind SourcePos)
typeKind ParsecT ParseError Text (StateT ParserState Quote) (Kind SourcePos)
-> ParsecT
     ParseError Text (StateT ParserState Quote) (Kind SourcePos)
-> ParsecT
     ParseError Text (StateT ParserState Quote) (Kind SourcePos)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ParseError Text (StateT ParserState Quote) (Kind SourcePos)
funKind)
    where
        typeKind :: ParsecT ParseError Text (StateT ParserState Quote) (Kind SourcePos)
typeKind = SourcePos -> Kind SourcePos
forall ann. ann -> Kind ann
Type (SourcePos -> Kind SourcePos)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
     ParseError Text (StateT ParserState Quote) (Kind SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
"type"
        funKind :: ParsecT ParseError Text (StateT ParserState Quote) (Kind SourcePos)
funKind  = SourcePos -> Kind SourcePos -> Kind SourcePos -> Kind SourcePos
forall ann. ann -> Kind ann -> Kind ann -> Kind ann
KindArrow (SourcePos -> Kind SourcePos -> Kind SourcePos -> Kind SourcePos)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
     ParseError
     Text
     (StateT ParserState Quote)
     (Kind SourcePos -> Kind SourcePos -> Kind SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
"fun" ParsecT
  ParseError
  Text
  (StateT ParserState Quote)
  (Kind SourcePos -> Kind SourcePos -> Kind SourcePos)
-> ParsecT
     ParseError Text (StateT ParserState Quote) (Kind SourcePos)
-> ParsecT
     ParseError
     Text
     (StateT ParserState Quote)
     (Kind SourcePos -> Kind SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ParseError Text (StateT ParserState Quote) (Kind SourcePos)
kind ParsecT
  ParseError
  Text
  (StateT ParserState Quote)
  (Kind SourcePos -> Kind SourcePos)
-> ParsecT
     ParseError Text (StateT ParserState Quote) (Kind SourcePos)
-> ParsecT
     ParseError Text (StateT ParserState Quote) (Kind SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ParseError Text (StateT ParserState Quote) (Kind SourcePos)
kind

-- | 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 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
    ]

defaultUniType :: Parser (SomeTypeIn DefaultUni)
defaultUniType :: ParsecT
  ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
defaultUniType = [ParsecT
   ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)]
-> ParsecT
     ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT
    ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)]
 -> ParsecT
      ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni))
-> [ParsecT
      ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)]
-> ParsecT
     ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
forall a b. (a -> b) -> a -> b
$ (ParsecT
   ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
 -> ParsecT
      ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni))
-> [ParsecT
      ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)]
-> [ParsecT
      ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)]
forall a b. (a -> b) -> [a] -> [b]
map ParsecT
  ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
-> ParsecT
     ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
  [ ParsecT
  ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
-> ParsecT
     ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
forall a. Parser a -> Parser a
inParens ParsecT
  ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
defaultUniType
  , DefaultUni (Esc Integer) -> SomeTypeIn DefaultUni
forall (uni :: * -> *) k (a :: k). uni (Esc a) -> SomeTypeIn uni
SomeTypeIn DefaultUni (Esc Integer)
DefaultUniInteger SomeTypeIn DefaultUni
-> Parser Text
-> ParsecT
     ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"integer"
  , DefaultUni (Esc ByteString) -> SomeTypeIn DefaultUni
forall (uni :: * -> *) k (a :: k). uni (Esc a) -> SomeTypeIn uni
SomeTypeIn DefaultUni (Esc ByteString)
DefaultUniByteString SomeTypeIn DefaultUni
-> Parser Text
-> ParsecT
     ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"bytestring"
  , DefaultUni (Esc Text) -> SomeTypeIn DefaultUni
forall (uni :: * -> *) k (a :: k). uni (Esc a) -> SomeTypeIn uni
SomeTypeIn DefaultUni (Esc Text)
DefaultUniString SomeTypeIn DefaultUni
-> Parser Text
-> ParsecT
     ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"string"
  , DefaultUni (Esc ()) -> SomeTypeIn DefaultUni
forall (uni :: * -> *) k (a :: k). uni (Esc a) -> SomeTypeIn uni
SomeTypeIn DefaultUni (Esc ())
DefaultUniUnit SomeTypeIn DefaultUni
-> Parser Text
-> ParsecT
     ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"unit"
  , DefaultUni (Esc Bool) -> SomeTypeIn DefaultUni
forall (uni :: * -> *) k (a :: k). uni (Esc a) -> SomeTypeIn uni
SomeTypeIn DefaultUni (Esc Bool)
DefaultUniBool SomeTypeIn DefaultUni
-> Parser Text
-> ParsecT
     ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"bool"
  ] --TODO complete all defaultUni types

inParens :: Parser a -> Parser a
inParens :: Parser a -> Parser a
inParens = Parser Text -> Parser Text -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"(") (Text -> Parser Text
symbol Text
")")

inBrackets :: Parser a -> Parser a
inBrackets :: Parser a -> Parser a
inBrackets = Parser Text -> Parser Text -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"[") (Text -> Parser Text
symbol Text
"]")

inBraces :: Parser a-> Parser a
inBraces :: Parser a -> Parser a
inBraces = Parser Text -> Parser Text -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"{") (Text -> Parser Text
symbol Text
"}")

isIdentifierChar :: Char -> Bool
isIdentifierChar :: Char -> Bool
isIdentifierChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''

-- | Create a parser that matches the input word and returns its source position.
-- This is for attaching source positions to parsed terms/programs.
wordPos ::
    -- | The word to match
    T.Text -> Parser SourcePos
wordPos :: Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
w = ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
forall a. Parser a -> Parser a
lexeme (ParsecT ParseError Text (StateT ParserState Quote) SourcePos
 -> ParsecT ParseError Text (StateT ParserState Quote) SourcePos)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
forall a b. (a -> b) -> a -> b
$ ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT ParseError Text (StateT ParserState Quote) SourcePos
 -> ParsecT ParseError Text (StateT ParserState Quote) SourcePos)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
forall a b. (a -> b) -> a -> b
$ ParsecT ParseError Text (StateT ParserState Quote) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> Parser Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text
symbol Text
w

-- | The list of parsable default functions and their pretty print correspondence.
builtinFnList :: [(DefaultFun, T.Text)]
builtinFnList :: [(DefaultFun, Text)]
builtinFnList =
    [ (DefaultFun
AddInteger,Text
"addInteger")
    , (DefaultFun
SubtractInteger,Text
"subtractInteger")
    , (DefaultFun
MultiplyInteger,Text
"multiplyInteger")
    , (DefaultFun
DivideInteger,Text
"divideInteger")
    , (DefaultFun
QuotientInteger,Text
"quotientInteger")
    , (DefaultFun
RemainderInteger,Text
"remainderInteger")
    , (DefaultFun
ModInteger,Text
"modInteger")
    , (DefaultFun
EqualsInteger,Text
"equalsInteger")
    , (DefaultFun
LessThanInteger,Text
"lessThanInteger")
    , (DefaultFun
LessThanEqualsInteger,Text
"lessThanEqualsInteger")
    , (DefaultFun
AppendByteString,Text
"appendByteString")
    , (DefaultFun
ConsByteString,Text
"consByteString")
    , (DefaultFun
SliceByteString,Text
"sliceByteString")
    , (DefaultFun
LengthOfByteString,Text
"lengthOfByteString")
    , (DefaultFun
IndexByteString,Text
"indexByteString")
    , (DefaultFun
EqualsByteString,Text
"equalsByteString")
    , (DefaultFun
LessThanByteString,Text
"lessThanByteString")
    , (DefaultFun
LessThanEqualsByteString,Text
"lessThanEqualsByteString")
    , (DefaultFun
Sha2_256,Text
"sha2_256")
    , (DefaultFun
Sha3_256,Text
"sha3_256")
    , (DefaultFun
Blake2b_256,Text
"blake2b_256")
    , (DefaultFun
VerifyEd25519Signature,Text
"verifyEd25519Signature")
    , (DefaultFun
VerifyEcdsaSecp256k1Signature ,Text
"verifyEcdsaSecp256k1Signature")
    , (DefaultFun
VerifySchnorrSecp256k1Signature  ,Text
"verifySchnorrSecp256k1Signature")
    , (DefaultFun
AppendString,Text
"appendString")
    , (DefaultFun
EqualsString,Text
"equalsString")
    , (DefaultFun
EncodeUtf8,Text
"encodeUtf8")
    , (DefaultFun
DecodeUtf8,Text
"decodeUtf8")
    , (DefaultFun
IfThenElse,Text
"ifThenElse")
    , (DefaultFun
ChooseUnit,Text
"chooseUnit")
    , (DefaultFun
Trace,Text
"trace")
    , (DefaultFun
FstPair,Text
"fstPair")
    , (DefaultFun
SndPair,Text
"sndPair")
    , (DefaultFun
ChooseList,Text
"chooseList")
    , (DefaultFun
MkCons,Text
"mkCons")
    , (DefaultFun
HeadList,Text
"headList")
    , (DefaultFun
TailList,Text
"tailList")
    , (DefaultFun
NullList,Text
"nullList")
    , (DefaultFun
ChooseData,Text
"chooseData")
    , (DefaultFun
ConstrData,Text
"constrData")
    , (DefaultFun
MapData,Text
"mapData")
    , (DefaultFun
ListData,Text
"listData")
    , (DefaultFun
IData,Text
"iData")
    , (DefaultFun
BData,Text
"bData")
    , (DefaultFun
UnConstrData,Text
"unConstrData")
    , (DefaultFun
UnMapData,Text
"unMapData")
    , (DefaultFun
UnListData,Text
"unListData")
    , (DefaultFun
UnIData,Text
"unIData")
    , (DefaultFun
UnBData,Text
"unBData")
    , (DefaultFun
EqualsData,Text
"equalsData")
    , (DefaultFun
SerialiseData,Text
"serialiseData")
    , (DefaultFun
MkPairData,Text
"mkPairData")
    , (DefaultFun
MkNilData,Text
"mkNilData")
    , (DefaultFun
MkNilPairData,Text
"mkNilPairData")
    ]

builtinFunction :: Parser DefaultFun
builtinFunction :: Parser DefaultFun
builtinFunction =
    [Parser DefaultFun] -> Parser DefaultFun
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser DefaultFun] -> Parser DefaultFun)
-> [Parser DefaultFun] -> Parser DefaultFun
forall a b. (a -> b) -> a -> b
$
        ((DefaultFun, Text) -> Parser DefaultFun)
-> [(DefaultFun, Text)] -> [Parser DefaultFun]
forall a b. (a -> b) -> [a] -> [b]
map
            (Parser DefaultFun -> Parser DefaultFun
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser DefaultFun -> Parser DefaultFun)
-> ((DefaultFun, Text) -> Parser DefaultFun)
-> (DefaultFun, Text)
-> Parser DefaultFun
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(DefaultFun
fn, Text
text) -> DefaultFun
fn DefaultFun -> Parser Text -> Parser DefaultFun
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
text))
            [(DefaultFun, Text)]
builtinFnList

version :: Parser (Version SourcePos)
version :: Parser (Version SourcePos)
version = Parser (Version SourcePos) -> Parser (Version SourcePos)
forall a. Parser a -> Parser a
lexeme (Parser (Version SourcePos) -> Parser (Version SourcePos))
-> Parser (Version SourcePos) -> Parser (Version SourcePos)
forall a b. (a -> b) -> a -> b
$ do
    SourcePos
p <- ParsecT ParseError Text (StateT ParserState Quote) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
    Natural
x <- ParsecT ParseError Text (StateT ParserState Quote) Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lex.decimal
    ParsecT ParseError Text (StateT ParserState Quote) Char
-> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ParseError Text (StateT ParserState Quote) Char
 -> Parser ())
-> ParsecT ParseError Text (StateT ParserState Quote) Char
-> Parser ()
forall a b. (a -> b) -> a -> b
$ Token Text
-> ParsecT ParseError Text (StateT ParserState Quote) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'
    Natural
y <- ParsecT ParseError Text (StateT ParserState Quote) Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lex.decimal
    ParsecT ParseError Text (StateT ParserState Quote) Char
-> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ParseError Text (StateT ParserState Quote) Char
 -> Parser ())
-> ParsecT ParseError Text (StateT ParserState Quote) Char
-> Parser ()
forall a b. (a -> b) -> a -> b
$ Token Text
-> ParsecT ParseError Text (StateT ParserState Quote) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'
    SourcePos -> Natural -> Natural -> Natural -> Version SourcePos
forall ann. ann -> Natural -> Natural -> Natural -> Version ann
Version SourcePos
p Natural
x Natural
y (Natural -> Version SourcePos)
-> ParsecT ParseError Text (StateT ParserState Quote) Natural
-> Parser (Version SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ParseError Text (StateT ParserState Quote) Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lex.decimal

name :: Parser Name
name :: Parser Name
name = Parser Name -> Parser Name
forall a. Parser a -> Parser a
lexeme (Parser Name -> Parser Name) -> Parser Name -> Parser Name
forall a b. (a -> b) -> a -> b
$ Parser Name -> Parser Name
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Name -> Parser Name) -> Parser Name -> Parser Name
forall a b. (a -> b) -> a -> b
$ do
    ParsecT ParseError Text (StateT ParserState Quote) Char
-> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ParseError Text (StateT ParserState Quote) Char
 -> Parser ())
-> ParsecT ParseError Text (StateT ParserState Quote) Char
-> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT ParseError Text (StateT ParserState Quote) Char
-> ParsecT ParseError Text (StateT ParserState Quote) Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT ParseError Text (StateT ParserState Quote) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar
    Text
str <- Maybe String
-> (Token Text -> Bool)
-> ParsecT ParseError Text (StateT ParserState Quote) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"identifier") Char -> Bool
Token Text -> Bool
isIdentifierChar
    Text -> Unique -> Name
Name Text
str (Unique -> Name)
-> ParsecT ParseError Text (StateT ParserState Quote) Unique
-> Parser Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT ParseError Text (StateT ParserState Quote) Unique
forall (m :: * -> *).
(MonadState ParserState m, MonadQuote m) =>
Text -> m Unique
intern Text
str

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

-- | Turn a parser that can succeed without consuming any input into one that fails in this case.
enforce :: Parser a -> Parser a
enforce :: Parser a -> Parser a
enforce Parser a
p = do
    (Text
input, a
x) <- Parser a
-> ParsecT
     ParseError Text (StateT ParserState Quote) (Tokens Text, a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match Parser a
p
    Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> (Bool -> Bool) -> Bool -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
input
    a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

signedInteger :: ParsecT ParseError T.Text (StateT ParserState Quote) Integer
signedInteger :: ParsecT ParseError Text (StateT ParserState Quote) Integer
signedInteger = Parser ()
-> ParsecT ParseError Text (StateT ParserState Quote) Integer
-> ParsecT ParseError Text (StateT ParserState Quote) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
Lex.signed Parser ()
whitespace (ParsecT ParseError Text (StateT ParserState Quote) Integer
-> ParsecT ParseError Text (StateT ParserState Quote) Integer
forall a. Parser a -> Parser a
lexeme ParsecT ParseError Text (StateT ParserState Quote) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lex.decimal)

-- | Parser for integer constants.
conInt :: Parser (Some (ValueOf DefaultUni))
conInt :: Parser (Some (ValueOf DefaultUni))
conInt = do
    Integer
con::Integer <- ParsecT ParseError Text (StateT ParserState Quote) Integer
signedInteger
    Some (ValueOf DefaultUni) -> Parser (Some (ValueOf DefaultUni))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Some (ValueOf DefaultUni) -> Parser (Some (ValueOf DefaultUni)))
-> Some (ValueOf DefaultUni) -> Parser (Some (ValueOf DefaultUni))
forall a b. (a -> b) -> a -> b
$ Integer -> Some (ValueOf DefaultUni)
forall a (uni :: * -> *). Includes uni a => a -> Some (ValueOf uni)
someValue Integer
con

-- | Parser for a pair of hex digits to a Word8.
hexByte :: Parser Word8
hexByte :: Parser Word8
hexByte = do
    Char
high <- ParsecT ParseError Text (StateT ParserState Quote) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar
    Char
low <- ParsecT ParseError Text (StateT ParserState Quote) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar
    Word8 -> Parser Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Parser Word8) -> Word8 -> Parser Word8
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
hexDigitToInt Char
high Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
hexDigitToInt Char
low)

-- | Parser for bytestring constants. They start with "#".
conBS :: Parser (Some (ValueOf DefaultUni))
conBS :: Parser (Some (ValueOf DefaultUni))
conBS = do
    Char
_ <- Token Text
-> ParsecT ParseError Text (StateT ParserState Quote) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'#'
    [Word8]
bytes <- Parser Word8
-> ParsecT ParseError Text (StateT ParserState Quote) [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Text.Megaparsec.many Parser Word8
hexByte
    Some (ValueOf DefaultUni) -> Parser (Some (ValueOf DefaultUni))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Some (ValueOf DefaultUni) -> Parser (Some (ValueOf DefaultUni)))
-> Some (ValueOf DefaultUni) -> Parser (Some (ValueOf DefaultUni))
forall a b. (a -> b) -> a -> b
$ ByteString -> Some (ValueOf DefaultUni)
forall a (uni :: * -> *). Includes uni a => a -> Some (ValueOf uni)
someValue (ByteString -> Some (ValueOf DefaultUni))
-> ByteString -> Some (ValueOf DefaultUni)
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
pack [Word8]
bytes

-- | Parser for string constants. They are wrapped in double quotes.
conText :: Parser (Some (ValueOf DefaultUni))
conText :: Parser (Some (ValueOf DefaultUni))
conText = do
    String
con <- Token Text
-> ParsecT ParseError Text (StateT ParserState Quote) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\"' ParsecT ParseError Text (StateT ParserState Quote) Char
-> ParsecT ParseError Text (StateT ParserState Quote) String
-> ParsecT ParseError Text (StateT ParserState Quote) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseError Text (StateT ParserState Quote) Char
-> ParsecT ParseError Text (StateT ParserState Quote) Char
-> ParsecT ParseError Text (StateT ParserState Quote) String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT ParseError Text (StateT ParserState Quote) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
Lex.charLiteral (Token Text
-> ParsecT ParseError Text (StateT ParserState Quote) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\"')
    Some (ValueOf DefaultUni) -> Parser (Some (ValueOf DefaultUni))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Some (ValueOf DefaultUni) -> Parser (Some (ValueOf DefaultUni)))
-> Some (ValueOf DefaultUni) -> Parser (Some (ValueOf DefaultUni))
forall a b. (a -> b) -> a -> b
$ Text -> Some (ValueOf DefaultUni)
forall a (uni :: * -> *). Includes uni a => a -> Some (ValueOf uni)
someValue (Text -> Some (ValueOf DefaultUni))
-> Text -> Some (ValueOf DefaultUni)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
con

-- | Parser for unit.
conUnit :: Parser (Some (ValueOf DefaultUni))
conUnit :: Parser (Some (ValueOf DefaultUni))
conUnit = () -> Some (ValueOf DefaultUni)
forall a (uni :: * -> *). Includes uni a => a -> Some (ValueOf uni)
someValue () Some (ValueOf DefaultUni)
-> Parser Text -> Parser (Some (ValueOf DefaultUni))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"()"

-- | Parser for bool.
conBool :: Parser (Some (ValueOf DefaultUni))
conBool :: Parser (Some (ValueOf DefaultUni))
conBool = [Parser (Some (ValueOf DefaultUni))]
-> Parser (Some (ValueOf DefaultUni))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Bool -> Some (ValueOf DefaultUni)
forall a (uni :: * -> *). Includes uni a => a -> Some (ValueOf uni)
someValue Bool
True Some (ValueOf DefaultUni)
-> Parser Text -> Parser (Some (ValueOf DefaultUni))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"True"
    , Bool -> Some (ValueOf DefaultUni)
forall a (uni :: * -> *). Includes uni a => a -> Some (ValueOf uni)
someValue Bool
False Some (ValueOf DefaultUni)
-> Parser Text -> Parser (Some (ValueOf DefaultUni))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"False"
    ]

-- | Parser for a constant term. Currently the syntax is "con defaultUniType val".
constant :: Parser (Some (ValueOf DefaultUni))
constant :: Parser (Some (ValueOf DefaultUni))
constant = do
    SomeTypeIn DefaultUni
conTy <- ParsecT
  ParseError Text (StateT ParserState Quote) (SomeTypeIn DefaultUni)
defaultUniType
    Some (ValueOf DefaultUni)
con <-
        case SomeTypeIn DefaultUni
conTy of --TODO add Lists, Pairs, Data, App
            SomeTypeIn DefaultUni (Esc a)
DefaultUniInteger    -> Parser (Some (ValueOf DefaultUni))
conInt
            SomeTypeIn DefaultUni (Esc a)
DefaultUniByteString -> Parser (Some (ValueOf DefaultUni))
conBS
            SomeTypeIn DefaultUni (Esc a)
DefaultUniString     -> Parser (Some (ValueOf DefaultUni))
conText
            SomeTypeIn DefaultUni (Esc a)
DefaultUniUnit       -> Parser (Some (ValueOf DefaultUni))
conUnit
            SomeTypeIn DefaultUni (Esc a)
DefaultUniBool       -> Parser (Some (ValueOf DefaultUni))
conBool
    Parser ()
whitespace
    Some (ValueOf DefaultUni) -> Parser (Some (ValueOf DefaultUni))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Some (ValueOf DefaultUni)
con