-- 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, 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 ParsedOp -> Parser ParsedValue
value' :: Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser = 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
$ Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser

valueInnerWithoutParens :: Parser ParsedOp -> Parser ParsedValue
valueInnerWithoutParens :: Parser ParsedOp -> Parser ParsedValue
valueInnerWithoutParens Parser ParsedOp
opParser = [Char] -> Parser ParsedValue -> Parser ParsedValue
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 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
  ]

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 = 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 op. MText -> Value' 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
  Text
_ <- ParsecT CustomParserException Text Identity Text
-> ParsecT CustomParserException Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomParserException Text Identity Text
 -> ParsecT CustomParserException Text Identity Text)
-> ParsecT CustomParserException Text Identity Text
-> ParsecT CustomParserException Text Identity 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 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
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 (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 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 (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
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 (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' op)
bytesLiteral :: forall op. Parser (Value' op)
bytesLiteral = Parser (Value' op) -> Parser (Value' op)
forall a. Parser a -> Parser a
lexeme (Parser (Value' op) -> Parser (Value' op))
-> Parser (Value' op) -> Parser (Value' 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' 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 :: forall op. Parser (Value' op)
intLiteral = Parser (Value' op) -> Parser (Value' op)
forall a. Parser a -> Parser a
lexeme (Parser (Value' op) -> Parser (Value' op))
-> Parser (Value' op) -> Parser (Value' op)
forall a b. (a -> b) -> a -> b
$ 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)
-> ParsecT CustomParserException Text Identity Integer
-> Parser (Value' 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 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 -> ParsecT CustomParserException Text Identity ()
symbol1 Tokens Text
"Pair" ParsecT CustomParserException Text Identity ()
-> 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
-> ParsecT
     CustomParserException Text Identity (ParsedValue -> ParsedValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser
      ParsecT
  CustomParserException Text Identity (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)
-> 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 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)
-> ParsecT
     CustomParserException Text Identity (ParsedValue -> ParsedValue)
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"Left" ParsedValue -> ParsedValue
forall op. Value' op -> Value' op
U.ValueLeft ParsecT
  CustomParserException Text Identity (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)
-> ParsecT
     CustomParserException Text Identity (ParsedValue -> ParsedValue)
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"Right" ParsedValue -> ParsedValue
forall op. Value' op -> Value' op
U.ValueRight ParsecT
  CustomParserException Text Identity (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)
-> ParsecT
     CustomParserException Text Identity (ParsedValue -> ParsedValue)
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"Some" ParsedValue -> ParsedValue
forall op. Value' op -> Value' op
U.ValueSome ParsecT
  CustomParserException Text Identity (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
-> ParsecT CustomParserException Text Identity ()
-> Parser ParsedValue
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity ()
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 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)
-> ParsecT CustomParserException Text Identity (NonEmpty ParsedOp)
-> Parser ParsedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomParserException Text Identity (NonEmpty ParsedOp)
ops1
  where
    ops1 :: Parser (NonEmpty ParsedOp)
    ops1 :: ParsecT CustomParserException Text Identity (NonEmpty ParsedOp)
ops1 = ParsecT CustomParserException Text Identity (NonEmpty ParsedOp)
-> ParsecT CustomParserException Text Identity (NonEmpty ParsedOp)
forall a. Parser a -> Parser a
braces (ParsecT CustomParserException Text Identity (NonEmpty ParsedOp)
 -> ParsecT CustomParserException Text Identity (NonEmpty ParsedOp))
-> ParsecT CustomParserException Text Identity (NonEmpty ParsedOp)
-> ParsecT CustomParserException Text Identity (NonEmpty ParsedOp)
forall a b. (a -> b) -> a -> b
$ Parser ParsedOp
-> ParsecT CustomParserException Text Identity ()
-> ParsecT CustomParserException Text Identity (NonEmpty ParsedOp)
forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
sepEndBy1 Parser ParsedOp
opParser ParsecT CustomParserException Text Identity ()
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)
-> 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 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 ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser) ParsecT CustomParserException Text Identity ()
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
-> ParsecT
     CustomParserException Text Identity (ParsedValue -> Elt ParsedOp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ParsedOp -> Parser ParsedValue
value' Parser ParsedOp
opParser ParsecT
  CustomParserException Text Identity (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)
-> ParsecT
     CustomParserException Text Identity (NonEmpty $ Elt ParsedOp)
-> Parser ParsedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT
  CustomParserException Text Identity (NonEmpty $ Elt ParsedOp)
-> ParsecT
     CustomParserException Text Identity (NonEmpty $ Elt ParsedOp)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT
   CustomParserException Text Identity (NonEmpty $ Elt ParsedOp)
 -> ParsecT
      CustomParserException Text Identity (NonEmpty $ Elt ParsedOp))
-> ParsecT
     CustomParserException Text Identity (NonEmpty $ Elt ParsedOp)
-> ParsecT
     CustomParserException Text Identity (NonEmpty $ Elt ParsedOp)
forall a b. (a -> b) -> a -> b
$ ParsecT
  CustomParserException Text Identity (NonEmpty $ Elt ParsedOp)
-> ParsecT
     CustomParserException Text Identity (NonEmpty $ Elt ParsedOp)
forall a. Parser a -> Parser a
braces (ParsecT
   CustomParserException Text Identity (NonEmpty $ Elt ParsedOp)
 -> ParsecT
      CustomParserException Text Identity (NonEmpty $ Elt ParsedOp))
-> ParsecT
     CustomParserException Text Identity (NonEmpty $ Elt ParsedOp)
-> ParsecT
     CustomParserException Text Identity (NonEmpty $ Elt ParsedOp)
forall a b. (a -> b) -> a -> b
$ Parser (Elt ParsedOp)
-> ParsecT CustomParserException Text Identity ()
-> ParsecT
     CustomParserException Text Identity (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) ParsecT CustomParserException Text Identity ()
semicolon)