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

-- TODO [#712]: Remove this next major release
{-# OPTIONS_GHC -Wno-deprecations #-}

-- TODO [#712]: Remove this next major release
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | 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 Data.Char qualified as Char
import Data.Map qualified as Map
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.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 (LetEnv, Parser, Parser', isLetEnv, letValues, withLetEnv)
import Morley.Michelson.Text (isMChar, mkMText)
import Morley.Michelson.Untyped qualified 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 le ParsedOp -> Parser le ParsedValue
value' :: Parser le ParsedOp -> Parser le ParsedValue
value' Parser le ParsedOp
opParser = Parser le ParsedOp -> Parser le ParsedValue
forall le. Parser le ParsedOp -> Parser le ParsedValue
parensOrTuple Parser le ParsedOp
opParser Parser' le ParsedValue
-> Parser' le ParsedValue -> Parser' le ParsedValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser le ParsedOp -> Parser le ParsedValue
forall le. Parser le ParsedOp -> Parser le ParsedValue
valueInnerWithoutParens Parser le ParsedOp
opParser

parensOrTuple :: forall le. Parser le ParsedOp -> Parser le ParsedValue
parensOrTuple :: Parser le ParsedOp -> Parser le ParsedValue
parensOrTuple Parser le ParsedOp
opParser = Parser le ParsedValue -> Parser le ParsedValue
forall le a. Parser le a -> Parser le a
parens (Parser le ParsedValue -> Parser le ParsedValue)
-> Parser le ParsedValue -> Parser le ParsedValue
forall a b. (a -> b) -> a -> b
$
  case HasLetEnv le => Maybe (le :~: LetEnv)
forall a. HasLetEnv a => Maybe (a :~: LetEnv)
isLetEnv @le of
    Just{} -> (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
     le (Parsec CustomParserException Text) (NonEmpty ParsedValue)
-> Parser' le ParsedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser le ParsedOp -> Parser le ParsedValue
forall le. Parser le ParsedOp -> Parser le ParsedValue
value' Parser le ParsedOp
opParser Parser' le ParsedValue
-> ReaderT le (Parsec CustomParserException Text) ()
-> ReaderT
     le (Parsec CustomParserException Text) (NonEmpty ParsedValue)
forall (f :: * -> *) a sep.
MonadPlus f =>
f a -> f sep -> f (NonEmpty a)
`sepBy1` ReaderT le (Parsec CustomParserException Text) ()
forall le. Parser le ()
comma
    Maybe (le :~: LetEnv)
Nothing -> Parser le ParsedOp -> Parser le ParsedValue
forall le. Parser le ParsedOp -> Parser le ParsedValue
value' Parser le ParsedOp
opParser

valueInnerWithoutParens :: Parser le ParsedOp -> Parser le ParsedValue
valueInnerWithoutParens :: Parser le ParsedOp -> Parser le ParsedValue
valueInnerWithoutParens Parser le ParsedOp
opParser = String
-> ReaderT le (Parsec CustomParserException Text) ParsedValue
-> ReaderT le (Parsec CustomParserException Text) ParsedValue
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"value" (ReaderT le (Parsec CustomParserException Text) ParsedValue
 -> ReaderT le (Parsec CustomParserException Text) ParsedValue)
-> ReaderT le (Parsec CustomParserException Text) ParsedValue
-> ReaderT le (Parsec CustomParserException Text) ParsedValue
forall a b. (a -> b) -> a -> b
$ [ReaderT le (Parsec CustomParserException Text) ParsedValue]
-> ReaderT le (Parsec CustomParserException Text) ParsedValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ReaderT le (Parsec CustomParserException Text) ParsedValue]
 -> ReaderT le (Parsec CustomParserException Text) ParsedValue)
-> [ReaderT le (Parsec CustomParserException Text) ParsedValue]
-> ReaderT le (Parsec CustomParserException Text) ParsedValue
forall a b. (a -> b) -> a -> b
$
  [ ReaderT le (Parsec CustomParserException Text) ParsedValue
forall le. Parser le ParsedValue
stringLiteral, ReaderT le (Parsec CustomParserException Text) ParsedValue
forall le op. Parser le (Value' op)
bytesLiteral, ReaderT le (Parsec CustomParserException Text) ParsedValue
forall le op. Parser le (Value' op)
intLiteral, ReaderT le (Parsec CustomParserException Text) ParsedValue
forall le. Parser le ParsedValue
unitValue
  , ReaderT le (Parsec CustomParserException Text) ParsedValue
forall le. Parser le ParsedValue
trueValue, ReaderT le (Parsec CustomParserException Text) ParsedValue
forall le. Parser le ParsedValue
falseValue, Parser le ParsedOp -> Parser le ParsedValue
forall le. Parser le ParsedOp -> Parser le ParsedValue
pairValueCore Parser le ParsedOp
opParser, Parser le ParsedOp -> Parser le ParsedValue
forall le. Parser le ParsedOp -> Parser le ParsedValue
leftValue Parser le ParsedOp
opParser
  , Parser le ParsedOp -> Parser le ParsedValue
forall le. Parser le ParsedOp -> Parser le ParsedValue
rightValue Parser le ParsedOp
opParser, Parser le ParsedOp -> Parser le ParsedValue
forall le. Parser le ParsedOp -> Parser le ParsedValue
someValue Parser le ParsedOp
opParser, ReaderT le (Parsec CustomParserException Text) ParsedValue
forall le. Parser le ParsedValue
noneValue, ReaderT le (Parsec CustomParserException Text) ParsedValue
forall le. Parser le ParsedValue
nilValue
  , Parser le ParsedOp -> Parser le ParsedValue
forall le. Parser le ParsedOp -> Parser le ParsedValue
seqOrLambda Parser le ParsedOp
opParser, Parser le ParsedOp -> Parser le ParsedValue
forall le. Parser le ParsedOp -> Parser le ParsedValue
mapValue Parser le ParsedOp
opParser, Parser' LetEnv ParsedValue -> Parser le ParsedValue
forall le a. Parser' LetEnv a -> Parser le a
withLetEnv Parser' LetEnv ParsedValue
dataLetValue
  ]

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

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

      strEscape :: Parser le Char
      strEscape :: ReaderT le (Parsec CustomParserException Text) Char
strEscape = ReaderT le (Parsec CustomParserException Text) Char
-> ReaderT le (Parsec CustomParserException Text) Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Token Text
-> ReaderT le (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 le (Parsec CustomParserException Text) Char
-> ReaderT le (Parsec CustomParserException Text) Char
-> ReaderT le (Parsec CustomParserException Text) Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT le (Parsec CustomParserException Text) Char
esc
        where
          esc :: ReaderT le (Parsec CustomParserException Text) Char
esc = [ReaderT le (Parsec CustomParserException Text) Char]
-> ReaderT le (Parsec CustomParserException Text) Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
            [ Token Text
-> ReaderT le (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 le (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 le (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 le (Parsec CustomParserException Text) Char
-> Char -> ReaderT le (Parsec CustomParserException Text) Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\n'
            , ReaderT le (Parsec CustomParserException Text) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ReaderT le (Parsec CustomParserException Text) Char
-> (Char -> ReaderT le (Parsec CustomParserException Text) Char)
-> ReaderT le (Parsec CustomParserException Text) Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StringLiteralParserException
-> ReaderT le (Parsec CustomParserException Text) Char
forall a.
StringLiteralParserException
-> ReaderT le (Parsec CustomParserException Text) a
stringLiteralFailure (StringLiteralParserException
 -> ReaderT le (Parsec CustomParserException Text) Char)
-> (Char -> StringLiteralParserException)
-> Char
-> ReaderT le (Parsec CustomParserException Text) Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> StringLiteralParserException
InvalidEscapeSequence
            ]
      stringLiteralFailure :: StringLiteralParserException
-> ReaderT le (Parsec CustomParserException Text) a
stringLiteralFailure = CustomParserException
-> ReaderT le (Parsec CustomParserException Text) a
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomParserException
 -> ReaderT le (Parsec CustomParserException Text) a)
-> (StringLiteralParserException -> CustomParserException)
-> StringLiteralParserException
-> ReaderT le (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 le (U.Value' op)
bytesLiteral :: Parser' le (Value' op)
bytesLiteral = Parser le (Value' op) -> Parser le (Value' op)
forall le a. Parser le a -> Parser le a
lexeme (Parser le (Value' op) -> Parser le (Value' op))
-> Parser le (Value' op) -> Parser le (Value' op)
forall a b. (a -> b) -> a -> b
$ do
  Tokens Text
-> ReaderT le (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 le (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' le (Value' op)
-> (ByteString -> Parser' le (Value' op))
-> Maybe ByteString
-> Parser' le (Value' op)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (CustomParserException -> Parser' le (Value' op)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure CustomParserException
OddNumberBytesException)
    (Value' op -> Parser' le (Value' op)
forall (m :: * -> *) a. Monad m => a -> m a
return (Value' op -> Parser' le (Value' op))
-> (ByteString -> Value' op)
-> ByteString
-> Parser' le (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 le (U.Value' op)
intLiteral :: Parser' le (Value' op)
intLiteral = Parser le (Value' op) -> Parser le (Value' op)
forall le a. Parser le a -> Parser le a
lexeme (Parser le (Value' op) -> Parser le (Value' op))
-> Parser le (Value' op) -> Parser le (Value' op)
forall a b. (a -> b) -> a -> b
$ Parser' le (Value' op) -> Parser' le (Value' op)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser' le (Value' op) -> Parser' le (Value' op))
-> Parser' le (Value' op) -> Parser' le (Value' op)
forall a b. (a -> b) -> a -> b
$ Integer -> Value' op
forall op. Integer -> Value' op
U.ValueInt (Integer -> Value' op)
-> ReaderT le (Parsec CustomParserException Text) Integer
-> Parser' le (Value' op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) ()
-> ReaderT le (Parsec CustomParserException Text) Integer
-> ReaderT le (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 le (Parsec CustomParserException Text) ()
forall (f :: * -> *). Applicative f => f ()
pass ReaderT le (Parsec CustomParserException Text) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal

unitValue :: Parser le ParsedValue
unitValue :: Parser' le ParsedValue
unitValue = Tokens Text -> ParsedValue -> Parser le ParsedValue
forall a le. Tokens Text -> a -> Parser le a
word Tokens Text
"Unit" ParsedValue
forall op. Value' op
U.ValueUnit

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

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

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

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

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

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

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

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

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

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

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

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

dataLetValue :: Parser' LetEnv ParsedValue
dataLetValue :: Parser' LetEnv 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' LetEnv ParsedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map Text LetValue -> Parser LetEnv LetValue
forall le. Map Text LetValue -> Parser le LetValue
mkLetVal Map Text LetValue
lvs)

mkLetVal :: Map Text LetValue -> Parser le LetValue
mkLetVal :: Map Text LetValue -> Parser le LetValue
mkLetVal Map Text LetValue
lvs = [ReaderT le (Parsec CustomParserException Text) LetValue]
-> ReaderT le (Parsec CustomParserException Text) LetValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ReaderT le (Parsec CustomParserException Text) LetValue]
 -> ReaderT le (Parsec CustomParserException Text) LetValue)
-> [ReaderT le (Parsec CustomParserException Text) LetValue]
-> ReaderT le (Parsec CustomParserException Text) LetValue
forall a b. (a -> b) -> a -> b
$ (LetValue -> Text) -> LetValue -> Parser le LetValue
forall a le. (a -> Text) -> a -> Parser le a
mkParser LetValue -> Text
lvName (LetValue
 -> ReaderT le (Parsec CustomParserException Text) LetValue)
-> [LetValue]
-> [ReaderT le (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