-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Parsing of untyped Michelson values.

module Morley.Michelson.Parser.Value
  ( value'
  , mkLetVal

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

import Prelude hiding (many, note, try)

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

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

import Morley.Michelson.Let (LetValue(..))
import Morley.Michelson.Macro (ParsedOp, ParsedValue)
import Morley.Michelson.Parser.Error
import Morley.Michelson.Parser.Helpers
import Morley.Michelson.Parser.Lexer
import Morley.Michelson.Parser.Types (Parser, letValues)
import Morley.Michelson.Text (isMChar, unsafeMkMText)
import qualified Morley.Michelson.Untyped as U

{-
Note [Exponential backtracking]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Consider the following input string:

@
(Pair 1 (Pair 2 (Pair 3 (Pair 4 5))))
@

until we've parsed it completely, we can't decide whether the first
opening parenthesis is starting a tuple, or a simple expression.
The same applies to all subsequent parentheses. At one point, our parser
first tried to parse the whole expression as a tuple, then backtracked,
then tried to parse the same expression as a value (which includes
a tuple). Hence it incurred the exponential backtracking.

To avoid that, we first try to parse anything that starts with @(@, i.e.
a comma-separated tuple, or a plain value in parentheses. The choice
between the two is trivial: if there's one value it's just value, if
there are multiple, it's a tuple.

If we don't find @(@ we then try to parse anything that /doesn't/ start
with a parenthesis, i.e. everything else.
-}

-- | Parse untyped 'ParsedValue'. Take instruction parser as argument
-- to avoid cyclic dependencies between modules, hence ' in its name.
value' :: Parser ParsedOp -> Parser ParsedValue
value' :: Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser = 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
$ Parser ParsedOp -> Parser ParsedValue
parensOrTuple Parser ParsedOp
opParser Parser ParsedValue -> Parser ParsedValue -> Parser ParsedValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParsedOp -> Parser ParsedValue
valueInnerWithoutParens Parser ParsedOp
opParser

parensOrTuple :: Parser ParsedOp -> Parser ParsedValue
parensOrTuple :: Parser ParsedOp -> Parser ParsedValue
parensOrTuple Parser ParsedOp
opParser = 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
$ (ParsedValue -> ParsedValue -> ParsedValue)
-> NonEmpty ParsedValue -> ParsedValue
forall a. (a -> a -> a) -> NonEmpty a -> a
foldr1 ParsedValue -> ParsedValue -> ParsedValue
forall op. Value' op -> Value' op -> Value' op
U.ValuePair (NonEmpty ParsedValue -> ParsedValue)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
-> Parser ParsedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser Parser ParsedValue
-> ReaderT LetEnv (Parsec CustomParserException Text) ()
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
forall (f :: * -> *) a sep.
MonadPlus f =>
f a -> f sep -> f (NonEmpty a)
`sepBy1` ReaderT LetEnv (Parsec CustomParserException Text) ()
comma

valueInnerWithoutParens :: Parser ParsedOp -> Parser ParsedValue
valueInnerWithoutParens :: Parser ParsedOp -> Parser ParsedValue
valueInnerWithoutParens Parser ParsedOp
opParser = String -> Parser ParsedValue -> Parser ParsedValue
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"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 op. Parser (Value' op)
bytesLiteral, Parser ParsedValue
forall op. Parser (Value' op)
intLiteral, Parser ParsedValue
unitValue
  , Parser ParsedValue
trueValue, Parser ParsedValue
falseValue, Parser ParsedOp -> Parser ParsedValue
pairValueCore Parser ParsedOp
opParser, Parser ParsedOp -> Parser ParsedValue
leftValue Parser ParsedOp
opParser
  , Parser ParsedOp -> Parser ParsedValue
rightValue Parser ParsedOp
opParser, Parser ParsedOp -> Parser ParsedValue
someValue Parser ParsedOp
opParser, Parser ParsedValue
noneValue, Parser ParsedValue
nilValue
  , Parser ParsedOp -> Parser ParsedValue
seqOrLambda Parser ParsedOp
opParser, Parser ParsedOp -> Parser ParsedValue
mapValue Parser ParsedOp
opParser, Parser ParsedValue
dataLetValue
  ]

seqOrLambda :: Parser ParsedOp -> Parser ParsedValue
seqOrLambda :: Parser ParsedOp -> Parser ParsedValue
seqOrLambda Parser ParsedOp
opParser = Parser ParsedValue -> Parser ParsedValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser ParsedOp -> Parser ParsedValue
lambdaValue Parser ParsedOp
opParser) Parser ParsedValue -> Parser ParsedValue -> Parser ParsedValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParsedOp -> Parser ParsedValue
seqValue Parser ParsedOp
opParser

stringLiteral :: Parser ParsedValue
stringLiteral :: Parser ParsedValue
stringLiteral = MText -> ParsedValue
forall op. MText -> Value' op
U.ValueString (MText -> ParsedValue)
-> (String -> MText) -> String -> ParsedValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> MText
Text -> MText
unsafeMkMText (Text -> MText) -> (String -> Text) -> String -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> ParsedValue)
-> ReaderT LetEnv (Parsec CustomParserException Text) String
-> Parser ParsedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Text
_ <- ReaderT LetEnv (Parsec CustomParserException Text) Text
-> ReaderT LetEnv (Parsec CustomParserException Text) Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ReaderT LetEnv (Parsec CustomParserException Text) Text
 -> ReaderT LetEnv (Parsec CustomParserException Text) Text)
-> ReaderT LetEnv (Parsec CustomParserException Text) Text
-> ReaderT LetEnv (Parsec CustomParserException Text) Text
forall a b. (a -> b) -> a -> b
$ Tokens Text
-> ReaderT LetEnv (Parsec CustomParserException Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\""
  ReaderT LetEnv (Parsec CustomParserException Text) Char
-> ReaderT LetEnv (Parsec CustomParserException Text) Text
-> ReaderT LetEnv (Parsec CustomParserException Text) String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ReaderT LetEnv (Parsec CustomParserException Text) Char
validChar (Tokens Text
-> ReaderT LetEnv (Parsec CustomParserException Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\"")
  where
      validChar :: Parser Char
      validChar :: ReaderT LetEnv (Parsec CustomParserException Text) Char
validChar = [ReaderT LetEnv (Parsec CustomParserException Text) Char]
-> ReaderT LetEnv (Parsec CustomParserException Text) Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ ReaderT LetEnv (Parsec CustomParserException Text) Char
strEscape
        , (Token Text -> Bool)
-> ReaderT LetEnv (Parsec CustomParserException Text) (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)
        , ReaderT LetEnv (Parsec CustomParserException Text) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ReaderT LetEnv (Parsec CustomParserException Text) Char
-> (Char
    -> ReaderT LetEnv (Parsec CustomParserException Text) Char)
-> ReaderT LetEnv (Parsec CustomParserException Text) Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StringLiteralParserException
-> ReaderT LetEnv (Parsec CustomParserException Text) Char
forall a.
StringLiteralParserException
-> ReaderT LetEnv (Parsec CustomParserException Text) a
stringLiteralFailure (StringLiteralParserException
 -> ReaderT LetEnv (Parsec CustomParserException Text) Char)
-> (Char -> StringLiteralParserException)
-> Char
-> ReaderT LetEnv (Parsec CustomParserException Text) Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> StringLiteralParserException
InvalidChar
        ]

      strEscape :: Parser Char
      strEscape :: ReaderT LetEnv (Parsec CustomParserException Text) Char
strEscape = ReaderT LetEnv (Parsec CustomParserException Text) Char
-> ReaderT LetEnv (Parsec CustomParserException Text) Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text
-> ReaderT LetEnv (Parsec CustomParserException Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\') ReaderT LetEnv (Parsec CustomParserException Text) Char
-> ReaderT LetEnv (Parsec CustomParserException Text) Char
-> ReaderT LetEnv (Parsec CustomParserException Text) Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT LetEnv (Parsec CustomParserException Text) Char
esc
        where
          esc :: ReaderT LetEnv (Parsec CustomParserException Text) Char
esc = [ReaderT LetEnv (Parsec CustomParserException Text) Char]
-> ReaderT LetEnv (Parsec CustomParserException Text) Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
            [ Token Text
-> ReaderT LetEnv (Parsec CustomParserException Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\'
            , Token Text
-> ReaderT LetEnv (Parsec CustomParserException Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"'
            , Token Text
-> ReaderT LetEnv (Parsec CustomParserException Text) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'n' ReaderT LetEnv (Parsec CustomParserException Text) Char
-> Char -> ReaderT LetEnv (Parsec CustomParserException Text) Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\n'
            , ReaderT LetEnv (Parsec CustomParserException Text) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ReaderT LetEnv (Parsec CustomParserException Text) Char
-> (Char
    -> ReaderT LetEnv (Parsec CustomParserException Text) Char)
-> ReaderT LetEnv (Parsec CustomParserException Text) Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StringLiteralParserException
-> ReaderT LetEnv (Parsec CustomParserException Text) Char
forall a.
StringLiteralParserException
-> ReaderT LetEnv (Parsec CustomParserException Text) a
stringLiteralFailure (StringLiteralParserException
 -> ReaderT LetEnv (Parsec CustomParserException Text) Char)
-> (Char -> StringLiteralParserException)
-> Char
-> ReaderT LetEnv (Parsec CustomParserException Text) Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> StringLiteralParserException
InvalidEscapeSequence
            ]
      stringLiteralFailure :: StringLiteralParserException
-> ReaderT LetEnv (Parsec CustomParserException Text) a
stringLiteralFailure = CustomParserException
-> ReaderT LetEnv (Parsec CustomParserException Text) a
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomParserException
 -> ReaderT LetEnv (Parsec CustomParserException Text) a)
-> (StringLiteralParserException -> CustomParserException)
-> StringLiteralParserException
-> ReaderT LetEnv (Parsec CustomParserException Text) 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' op)
bytesLiteral :: Parser (Value' op)
bytesLiteral = do
  Tokens Text
-> ReaderT LetEnv (Parsec CustomParserException Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"0x"
  Text
hexdigits <- Maybe String
-> (Token Text -> Bool)
-> ReaderT LetEnv (Parsec CustomParserException Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
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' op)
-> (ByteString -> Parser (Value' op))
-> Maybe ByteString
-> Parser (Value' op)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (CustomParserException -> Parser (Value' op)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure CustomParserException
OddNumberBytesException)
    (Value' op -> Parser (Value' op)
forall (m :: * -> *) a. Monad m => a -> m a
return (Value' op -> Parser (Value' op))
-> (ByteString -> Value' op) -> ByteString -> Parser (Value' op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalByteString -> Value' op
forall op. InternalByteString -> Value' op
U.ValueBytes (InternalByteString -> Value' op)
-> (ByteString -> InternalByteString) -> ByteString -> Value' op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> InternalByteString
U.InternalByteString)
    Maybe ByteString
mBytes

intLiteral :: Parser (U.Value' op)
intLiteral :: Parser (Value' op)
intLiteral = Parser (Value' op) -> Parser (Value' op)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser (Value' op) -> Parser (Value' op))
-> Parser (Value' op) -> Parser (Value' op)
forall a b. (a -> b) -> a -> b
$ Integer -> Value' op
forall op. Integer -> Value' op
U.ValueInt (Integer -> Value' op)
-> ReaderT LetEnv (Parsec CustomParserException Text) Integer
-> Parser (Value' op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT LetEnv (Parsec CustomParserException Text) ()
-> ReaderT LetEnv (Parsec CustomParserException Text) Integer
-> ReaderT LetEnv (Parsec CustomParserException Text) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed ReaderT LetEnv (Parsec CustomParserException Text) ()
forall (f :: * -> *). Applicative f => f ()
pass ReaderT LetEnv (Parsec CustomParserException Text) 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 Tokens Text
"Unit" ParsedValue
forall op. Value' op
U.ValueUnit

trueValue :: Parser ParsedValue
trueValue :: Parser ParsedValue
trueValue = Tokens Text -> ParsedValue -> Parser ParsedValue
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"True" ParsedValue
forall op. Value' op
U.ValueTrue

falseValue :: Parser ParsedValue
falseValue :: Parser ParsedValue
falseValue = Tokens Text -> ParsedValue -> Parser ParsedValue
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"False" ParsedValue
forall op. Value' op
U.ValueFalse

pairValueCore :: Parser ParsedOp -> Parser ParsedValue
pairValueCore :: Parser ParsedOp -> Parser ParsedValue
pairValueCore Parser ParsedOp
opParser = Tokens Text
-> ReaderT LetEnv (Parsec CustomParserException Text) ()
symbol Tokens Text
"Pair" ReaderT LetEnv (Parsec CustomParserException Text) ()
-> Parser ParsedValue -> Parser ParsedValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ParsedValue
pairInner
  where
    pairInner :: Parser ParsedValue
pairInner = ParsedValue -> ParsedValue -> ParsedValue
forall op. Value' op -> Value' op -> Value' op
U.ValuePair
      (ParsedValue -> ParsedValue -> ParsedValue)
-> Parser ParsedValue
-> ReaderT
     LetEnv
     (Parsec CustomParserException Text)
     (ParsedValue -> ParsedValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser
      ReaderT
  LetEnv
  (Parsec CustomParserException Text)
  (ParsedValue -> ParsedValue)
-> Parser ParsedValue -> Parser ParsedValue
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 op. Value' op -> Value' op -> Value' op
U.ValuePair (NonEmpty ParsedValue -> ParsedValue)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
-> Parser ParsedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParsedValue
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
forall (f :: * -> *) a. MonadPlus f => f a -> f (NonEmpty a)
some' (Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser))

leftValue :: Parser ParsedOp -> Parser ParsedValue
leftValue :: Parser ParsedOp -> Parser ParsedValue
leftValue Parser ParsedOp
opParser = Tokens Text
-> (ParsedValue -> ParsedValue)
-> ReaderT
     LetEnv
     (Parsec CustomParserException Text)
     (ParsedValue -> ParsedValue)
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"Left" ParsedValue -> ParsedValue
forall op. Value' op -> Value' op
U.ValueLeft ReaderT
  LetEnv
  (Parsec CustomParserException Text)
  (ParsedValue -> ParsedValue)
-> Parser ParsedValue -> Parser ParsedValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser

rightValue :: Parser ParsedOp -> Parser ParsedValue
rightValue :: Parser ParsedOp -> Parser ParsedValue
rightValue Parser ParsedOp
opParser = Tokens Text
-> (ParsedValue -> ParsedValue)
-> ReaderT
     LetEnv
     (Parsec CustomParserException Text)
     (ParsedValue -> ParsedValue)
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"Right" ParsedValue -> ParsedValue
forall op. Value' op -> Value' op
U.ValueRight ReaderT
  LetEnv
  (Parsec CustomParserException Text)
  (ParsedValue -> ParsedValue)
-> Parser ParsedValue -> Parser ParsedValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser

someValue :: Parser ParsedOp -> Parser ParsedValue
someValue :: Parser ParsedOp -> Parser ParsedValue
someValue Parser ParsedOp
opParser = Tokens Text
-> (ParsedValue -> ParsedValue)
-> ReaderT
     LetEnv
     (Parsec CustomParserException Text)
     (ParsedValue -> ParsedValue)
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"Some" ParsedValue -> ParsedValue
forall op. Value' op -> Value' op
U.ValueSome ReaderT
  LetEnv
  (Parsec CustomParserException Text)
  (ParsedValue -> ParsedValue)
-> Parser ParsedValue -> Parser ParsedValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser

noneValue :: Parser ParsedValue
noneValue :: Parser ParsedValue
noneValue = Tokens Text -> ParsedValue -> Parser ParsedValue
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"None" ParsedValue
forall op. Value' op
U.ValueNone

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

lambdaValue :: Parser ParsedOp -> Parser ParsedValue
lambdaValue :: Parser ParsedOp -> Parser ParsedValue
lambdaValue Parser ParsedOp
opParser = NonEmpty ParsedOp -> ParsedValue
forall op. NonEmpty op -> Value' op
U.ValueLambda (NonEmpty ParsedOp -> ParsedValue)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedOp)
-> Parser ParsedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedOp)
ops1
  where
    ops1 :: Parser (NonEmpty ParsedOp)
    ops1 :: ReaderT
  LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedOp)
ops1 = ReaderT
  LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedOp)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedOp)
forall a. Parser a -> Parser a
braces (ReaderT
   LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedOp)
 -> ReaderT
      LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedOp))
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedOp)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedOp)
forall a b. (a -> b) -> a -> b
$ Parser ParsedOp
-> ReaderT LetEnv (Parsec CustomParserException Text) ()
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedOp)
forall (f :: * -> *) a sep.
MonadPlus f =>
f a -> f sep -> f (NonEmpty a)
sepEndBy1 Parser ParsedOp
opParser ReaderT LetEnv (Parsec CustomParserException Text) ()
semicolon

seqValue :: Parser ParsedOp -> Parser ParsedValue
seqValue :: Parser ParsedOp -> Parser ParsedValue
seqValue Parser ParsedOp
opParser =
  NonEmpty ParsedValue -> ParsedValue
forall op. (NonEmpty $ Value' op) -> Value' op
U.ValueSeq (NonEmpty ParsedValue -> ParsedValue)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
-> Parser ParsedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderT
  LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ReaderT
   LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
 -> ReaderT
      LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue))
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
forall a b. (a -> b) -> a -> b
$ ReaderT
  LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
forall a. Parser a -> Parser a
braces (ReaderT
   LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
 -> ReaderT
      LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue))
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
forall a b. (a -> b) -> a -> b
$ Parser ParsedValue
-> ReaderT LetEnv (Parsec CustomParserException Text) ()
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (NonEmpty ParsedValue)
forall (f :: * -> *) a sep.
MonadPlus f =>
f a -> f sep -> f (NonEmpty a)
sepEndBy1 (Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser) ReaderT LetEnv (Parsec CustomParserException Text) ()
semicolon)

eltValue :: Parser ParsedOp -> Parser (U.Elt ParsedOp)
eltValue :: Parser ParsedOp -> Parser (Elt ParsedOp)
eltValue Parser ParsedOp
opParser = Tokens Text
-> (ParsedValue -> ParsedValue -> Elt ParsedOp)
-> Parser (ParsedValue -> ParsedValue -> Elt ParsedOp)
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"Elt" ParsedValue -> ParsedValue -> Elt ParsedOp
forall op. Value' op -> Value' op -> Elt op
U.Elt Parser (ParsedValue -> ParsedValue -> Elt ParsedOp)
-> Parser ParsedValue
-> ReaderT
     LetEnv
     (Parsec CustomParserException Text)
     (ParsedValue -> Elt ParsedOp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser ReaderT
  LetEnv
  (Parsec CustomParserException Text)
  (ParsedValue -> Elt ParsedOp)
-> Parser ParsedValue -> Parser (Elt ParsedOp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser

mapValue :: Parser ParsedOp -> Parser ParsedValue
mapValue :: Parser ParsedOp -> Parser ParsedValue
mapValue Parser ParsedOp
opParser =
  (NonEmpty $ Elt ParsedOp) -> ParsedValue
forall op. (NonEmpty $ Elt op) -> Value' op
U.ValueMap ((NonEmpty $ Elt ParsedOp) -> ParsedValue)
-> ReaderT
     LetEnv
     (Parsec CustomParserException Text)
     (NonEmpty $ Elt ParsedOp)
-> Parser ParsedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderT
  LetEnv
  (Parsec CustomParserException Text)
  (NonEmpty $ Elt ParsedOp)
-> ReaderT
     LetEnv
     (Parsec CustomParserException Text)
     (NonEmpty $ Elt ParsedOp)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ReaderT
   LetEnv
   (Parsec CustomParserException Text)
   (NonEmpty $ Elt ParsedOp)
 -> ReaderT
      LetEnv
      (Parsec CustomParserException Text)
      (NonEmpty $ Elt ParsedOp))
-> ReaderT
     LetEnv
     (Parsec CustomParserException Text)
     (NonEmpty $ Elt ParsedOp)
-> ReaderT
     LetEnv
     (Parsec CustomParserException Text)
     (NonEmpty $ Elt ParsedOp)
forall a b. (a -> b) -> a -> b
$ ReaderT
  LetEnv
  (Parsec CustomParserException Text)
  (NonEmpty $ Elt ParsedOp)
-> ReaderT
     LetEnv
     (Parsec CustomParserException Text)
     (NonEmpty $ Elt ParsedOp)
forall a. Parser a -> Parser a
braces (ReaderT
   LetEnv
   (Parsec CustomParserException Text)
   (NonEmpty $ Elt ParsedOp)
 -> ReaderT
      LetEnv
      (Parsec CustomParserException Text)
      (NonEmpty $ Elt ParsedOp))
-> ReaderT
     LetEnv
     (Parsec CustomParserException Text)
     (NonEmpty $ Elt ParsedOp)
-> ReaderT
     LetEnv
     (Parsec CustomParserException Text)
     (NonEmpty $ Elt ParsedOp)
forall a b. (a -> b) -> a -> b
$ Parser (Elt ParsedOp)
-> ReaderT LetEnv (Parsec CustomParserException Text) ()
-> ReaderT
     LetEnv
     (Parsec CustomParserException Text)
     (NonEmpty $ Elt ParsedOp)
forall (f :: * -> *) a sep.
MonadPlus f =>
f a -> f sep -> f (NonEmpty a)
sepEndBy1 (Parser ParsedOp -> Parser (Elt ParsedOp)
eltValue Parser ParsedOp
opParser) ReaderT LetEnv (Parsec CustomParserException Text) ()
semicolon)

dataLetValue :: Parser ParsedValue
dataLetValue :: Parser ParsedValue
dataLetValue = do
  Map Text LetValue
lvs <- (LetEnv -> Map Text LetValue)
-> ReaderT
     LetEnv (Parsec CustomParserException Text) (Map Text LetValue)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks LetEnv -> Map Text LetValue
letValues
  LetValue -> ParsedValue
lvVal (LetValue -> ParsedValue)
-> ReaderT LetEnv (Parsec CustomParserException Text) LetValue
-> Parser ParsedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map Text LetValue
-> ReaderT LetEnv (Parsec CustomParserException Text) LetValue
mkLetVal Map Text LetValue
lvs)

mkLetVal :: Map Text LetValue -> Parser LetValue
mkLetVal :: Map Text LetValue
-> ReaderT LetEnv (Parsec CustomParserException Text) LetValue
mkLetVal Map Text LetValue
lvs = [ReaderT LetEnv (Parsec CustomParserException Text) LetValue]
-> ReaderT LetEnv (Parsec CustomParserException Text) LetValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ReaderT LetEnv (Parsec CustomParserException Text) LetValue]
 -> ReaderT LetEnv (Parsec CustomParserException Text) LetValue)
-> [ReaderT LetEnv (Parsec CustomParserException Text) LetValue]
-> ReaderT LetEnv (Parsec CustomParserException Text) LetValue
forall a b. (a -> b) -> a -> b
$ (LetValue -> Text)
-> LetValue
-> ReaderT LetEnv (Parsec CustomParserException Text) LetValue
forall a. (a -> Text) -> a -> Parser a
mkParser LetValue -> Text
lvName (LetValue
 -> ReaderT LetEnv (Parsec CustomParserException Text) LetValue)
-> [LetValue]
-> [ReaderT LetEnv (Parsec CustomParserException Text) LetValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text LetValue -> [LetValue]
forall k a. Map k a -> [a]
Map.elems Map Text LetValue
lvs