-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Parsing of untyped Michelson values.

module Morley.Michelson.Parser.Value
  ( value'

  -- * For tests
  , stringLiteral
  , bytesLiteral
  , intLiteral
  ) where

import Prelude hiding (many, note, try)

import Data.Char qualified as Char
import Text.Hex qualified as Hex

import Text.Megaparsec (anySingle, choice, customFailure, label, manyTill, satisfy, takeWhileP, try)
import Text.Megaparsec.Char (char, string)
import Text.Megaparsec.Char.Lexer qualified as L

import Morley.Michelson.Macro (ParsedOp, ParsedSeq(..), ParsedValue)
import Morley.Michelson.Parser.Error
import Morley.Michelson.Parser.Helpers
import Morley.Michelson.Parser.Lexer
import Morley.Michelson.Parser.Types (Parser)
import Morley.Michelson.Text (isMChar, mkMText)
import Morley.Michelson.Untyped qualified as U

-- | Parse untyped 'ParsedValue'. Take instruction parser as argument
-- to avoid cyclic dependencies between modules, hence ' in its name.
value' :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
value' :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
value' Parser (ParsedSeq ParsedOp)
opsParser = Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
parensOrTuple Parser (ParsedSeq ParsedOp)
opsParser Parser ParsedValue -> Parser ParsedValue -> Parser ParsedValue
forall a.
ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
valueInnerWithoutParens Parser (ParsedSeq ParsedOp)
opsParser

parensOrTuple :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
parensOrTuple :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
parensOrTuple Parser (ParsedSeq ParsedOp)
opsParser = Parser ParsedValue -> Parser ParsedValue
forall a. Parser a -> Parser a
parens (Parser ParsedValue -> Parser ParsedValue)
-> Parser ParsedValue -> Parser ParsedValue
forall a b. (a -> b) -> a -> b
$ Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
value' Parser (ParsedSeq ParsedOp)
opsParser

valueInnerWithoutParens :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
valueInnerWithoutParens :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
valueInnerWithoutParens Parser (ParsedSeq ParsedOp)
opsParser = [Char] -> Parser ParsedValue -> Parser ParsedValue
forall a.
[Char]
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"value" (Parser ParsedValue -> Parser ParsedValue)
-> Parser ParsedValue -> Parser ParsedValue
forall a b. (a -> b) -> a -> b
$ [Parser ParsedValue] -> Parser ParsedValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser ParsedValue] -> Parser ParsedValue)
-> [Parser ParsedValue] -> Parser ParsedValue
forall a b. (a -> b) -> a -> b
$
  [ Parser ParsedValue
stringLiteral, Parser ParsedValue
forall {k} (f :: k -> *) (op :: k). Parser (Value' f op)
bytesLiteral, Parser ParsedValue
forall {k} (f :: k -> *) (op :: k). Parser (Value' f op)
intLiteral, Parser ParsedValue
unitValue
  , Parser ParsedValue
trueValue, Parser ParsedValue
falseValue, Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
pairValueCore Parser (ParsedSeq ParsedOp)
opsParser, Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
leftValue Parser (ParsedSeq ParsedOp)
opsParser
  , Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
rightValue Parser (ParsedSeq ParsedOp)
opsParser, Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
someValue Parser (ParsedSeq ParsedOp)
opsParser, Parser ParsedValue
noneValue, Parser ParsedValue
nilValue
  , Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
seqOrLambda Parser (ParsedSeq ParsedOp)
opsParser, Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
mapValue Parser (ParsedSeq ParsedOp)
opsParser, Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
lambdaRecValue Parser (ParsedSeq ParsedOp)
opsParser
  ]

seqOrLambda :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
seqOrLambda :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
seqOrLambda Parser (ParsedSeq ParsedOp)
opsParser = Parser ParsedValue -> Parser ParsedValue
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
lambdaValue Parser (ParsedSeq ParsedOp)
opsParser) Parser ParsedValue -> Parser ParsedValue -> Parser ParsedValue
forall a.
ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
seqValue Parser (ParsedSeq ParsedOp)
opsParser

stringLiteral :: Parser ParsedValue
stringLiteral :: Parser ParsedValue
stringLiteral = Parser ParsedValue -> Parser ParsedValue
forall a. Parser a -> Parser a
lexeme (Parser ParsedValue -> Parser ParsedValue)
-> Parser ParsedValue -> Parser ParsedValue
forall a b. (a -> b) -> a -> b
$ MText -> ParsedValue
forall {k} (f :: k -> *) (op :: k). MText -> Value' f op
U.ValueString (MText -> ParsedValue)
-> ([Char] -> MText) -> [Char] -> ParsedValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Text MText -> MText
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text MText -> MText)
-> ([Char] -> Either Text MText) -> [Char] -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> Either Text MText)
-> ([Char] -> Text) -> [Char] -> Either Text MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
forall a. ToText a => a -> Text
toText ([Char] -> ParsedValue)
-> ParsecT CustomParserException Text Identity [Char]
-> Parser ParsedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Tokens Text
_ <- ParsecT CustomParserException Text Identity (Tokens Text)
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomParserException Text Identity (Tokens Text)
 -> ParsecT CustomParserException Text Identity (Tokens Text))
-> ParsecT CustomParserException Text Identity (Tokens Text)
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\""
  ParsecT CustomParserException Text Identity Char
-> ParsecT CustomParserException Text Identity (Tokens Text)
-> ParsecT CustomParserException Text Identity [Char]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT CustomParserException Text Identity Char
validChar (Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\"")
  where
      validChar :: Parser Char
      validChar :: ParsecT CustomParserException Text Identity Char
validChar = [ParsecT CustomParserException Text Identity Char]
-> ParsecT CustomParserException Text Identity Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ ParsecT CustomParserException Text Identity Char
strEscape
        , (Token Text -> Bool)
-> ParsecT CustomParserException Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token Text
x -> Char
Token Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Char -> Bool
isMChar Char
Token Text
x)
        , ParsecT CustomParserException Text Identity Char
ParsecT CustomParserException Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT CustomParserException Text Identity Char
-> (Char -> ParsecT CustomParserException Text Identity Char)
-> ParsecT CustomParserException Text Identity Char
forall a b.
ParsecT CustomParserException Text Identity a
-> (a -> ParsecT CustomParserException Text Identity b)
-> ParsecT CustomParserException Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StringLiteralParserException
-> ParsecT CustomParserException Text Identity Char
forall {a}.
StringLiteralParserException
-> ParsecT CustomParserException Text Identity a
stringLiteralFailure (StringLiteralParserException
 -> ParsecT CustomParserException Text Identity Char)
-> (Char -> StringLiteralParserException)
-> Char
-> ParsecT CustomParserException Text Identity Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> StringLiteralParserException
InvalidChar
        ]

      strEscape :: Parser Char
      strEscape :: ParsecT CustomParserException Text Identity Char
strEscape = ParsecT CustomParserException Text Identity Char
-> ParsecT CustomParserException Text Identity Char
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text
-> ParsecT CustomParserException Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\') ParsecT CustomParserException Text Identity Char
-> ParsecT CustomParserException Text Identity Char
-> ParsecT CustomParserException Text Identity Char
forall a b.
ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity b
-> ParsecT CustomParserException Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomParserException Text Identity Char
esc
        where
          esc :: ParsecT CustomParserException Text Identity Char
esc = [ParsecT CustomParserException Text Identity Char]
-> ParsecT CustomParserException Text Identity Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
            [ Token Text
-> ParsecT CustomParserException Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\'
            , Token Text
-> ParsecT CustomParserException Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"'
            , Token Text
-> ParsecT CustomParserException Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'n' ParsecT CustomParserException Text Identity Char
-> Char -> ParsecT CustomParserException Text Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\n'
            , ParsecT CustomParserException Text Identity Char
ParsecT CustomParserException Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT CustomParserException Text Identity Char
-> (Char -> ParsecT CustomParserException Text Identity Char)
-> ParsecT CustomParserException Text Identity Char
forall a b.
ParsecT CustomParserException Text Identity a
-> (a -> ParsecT CustomParserException Text Identity b)
-> ParsecT CustomParserException Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StringLiteralParserException
-> ParsecT CustomParserException Text Identity Char
forall {a}.
StringLiteralParserException
-> ParsecT CustomParserException Text Identity a
stringLiteralFailure (StringLiteralParserException
 -> ParsecT CustomParserException Text Identity Char)
-> (Char -> StringLiteralParserException)
-> Char
-> ParsecT CustomParserException Text Identity Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> StringLiteralParserException
InvalidEscapeSequence
            ]
      stringLiteralFailure :: StringLiteralParserException
-> ParsecT CustomParserException Text Identity a
stringLiteralFailure = CustomParserException
-> ParsecT CustomParserException Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomParserException
 -> ParsecT CustomParserException Text Identity a)
-> (StringLiteralParserException -> CustomParserException)
-> StringLiteralParserException
-> ParsecT CustomParserException Text Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteralParserException -> CustomParserException
StringLiteralException

-- It is safe not to use `try` here because bytesLiteral is the only
-- thing that starts from 0x (at least for now)
bytesLiteral :: Parser (U.Value' f op)
bytesLiteral :: forall {k} (f :: k -> *) (op :: k). Parser (Value' f op)
bytesLiteral = Parser (Value' f op) -> Parser (Value' f op)
forall a. Parser a -> Parser a
lexeme (Parser (Value' f op) -> Parser (Value' f op))
-> Parser (Value' f op) -> Parser (Value' f op)
forall a b. (a -> b) -> a -> b
$ do
  Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"0x"
  Text
hexdigits <- Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
Char.isHexDigit
  let mBytes :: Maybe ByteString
mBytes = Text -> Maybe ByteString
Hex.decodeHex Text
hexdigits
  Parser (Value' f op)
-> (ByteString -> Parser (Value' f op))
-> Maybe ByteString
-> Parser (Value' f op)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (CustomParserException -> Parser (Value' f op)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure CustomParserException
OddNumberBytesException)
    (Value' f op -> Parser (Value' f op)
forall a. a -> ParsecT CustomParserException Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value' f op -> Parser (Value' f op))
-> (ByteString -> Value' f op)
-> ByteString
-> Parser (Value' f op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalByteString -> Value' f op
forall {k} (f :: k -> *) (op :: k).
InternalByteString -> Value' f op
U.ValueBytes (InternalByteString -> Value' f op)
-> (ByteString -> InternalByteString) -> ByteString -> Value' f op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> InternalByteString
U.InternalByteString)
    Maybe ByteString
mBytes

intLiteral :: Parser (U.Value' f op)
intLiteral :: forall {k} (f :: k -> *) (op :: k). Parser (Value' f op)
intLiteral = Parser (Value' f op) -> Parser (Value' f op)
forall a. Parser a -> Parser a
lexeme (Parser (Value' f op) -> Parser (Value' f op))
-> Parser (Value' f op) -> Parser (Value' f op)
forall a b. (a -> b) -> a -> b
$ Parser (Value' f op) -> Parser (Value' f op)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser (Value' f op) -> Parser (Value' f op))
-> Parser (Value' f op) -> Parser (Value' f op)
forall a b. (a -> b) -> a -> b
$ Integer -> Value' f op
forall {k} (f :: k -> *) (op :: k). Integer -> Value' f op
U.ValueInt (Integer -> Value' f op)
-> ParsecT CustomParserException Text Identity Integer
-> Parser (Value' f op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity Integer
-> ParsecT CustomParserException Text Identity Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed ParsecT CustomParserException Text Identity ()
forall (f :: * -> *). Applicative f => f ()
pass ParsecT CustomParserException Text Identity Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal

unitValue :: Parser ParsedValue
unitValue :: Parser ParsedValue
unitValue = Tokens Text -> ParsedValue -> Parser ParsedValue
forall a. Tokens Text -> a -> Parser a
word Text
Tokens Text
"Unit" ParsedValue
forall {k} (f :: k -> *) (op :: k). Value' f op
U.ValueUnit

trueValue :: Parser ParsedValue
trueValue :: Parser ParsedValue
trueValue = Tokens Text -> ParsedValue -> Parser ParsedValue
forall a. Tokens Text -> a -> Parser a
word Text
Tokens Text
"True" ParsedValue
forall {k} (f :: k -> *) (op :: k). Value' f op
U.ValueTrue

falseValue :: Parser ParsedValue
falseValue :: Parser ParsedValue
falseValue = Tokens Text -> ParsedValue -> Parser ParsedValue
forall a. Tokens Text -> a -> Parser a
word Text
Tokens Text
"False" ParsedValue
forall {k} (f :: k -> *) (op :: k). Value' f op
U.ValueFalse

pairValueCore :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
pairValueCore :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
pairValueCore Parser (ParsedSeq ParsedOp)
opsParser = Tokens Text -> ParsecT CustomParserException Text Identity ()
symbol1 Text
Tokens Text
"Pair" ParsecT CustomParserException Text Identity ()
-> Parser ParsedValue -> Parser ParsedValue
forall a b.
ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity b
-> ParsecT CustomParserException Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ParsedValue
pairInner
  where
    pairInner :: Parser ParsedValue
pairInner = ParsedValue -> ParsedValue -> ParsedValue
forall {k} (f :: k -> *) (op :: k).
Value' f op -> Value' f op -> Value' f op
U.ValuePair
      (ParsedValue -> ParsedValue -> ParsedValue)
-> Parser ParsedValue
-> ParsecT
     CustomParserException Text Identity (ParsedValue -> ParsedValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
value' Parser (ParsedSeq ParsedOp)
opsParser
      ParsecT
  CustomParserException Text Identity (ParsedValue -> ParsedValue)
-> Parser ParsedValue -> Parser ParsedValue
forall a b.
ParsecT CustomParserException Text Identity (a -> b)
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((ParsedValue -> ParsedValue -> ParsedValue)
-> NonEmpty ParsedValue -> ParsedValue
forall a. (a -> a -> a) -> NonEmpty a -> a
foldr1 ParsedValue -> ParsedValue -> ParsedValue
forall {k} (f :: k -> *) (op :: k).
Value' f op -> Value' f op -> Value' f op
U.ValuePair (NonEmpty ParsedValue -> ParsedValue)
-> ParsecT
     CustomParserException Text Identity (NonEmpty ParsedValue)
-> Parser ParsedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParsedValue
-> ParsecT
     CustomParserException Text Identity (NonEmpty ParsedValue)
forall (f :: * -> *) a. MonadPlus f => f a -> f (NonEmpty a)
some' (Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
value' Parser (ParsedSeq ParsedOp)
opsParser))

leftValue :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
leftValue :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
leftValue Parser (ParsedSeq ParsedOp)
opsParser = Tokens Text
-> (ParsedValue -> ParsedValue)
-> ParsecT
     CustomParserException Text Identity (ParsedValue -> ParsedValue)
forall a. Tokens Text -> a -> Parser a
word Text
Tokens Text
"Left" ParsedValue -> ParsedValue
forall {k} (f :: k -> *) (op :: k). Value' f op -> Value' f op
U.ValueLeft ParsecT
  CustomParserException Text Identity (ParsedValue -> ParsedValue)
-> Parser ParsedValue -> Parser ParsedValue
forall a b.
ParsecT CustomParserException Text Identity (a -> b)
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
value' Parser (ParsedSeq ParsedOp)
opsParser

rightValue :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
rightValue :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
rightValue Parser (ParsedSeq ParsedOp)
opsParser = Tokens Text
-> (ParsedValue -> ParsedValue)
-> ParsecT
     CustomParserException Text Identity (ParsedValue -> ParsedValue)
forall a. Tokens Text -> a -> Parser a
word Text
Tokens Text
"Right" ParsedValue -> ParsedValue
forall {k} (f :: k -> *) (op :: k). Value' f op -> Value' f op
U.ValueRight ParsecT
  CustomParserException Text Identity (ParsedValue -> ParsedValue)
-> Parser ParsedValue -> Parser ParsedValue
forall a b.
ParsecT CustomParserException Text Identity (a -> b)
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
value' Parser (ParsedSeq ParsedOp)
opsParser

someValue :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
someValue :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
someValue Parser (ParsedSeq ParsedOp)
opsParser = Tokens Text
-> (ParsedValue -> ParsedValue)
-> ParsecT
     CustomParserException Text Identity (ParsedValue -> ParsedValue)
forall a. Tokens Text -> a -> Parser a
word Text
Tokens Text
"Some" ParsedValue -> ParsedValue
forall {k} (f :: k -> *) (op :: k). Value' f op -> Value' f op
U.ValueSome ParsecT
  CustomParserException Text Identity (ParsedValue -> ParsedValue)
-> Parser ParsedValue -> Parser ParsedValue
forall a b.
ParsecT CustomParserException Text Identity (a -> b)
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
value' Parser (ParsedSeq ParsedOp)
opsParser

noneValue :: Parser ParsedValue
noneValue :: Parser ParsedValue
noneValue = Tokens Text -> ParsedValue -> Parser ParsedValue
forall a. Tokens Text -> a -> Parser a
word Text
Tokens Text
"None" ParsedValue
forall {k} (f :: k -> *) (op :: k). Value' f op
U.ValueNone

nilValue :: Parser ParsedValue
nilValue :: Parser ParsedValue
nilValue = ParsedValue
forall {k} (f :: k -> *) (op :: k). Value' f op
U.ValueNil ParsedValue
-> ParsecT CustomParserException Text Identity ()
-> Parser ParsedValue
forall a b.
a
-> ParsecT CustomParserException Text Identity b
-> ParsecT CustomParserException Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomParserException Text Identity ()
 -> ParsecT CustomParserException Text Identity ())
-> ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
forall a. Parser a -> Parser a
braces ParsecT CustomParserException Text Identity ()
forall (f :: * -> *). Applicative f => f ()
pass)

lambdaValue :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
lambdaValue :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
lambdaValue Parser (ParsedSeq ParsedOp)
opsParser = Parser (ParsedSeq ParsedOp)
opsParser Parser (ParsedSeq ParsedOp)
-> (ParsedSeq ParsedOp -> ParsedValue) -> Parser ParsedValue
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
  PSSequence [] -> ParsedValue
forall {k} (f :: k -> *) (op :: k). Value' f op
U.ValueNil
  ParsedSeq ParsedOp
ops -> ParsedSeq ParsedOp -> ParsedValue
forall {k} (f :: k -> *) (op :: k). f op -> Value' f op
U.ValueLambda ParsedSeq ParsedOp
ops

lambdaRecValue :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
lambdaRecValue :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
lambdaRecValue Parser (ParsedSeq ParsedOp)
opsParser = Tokens Text
-> (ParsedSeq ParsedOp -> ParsedValue)
-> Parser (ParsedSeq ParsedOp -> ParsedValue)
forall a. Tokens Text -> a -> Parser a
word Text
Tokens Text
"Lambda_rec" ParsedSeq ParsedOp -> ParsedValue
forall {k} (f :: k -> *) (op :: k). f op -> Value' f op
U.ValueLamRec Parser (ParsedSeq ParsedOp -> ParsedValue)
-> Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
forall a b.
ParsecT CustomParserException Text Identity (a -> b)
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ParsedSeq ParsedOp)
opsParser

seqValue :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
seqValue :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
seqValue Parser (ParsedSeq ParsedOp)
opsParser =
  NonEmpty ParsedValue -> ParsedValue
forall {k} (f :: k -> *) (op :: k).
(NonEmpty $ Value' f op) -> Value' f op
U.ValueSeq (NonEmpty ParsedValue -> ParsedValue)
-> ParsecT
     CustomParserException Text Identity (NonEmpty ParsedValue)
-> Parser ParsedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT CustomParserException Text Identity (NonEmpty ParsedValue)
-> ParsecT
     CustomParserException Text Identity (NonEmpty ParsedValue)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomParserException Text Identity (NonEmpty ParsedValue)
 -> ParsecT
      CustomParserException Text Identity (NonEmpty ParsedValue))
-> ParsecT
     CustomParserException Text Identity (NonEmpty ParsedValue)
-> ParsecT
     CustomParserException Text Identity (NonEmpty ParsedValue)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomParserException Text Identity (NonEmpty ParsedValue)
-> ParsecT
     CustomParserException Text Identity (NonEmpty ParsedValue)
forall a. Parser a -> Parser a
braces (ParsecT CustomParserException Text Identity (NonEmpty ParsedValue)
 -> ParsecT
      CustomParserException Text Identity (NonEmpty ParsedValue))
-> ParsecT
     CustomParserException Text Identity (NonEmpty ParsedValue)
-> ParsecT
     CustomParserException Text Identity (NonEmpty ParsedValue)
forall a b. (a -> b) -> a -> b
$ Parser ParsedValue
-> ParsecT CustomParserException Text Identity ()
-> ParsecT
     CustomParserException Text Identity (NonEmpty ParsedValue)
forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
sepEndBy1 (Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
value' Parser (ParsedSeq ParsedOp)
opsParser) ParsecT CustomParserException Text Identity ()
semicolon)

eltValue :: Parser (ParsedSeq ParsedOp) -> Parser (U.Elt ParsedSeq ParsedOp)
eltValue :: Parser (ParsedSeq ParsedOp) -> Parser (Elt ParsedSeq ParsedOp)
eltValue Parser (ParsedSeq ParsedOp)
opsParser = Tokens Text
-> (ParsedValue -> ParsedValue -> Elt ParsedSeq ParsedOp)
-> Parser (ParsedValue -> ParsedValue -> Elt ParsedSeq ParsedOp)
forall a. Tokens Text -> a -> Parser a
word Text
Tokens Text
"Elt" ParsedValue -> ParsedValue -> Elt ParsedSeq ParsedOp
forall {k} (f :: k -> *) (op :: k).
Value' f op -> Value' f op -> Elt f op
U.Elt Parser (ParsedValue -> ParsedValue -> Elt ParsedSeq ParsedOp)
-> Parser ParsedValue
-> ParsecT
     CustomParserException
     Text
     Identity
     (ParsedValue -> Elt ParsedSeq ParsedOp)
forall a b.
ParsecT CustomParserException Text Identity (a -> b)
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
value' Parser (ParsedSeq ParsedOp)
opsParser ParsecT
  CustomParserException
  Text
  Identity
  (ParsedValue -> Elt ParsedSeq ParsedOp)
-> Parser ParsedValue -> Parser (Elt ParsedSeq ParsedOp)
forall a b.
ParsecT CustomParserException Text Identity (a -> b)
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
value' Parser (ParsedSeq ParsedOp)
opsParser

mapValue :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
mapValue :: Parser (ParsedSeq ParsedOp) -> Parser ParsedValue
mapValue Parser (ParsedSeq ParsedOp)
opsParser =
  (NonEmpty $ Elt ParsedSeq ParsedOp) -> ParsedValue
forall {k} (f :: k -> *) (op :: k).
(NonEmpty $ Elt f op) -> Value' f op
U.ValueMap ((NonEmpty $ Elt ParsedSeq ParsedOp) -> ParsedValue)
-> ParsecT
     CustomParserException
     Text
     Identity
     (NonEmpty $ Elt ParsedSeq ParsedOp)
-> Parser ParsedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT
  CustomParserException
  Text
  Identity
  (NonEmpty $ Elt ParsedSeq ParsedOp)
-> ParsecT
     CustomParserException
     Text
     Identity
     (NonEmpty $ Elt ParsedSeq ParsedOp)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT
   CustomParserException
   Text
   Identity
   (NonEmpty $ Elt ParsedSeq ParsedOp)
 -> ParsecT
      CustomParserException
      Text
      Identity
      (NonEmpty $ Elt ParsedSeq ParsedOp))
-> ParsecT
     CustomParserException
     Text
     Identity
     (NonEmpty $ Elt ParsedSeq ParsedOp)
-> ParsecT
     CustomParserException
     Text
     Identity
     (NonEmpty $ Elt ParsedSeq ParsedOp)
forall a b. (a -> b) -> a -> b
$ ParsecT
  CustomParserException
  Text
  Identity
  (NonEmpty $ Elt ParsedSeq ParsedOp)
-> ParsecT
     CustomParserException
     Text
     Identity
     (NonEmpty $ Elt ParsedSeq ParsedOp)
forall a. Parser a -> Parser a
braces (ParsecT
   CustomParserException
   Text
   Identity
   (NonEmpty $ Elt ParsedSeq ParsedOp)
 -> ParsecT
      CustomParserException
      Text
      Identity
      (NonEmpty $ Elt ParsedSeq ParsedOp))
-> ParsecT
     CustomParserException
     Text
     Identity
     (NonEmpty $ Elt ParsedSeq ParsedOp)
-> ParsecT
     CustomParserException
     Text
     Identity
     (NonEmpty $ Elt ParsedSeq ParsedOp)
forall a b. (a -> b) -> a -> b
$ Parser (Elt ParsedSeq ParsedOp)
-> ParsecT CustomParserException Text Identity ()
-> ParsecT
     CustomParserException
     Text
     Identity
     (NonEmpty $ Elt ParsedSeq ParsedOp)
forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
sepEndBy1 (Parser (ParsedSeq ParsedOp) -> Parser (Elt ParsedSeq ParsedOp)
eltValue Parser (ParsedSeq ParsedOp)
opsParser) ParsecT CustomParserException Text Identity ()
semicolon)