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

module PlutusCore.Parser.Builtin where

import PlutusPrelude (Word8, reoption)

import PlutusCore.Crypto.BLS12_381.G1 qualified as BLS12_381.G1
import PlutusCore.Crypto.BLS12_381.G2 qualified as BLS12_381.G2
import PlutusCore.Data
import PlutusCore.Default
import PlutusCore.Error (ParserError (UnknownBuiltinFunction))
import PlutusCore.Name.Unique
import PlutusCore.Parser.ParserCommon
import PlutusCore.Parser.Type (defaultUni)
import PlutusCore.Pretty (display)

import Control.Monad.Combinators
import Data.ByteString (ByteString, pack)
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Data.Text.Internal.Read (hexDigitToInt)
import Text.Megaparsec (customFailure, getSourcePos, takeWhileP)
import Text.Megaparsec.Char (char, hexDigitChar, string)
import Text.Megaparsec.Char.Lexer qualified as Lex

cachedBuiltin :: Map.Map T.Text DefaultFun
cachedBuiltin :: Map Text DefaultFun
cachedBuiltin = [(Text, DefaultFun)] -> Map Text DefaultFun
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(DefaultFun -> Text
forall str a. (Pretty a, Render str) => a -> str
display DefaultFun
fn, DefaultFun
fn) | DefaultFun
fn <- [DefaultFun
forall a. Bounded a => a
minBound .. DefaultFun
forall a. Bounded a => a
maxBound]]

-- | Parser for builtin functions. Atm the parser can only parse `DefaultFun`.
builtinFunction :: Parser DefaultFun
builtinFunction :: Parser DefaultFun
builtinFunction = Parser DefaultFun -> Parser DefaultFun
forall a. Parser a -> Parser a
lexeme (Parser DefaultFun -> Parser DefaultFun)
-> Parser DefaultFun -> Parser DefaultFun
forall a b. (a -> b) -> a -> b
$ do
  Text
txt <- Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"builtin function identifier") Char -> Bool
Token Text -> Bool
isIdentifierChar
  case Text -> Map Text DefaultFun -> Maybe DefaultFun
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
txt Map Text DefaultFun
cachedBuiltin of
    Maybe DefaultFun
Nothing -> do
      let lBuiltin :: [Text]
lBuiltin = ((Text, DefaultFun) -> Text) -> [(Text, DefaultFun)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, DefaultFun) -> Text
forall a b. (a, b) -> a
fst ([(Text, DefaultFun)] -> [Text]) -> [(Text, DefaultFun)] -> [Text]
forall a b. (a -> b) -> a -> b
$ Map Text DefaultFun -> [(Text, DefaultFun)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text DefaultFun
cachedBuiltin
      SourcePos
pos <- ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
      ParserError -> Parser DefaultFun
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (ParserError -> Parser DefaultFun)
-> ParserError -> Parser DefaultFun
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> [Text] -> ParserError
UnknownBuiltinFunction Text
txt SourcePos
pos [Text]
lBuiltin
    Just DefaultFun
builtin -> DefaultFun -> Parser DefaultFun
forall a.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DefaultFun
builtin

-- | Parser for integer constants.
conInteger :: Parser Integer
conInteger :: Parser Integer
conInteger = ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  ()
-> Parser Integer -> Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
Lex.signed ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  ()
whitespace (Parser Integer -> Parser Integer
forall a. Parser a -> Parser a
lexeme Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lex.decimal)

-- | Parser for a pair of hex digits to a Word8.
hexByte :: Parser Word8
hexByte :: Parser Word8
hexByte = do
  Char
high <- ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Char
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar
  Char
low <- ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Char
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar
  Word8 -> Parser Word8
forall a.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 ByteString
conBS :: Parser ByteString
conBS = Parser ByteString -> Parser ByteString
forall a. Parser a -> Parser a
lexeme (Parser ByteString -> Parser ByteString)
-> (ParsecT
      ParserError
      Text
      (StateT ParserState (ReaderT (Maybe Version) Quote))
      [Word8]
    -> Parser ByteString)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Word8]
-> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Word8] -> ByteString)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Word8]
-> Parser ByteString
forall a b.
(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. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
pack (ParsecT
   ParserError
   Text
   (StateT ParserState (ReaderT (Maybe Version) Quote))
   [Word8]
 -> Parser ByteString)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Word8]
-> Parser ByteString
forall a b. (a -> b) -> a -> b
$ Token Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'#' ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Char
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Word8]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Word8]
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 Word8
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser Word8
hexByte

{- | Parser for string constants (wrapped in double quotes).  Note that
 Data.Text.pack "performs replacement on invalid scalar values", which means
 that Unicode surrogate code points (corresponding to integers in the range
 0xD800-0xDFFF) are converted to the Unicode replacement character U+FFFD
 (decimal 65533).  Thus `(con string "X\xD800Z")` parses to a `Text` object
 whose second character is U+FFFD.
-}
conText :: Parser T.Text
conText :: ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Text
conText = ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
forall a. Parser a -> Parser a
lexeme (ParsecT
   ParserError
   Text
   (StateT ParserState (ReaderT (Maybe Version) Quote))
   Text
 -> ParsecT
      ParserError
      Text
      (StateT ParserState (ReaderT (Maybe Version) Quote))
      Text)
-> (ParsecT
      ParserError
      Text
      (StateT ParserState (ReaderT (Maybe Version) Quote))
      [Char]
    -> ParsecT
         ParserError
         Text
         (StateT ParserState (ReaderT (Maybe Version) Quote))
         Text)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Char]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Text)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Char]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
forall a b.
(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. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
T.pack (ParsecT
   ParserError
   Text
   (StateT ParserState (ReaderT (Maybe Version) Quote))
   [Char]
 -> ParsecT
      ParserError
      Text
      (StateT ParserState (ReaderT (Maybe Version) Quote))
      Text)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Char]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
forall a b. (a -> b) -> a -> b
$ Token Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\"' ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Char
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Char]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Char]
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))
  Char
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Char
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Char]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
Lex.charLiteral (Token Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\"')

-- | Parser for unit.
conUnit :: Parser ()
conUnit :: ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  ()
conUnit = () ()
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     ()
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
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"(" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
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
*> Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
")")

-- | Parser for bool.
conBool :: Parser Bool
conBool :: Parser Bool
conBool =
  [Parser Bool] -> Parser Bool
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Bool
True Bool
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
-> Parser Bool
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
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"True"
    , Bool
False Bool
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
-> Parser Bool
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
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"False"
    ]

-- | Parser for lists.
conList :: DefaultUni (Esc a) -> Parser [a]
conList :: forall a. DefaultUni (Esc a) -> Parser [a]
conList DefaultUni (Esc a)
uniA = Parser [a] -> Parser [a]
forall a. Parser a -> Parser a
trailingWhitespace (Parser [a] -> Parser [a])
-> (Parser [a] -> Parser [a]) -> Parser [a] -> Parser [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser [a] -> Parser [a]
forall a. Parser a -> Parser a
inBrackets (Parser [a] -> Parser [a]) -> Parser [a] -> Parser [a]
forall a b. (a -> b) -> a -> b
$
    ExpectParens -> DefaultUni (Esc a) -> Parser a
forall a. ExpectParens -> DefaultUni (Esc a) -> Parser a
constantOf ExpectParens
ExpectParensNo DefaultUni (Esc a)
uniA Parser a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
-> Parser [a]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
","

-- | Parser for pairs.
conPair :: DefaultUni (Esc a) -> DefaultUni (Esc b) -> Parser (a, b)
conPair :: forall a b.
DefaultUni (Esc a) -> DefaultUni (Esc b) -> Parser (a, b)
conPair DefaultUni (Esc a)
uniA DefaultUni (Esc b)
uniB = Parser (a, b) -> Parser (a, b)
forall a. Parser a -> Parser a
trailingWhitespace (Parser (a, b) -> Parser (a, b))
-> (Parser (a, b) -> Parser (a, b))
-> Parser (a, b)
-> Parser (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (a, b) -> Parser (a, b)
forall a. Parser a -> Parser a
inParens (Parser (a, b) -> Parser (a, b)) -> Parser (a, b) -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ do
  a
a <- ExpectParens -> DefaultUni (Esc a) -> Parser a
forall a. ExpectParens -> DefaultUni (Esc a) -> Parser a
constantOf ExpectParens
ExpectParensNo DefaultUni (Esc a)
uniA
  Text
_ <- Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
","
  b
b <- ExpectParens -> DefaultUni (Esc b) -> Parser b
forall a. ExpectParens -> DefaultUni (Esc a) -> Parser a
constantOf ExpectParens
ExpectParensNo DefaultUni (Esc b)
uniB
  (a, b) -> Parser (a, b)
forall a.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b)

conDataNoParens :: Parser Data
conDataNoParens :: Parser Data
conDataNoParens =
    [Parser Data] -> Parser Data
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"Constr" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Text
-> Parser Data -> Parser Data
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
*> (Integer -> [Data] -> Data
Constr (Integer -> [Data] -> Data)
-> Parser Integer
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     ([Data] -> Data)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
conInteger ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  ([Data] -> Data)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Data]
-> Parser Data
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
<*> DefaultUni (Esc Data)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Data]
forall a. DefaultUni (Esc a) -> Parser [a]
conList DefaultUni (Esc Data)
forall k (uni :: * -> *) (a :: k). Contains uni a => uni (Esc a)
knownUni)
        , Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"Map" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Text
-> Parser Data -> Parser Data
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
*> ([(Data, Data)] -> Data
Map ([(Data, Data)] -> Data)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [(Data, Data)]
-> Parser Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DefaultUni (Esc (Data, Data))
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [(Data, Data)]
forall a. DefaultUni (Esc a) -> Parser [a]
conList DefaultUni (Esc (Data, Data))
forall k (uni :: * -> *) (a :: k). Contains uni a => uni (Esc a)
knownUni)
        , Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"List" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Text
-> Parser Data -> Parser Data
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
*> ([Data] -> Data
List ([Data] -> Data)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Data]
-> Parser Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DefaultUni (Esc Data)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Data]
forall a. DefaultUni (Esc a) -> Parser [a]
conList DefaultUni (Esc Data)
forall k (uni :: * -> *) (a :: k). Contains uni a => uni (Esc a)
knownUni)
        , Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"I" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Text
-> Parser Data -> Parser Data
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
*> (Integer -> Data
I (Integer -> Data) -> Parser Integer -> Parser Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
conInteger)
        , Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"B" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Text
-> Parser Data -> Parser Data
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
*> (ByteString -> Data
B (ByteString -> Data) -> Parser ByteString -> Parser Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
conBS)
        ]

conData :: ExpectParens -> Parser Data
conData :: ExpectParens -> Parser Data
conData ExpectParens
ExpectParensYes = Parser Data -> Parser Data
forall a. Parser a -> Parser a
trailingWhitespace (Parser Data -> Parser Data) -> Parser Data -> Parser Data
forall a b. (a -> b) -> a -> b
$ Parser Data -> Parser Data
forall a. Parser a -> Parser a
inParens Parser Data
conDataNoParens
conData ExpectParens
ExpectParensNo  = Parser Data
conDataNoParens

-- Serialised BLS12_381 elements are "0x" followed by a hex string of even
-- length.  Maybe we should just use the usual bytestring syntax.
con0xBS :: Parser ByteString
con0xBS :: Parser ByteString
con0xBS = Parser ByteString -> Parser ByteString
forall a. Parser a -> Parser a
lexeme (Parser ByteString -> Parser ByteString)
-> (ParsecT
      ParserError
      Text
      (StateT ParserState (ReaderT (Maybe Version) Quote))
      [Word8]
    -> Parser ByteString)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Word8]
-> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Word8] -> ByteString)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Word8]
-> Parser ByteString
forall a b.
(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. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
pack (ParsecT
   ParserError
   Text
   (StateT ParserState (ReaderT (Maybe Version) Quote))
   [Word8]
 -> Parser ByteString)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Word8]
-> Parser ByteString
forall a b. (a -> b) -> a -> b
$ Tokens Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"0x" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Tokens Text)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Word8]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Word8]
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 Word8
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser Word8
hexByte

conBLS12_381_G1_Element :: Parser BLS12_381.G1.Element
conBLS12_381_G1_Element :: Parser Element
conBLS12_381_G1_Element = do
    ByteString
s <- Parser ByteString
con0xBS
    case ByteString -> Either BLSTError Element
BLS12_381.G1.uncompress ByteString
s of
      Left BLSTError
err -> [Char] -> Parser Element
forall a.
[Char]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Element) -> [Char] -> Parser Element
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to decode value of type bls12_381_G1_element: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BLSTError -> [Char]
forall a. Show a => a -> [Char]
show BLSTError
err
      Right Element
e  -> Element -> Parser Element
forall a.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
e

conBLS12_381_G2_Element :: Parser BLS12_381.G2.Element
conBLS12_381_G2_Element :: Parser Element
conBLS12_381_G2_Element = do
    ByteString
s <- Parser ByteString
con0xBS
    case ByteString -> Either BLSTError Element
BLS12_381.G2.uncompress ByteString
s of
      Left BLSTError
err -> [Char] -> Parser Element
forall a.
[Char]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Element) -> [Char] -> Parser Element
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to decode value of type bls12_381_G2_element: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BLSTError -> [Char]
forall a. Show a => a -> [Char]
show BLSTError
err
      Right Element
e  -> Element -> Parser Element
forall a.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
e

-- | Parser for constants of the given type.
constantOf :: ExpectParens -> DefaultUni (Esc a) -> Parser a
constantOf :: forall a. ExpectParens -> DefaultUni (Esc a) -> Parser a
constantOf ExpectParens
expectParens DefaultUni (Esc a)
uni = case DefaultUni (Esc a)
uni of
    DefaultUni (Esc a)
DefaultUniInteger                                                 -> Parser a
Parser Integer
conInteger
    DefaultUni (Esc a)
DefaultUniByteString                                              -> Parser a
Parser ByteString
conBS
    DefaultUni (Esc a)
DefaultUniString                                                  -> Parser a
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Text
conText
    DefaultUni (Esc a)
DefaultUniUnit                                                    -> Parser a
ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  ()
conUnit
    DefaultUni (Esc a)
DefaultUniBool                                                    -> Parser a
Parser Bool
conBool
    DefaultUni (Esc f)
DefaultUniProtoList `DefaultUniApply` DefaultUni (Esc a1)
uniA                        -> DefaultUni (Esc a1) -> Parser [a1]
forall a. DefaultUni (Esc a) -> Parser [a]
conList DefaultUni (Esc a1)
DefaultUni (Esc a1)
uniA
    DefaultUni (Esc f)
DefaultUniProtoPair `DefaultUniApply` DefaultUni (Esc a1)
uniA `DefaultUniApply` DefaultUni (Esc a1)
uniB -> DefaultUni (Esc a1) -> DefaultUni (Esc a1) -> Parser (a1, a1)
forall a b.
DefaultUni (Esc a) -> DefaultUni (Esc b) -> Parser (a, b)
conPair DefaultUni (Esc a1)
DefaultUni (Esc a1)
uniA DefaultUni (Esc a1)
DefaultUni (Esc a1)
uniB
    DefaultUni (Esc f)
f `DefaultUniApply` DefaultUni (Esc a1)
_ `DefaultUniApply` DefaultUni (Esc a1)
_ `DefaultUniApply` DefaultUni (Esc a1)
_     -> DefaultUni (Esc f) -> Parser a
forall a b c d (f :: a -> b -> c -> d) any.
DefaultUni (Esc f) -> any
noMoreTypeFunctions DefaultUni (Esc f)
DefaultUni (Esc f)
f
    DefaultUni (Esc a)
DefaultUniData                                                    -> ExpectParens -> Parser Data
conData ExpectParens
expectParens
    DefaultUni (Esc a)
DefaultUniBLS12_381_G1_Element                                    -> Parser a
Parser Element
conBLS12_381_G1_Element
    DefaultUni (Esc a)
DefaultUniBLS12_381_G2_Element                                    -> Parser a
Parser Element
conBLS12_381_G2_Element
    DefaultUni (Esc a)
DefaultUniBLS12_381_MlResult
        -> [Char] -> Parser a
forall a.
[Char]
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Constants of type bls12_381_mlresult are not supported"

-- | Parser of constants whose type is in 'DefaultUni'.
constant :: Parser (Some (ValueOf DefaultUni))
constant :: Parser (Some (ValueOf DefaultUni))
constant = do
  -- Parse the type tag.
  SomeTypeIn (Kinded DefaultUni (Esc a)
uni) <- Parser (SomeTypeIn (Kinded DefaultUni))
defaultUni
  -- Check it's of kind @*@, because a constant that we're about to parse can only be of type of
  -- kind @*@.
  k :~: *
Refl <- Maybe (k :~: *)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (k :~: *)
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Alternative g) =>
f a -> g a
reoption (Maybe (k :~: *)
 -> ParsecT
      ParserError
      Text
      (StateT ParserState (ReaderT (Maybe Version) Quote))
      (k :~: *))
-> Maybe (k :~: *)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (k :~: *)
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc a) -> Maybe (k :~: *)
forall (uni :: * -> *) a (x :: a).
Typeable a =>
uni (Esc x) -> Maybe (a :~: *)
checkStar DefaultUni (Esc a)
uni
  -- Parse the constant of the type represented by the type tag.
  DefaultUni (Esc a) -> a -> Some (ValueOf DefaultUni)
forall a (uni :: * -> *). uni (Esc a) -> a -> Some (ValueOf uni)
someValueOf DefaultUni (Esc a)
DefaultUni (Esc a)
uni (a -> Some (ValueOf DefaultUni))
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
-> Parser (Some (ValueOf DefaultUni))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpectParens
-> DefaultUni (Esc a)
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall a. ExpectParens -> DefaultUni (Esc a) -> Parser a
constantOf ExpectParens
ExpectParensYes DefaultUni (Esc a)
DefaultUni (Esc a)
uni

data ExpectParens
  = ExpectParensYes
  | ExpectParensNo