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

-- | Parsing of untyped Michelson values.

module Michelson.Parser.Value
  ( value'
  , mkLetVal

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

import Prelude hiding (many, note, some, 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, manyTill, satisfy, takeWhileP, try)
import Text.Megaparsec.Char (char, string)
import qualified Text.Megaparsec.Char.Lexer as L

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

-- | 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' opParser :: 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 ParsedValue -> Parser ParsedValue
forall a. Parser a -> Parser a
mparens Parser ParsedValue
valueInner'
  where
    valueInner' :: Parser ParsedValue
valueInner' = Parser ParsedOp -> Parser ParsedValue
valueInner Parser ParsedOp
opParser

valueInner :: Parser ParsedOp -> Parser ParsedValue
valueInner :: Parser ParsedOp -> Parser ParsedValue
valueInner opParser :: Parser ParsedOp
opParser = [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
pairValue 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 opParser :: 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)
-> ([Char] -> MText) -> [Char] -> ParsedValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> MText
Text -> MText
mkMTextUnsafe (Text -> MText) -> ([Char] -> Text) -> [Char] -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
forall a. ToText a => a -> Text
toText ([Char] -> ParsedValue)
-> ReaderT LetEnv (Parsec CustomParserException Text) [Char]
-> 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 "\""
  ReaderT LetEnv (Parsec CustomParserException Text) Char
-> ReaderT LetEnv (Parsec CustomParserException Text) Text
-> ReaderT LetEnv (Parsec CustomParserException Text) [Char]
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 "\"")
  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 (\x :: Token Text
x -> Char
Token Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '"' Bool -> Bool -> Bool
&& 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 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 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 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 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
$> '\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 "0x"
  Text
hexdigits <- Maybe [Char]
-> (Token Text -> Bool)
-> ReaderT LetEnv (Parsec CustomParserException Text) (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' 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 "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 "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 "False" ParsedValue
forall op. Value' op
U.ValueFalse

pairValue :: Parser ParsedOp -> Parser ParsedValue
pairValue :: Parser ParsedOp -> Parser ParsedValue
pairValue opParser :: Parser ParsedOp
opParser = Parser ParsedValue
core Parser ParsedValue -> Parser ParsedValue -> Parser ParsedValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParsedValue
tuple
  where
    core :: Parser ParsedValue
core = Tokens Text
-> ReaderT LetEnv (Parsec CustomParserException Text) ()
symbol "Pair" ReaderT LetEnv (Parsec CustomParserException Text) ()
-> Parser ParsedValue -> Parser ParsedValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT LetEnv (Parsec CustomParserException Text) ()
-> Parser ParsedValue
tupleInner ReaderT LetEnv (Parsec CustomParserException Text) ()
forall (f :: * -> *). Applicative f => f ()
pass
    tuple :: Parser ParsedValue
tuple = Parser ParsedValue -> Parser ParsedValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser ParsedValue -> Parser ParsedValue)
-> Parser ParsedValue -> Parser ParsedValue
forall a b. (a -> b) -> a -> b
$ Parser ParsedValue -> Parser ParsedValue
forall a. Parser a -> Parser a
parens (ReaderT LetEnv (Parsec CustomParserException Text) ()
-> Parser ParsedValue
tupleInner ReaderT LetEnv (Parsec CustomParserException Text) ()
comma)

    tupleInner :: Parser () -> Parser ParsedValue
    tupleInner :: ReaderT LetEnv (Parsec CustomParserException Text) ()
-> Parser ParsedValue
tupleInner sep :: ReaderT LetEnv (Parsec CustomParserException Text) ()
sep = Parser ParsedValue -> Parser ParsedValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser ParsedValue -> Parser ParsedValue)
-> Parser ParsedValue -> Parser ParsedValue
forall a b. (a -> b) -> a -> b
$ do
      ParsedValue
a <- Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser
      ReaderT LetEnv (Parsec CustomParserException Text) ()
sep
      ParsedValue
b <- ReaderT LetEnv (Parsec CustomParserException Text) ()
-> Parser ParsedValue
tupleInner ReaderT LetEnv (Parsec CustomParserException Text) ()
sep Parser ParsedValue -> Parser ParsedValue -> Parser ParsedValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser
      return $ ParsedValue -> ParsedValue -> ParsedValue
forall op. Value' op -> Value' op -> Value' op
U.ValuePair ParsedValue
a ParsedValue
b

leftValue :: Parser ParsedOp -> Parser ParsedValue
leftValue :: Parser ParsedOp -> Parser ParsedValue
leftValue opParser :: Parser ParsedOp
opParser = Tokens Text
-> (ParsedValue -> ParsedValue)
-> Parser (ParsedValue -> ParsedValue)
forall a. Tokens Text -> a -> Parser a
word "Left" ParsedValue -> ParsedValue
forall op. Value' op -> Value' op
U.ValueLeft Parser (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 opParser :: Parser ParsedOp
opParser = Tokens Text
-> (ParsedValue -> ParsedValue)
-> Parser (ParsedValue -> ParsedValue)
forall a. Tokens Text -> a -> Parser a
word "Right" ParsedValue -> ParsedValue
forall op. Value' op -> Value' op
U.ValueRight Parser (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 opParser :: Parser ParsedOp
opParser = Tokens Text
-> (ParsedValue -> ParsedValue)
-> Parser (ParsedValue -> ParsedValue)
forall a. Tokens Text -> a -> Parser a
word "Some" ParsedValue -> ParsedValue
forall op. Value' op -> Value' op
U.ValueSome Parser (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 "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 opParser :: 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 (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
sepEndBy1 Parser ParsedOp
opParser ReaderT LetEnv (Parsec CustomParserException Text) ()
semicolon

seqValue :: Parser ParsedOp -> Parser ParsedValue
seqValue :: Parser ParsedOp -> Parser ParsedValue
seqValue opParser :: 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 (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (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 opParser :: Parser ParsedOp
opParser = Tokens Text
-> (ParsedValue -> ParsedValue -> Elt ParsedOp)
-> Parser (ParsedValue -> ParsedValue -> Elt ParsedOp)
forall a. Tokens Text -> a -> Parser a
word "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 opParser :: 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 (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (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 lvs :: 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