{-# LANGUAGE OverloadedStrings #-}

-- | Internal module for parsing string based directives inside of curl runnings
-- suites. Use this module at your own risk, it may change. Currently, string
-- interpolation can be performed, where interpolated values are json quries
-- into responses from past test cases.
--
-- > "$<RESPONSES[0].key[0].another_key>"
--
-- here the `RESPONSES` keyword references the results of previous test cases. Here, the
-- whole string is a query, so if the value referenced by this query is itself a
-- json value, the entire value will replace this string in a json matcher.
-- Additionally, interpolation of the form:
--
-- >
-- > "some text to interpolate with $<RESPONSES[0].key.key>"
-- >
--
-- will substitute a string found at the specified query
-- and subsitute the string.
--
-- Rules for the language are similar to JQ or regular JSON indexing rules. All
-- queries must start with a RESPONSES[integer] index, and be written between a
--
-- >
-- >  $< ... >
-- >
--
-- to signify an interpolation. You can have mutliple queries inside a
-- single string, but if interpolation is occuring, then the query specified
-- must resolve to a string value. Otheriwse, a type error will be thrown.
module Testing.CurlRunnings.Internal.Parser
    (
      parseQuery
    ) where

import           Data.Bifunctor             (Bifunctor (..))
import           Data.Char                  (isAscii)
import           Data.List
import qualified Data.Text                  as T
import           Data.Void
import           Testing.CurlRunnings.Types
import           Text.Megaparsec
import           Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L

-- | Given some query text, attempt to parse it to a list of interplated query objects. This data representation may change.
parseQuery :: FullQueryText -> Either QueryError [InterpolatedQuery]
parseQuery :: FullQueryText -> Either QueryError [InterpolatedQuery]
parseQuery FullQueryText
q =
  let trimmed :: FullQueryText
trimmed = FullQueryText -> FullQueryText
T.strip FullQueryText
q
  in case Parsec Void FullQueryText [InterpolatedQuery]
-> String
-> FullQueryText
-> Either (ParseErrorBundle FullQueryText Void) [InterpolatedQuery]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Text.Megaparsec.parse Parsec Void FullQueryText [InterpolatedQuery]
parseFullTextWithQuery String
"" FullQueryText
trimmed of
       Right [InterpolatedQuery]
a -> [InterpolatedQuery] -> Either QueryError [InterpolatedQuery]
forall a b. b -> Either a b
Right [InterpolatedQuery]
a Either QueryError [InterpolatedQuery]
-> ([InterpolatedQuery] -> Either QueryError [InterpolatedQuery])
-> Either QueryError [InterpolatedQuery]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [InterpolatedQuery] -> Either QueryError [InterpolatedQuery]
validateQuery
       Left ParseErrorBundle FullQueryText Void
a  -> QueryError -> Either QueryError [InterpolatedQuery]
forall a b. a -> Either a b
Left (QueryError -> Either QueryError [InterpolatedQuery])
-> QueryError -> Either QueryError [InterpolatedQuery]
forall a b. (a -> b) -> a -> b
$ FullQueryText -> FullQueryText -> QueryError
QueryParseError (String -> FullQueryText
T.pack (String -> FullQueryText) -> String -> FullQueryText
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle FullQueryText Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle FullQueryText Void
a) FullQueryText
q

-- | Once we have parsed a query successfully, ensure that it is a legal query
validateQuery :: [InterpolatedQuery] -> Either QueryError [InterpolatedQuery]
-- If we have a json indexing query, it needs to start by indexing the special
-- RESPONSES array
validateQuery :: [InterpolatedQuery] -> Either QueryError [InterpolatedQuery]
validateQuery q :: [InterpolatedQuery]
q@(InterpolatedQuery FullQueryText
_ (Query (CaseResultIndex Integer
_:[Index]
_)):[InterpolatedQuery]
_) = [InterpolatedQuery] -> Either QueryError [InterpolatedQuery]
forall a b. b -> Either a b
Right [InterpolatedQuery]
q
validateQuery q :: [InterpolatedQuery]
q@(NonInterpolatedQuery  (Query (CaseResultIndex Integer
_:[Index]
_)):[InterpolatedQuery]
_) = [InterpolatedQuery] -> Either QueryError [InterpolatedQuery]
forall a b. b -> Either a b
Right [InterpolatedQuery]
q
-- If the RESPONSES array is not indexed, it's not valid, as we don't know which
-- response to look at
validateQuery (InterpolatedQuery FullQueryText
_ (Query  [Index]
_):[InterpolatedQuery]
_) = QueryError -> Either QueryError [InterpolatedQuery]
forall a b. a -> Either a b
Left (QueryError -> Either QueryError [InterpolatedQuery])
-> QueryError -> Either QueryError [InterpolatedQuery]
forall a b. (a -> b) -> a -> b
$ FullQueryText -> QueryError
QueryValidationError FullQueryText
"JSON interpolation must begin by indexing into RESPONSES"
validateQuery (NonInterpolatedQuery (Query [Index]
_):[InterpolatedQuery]
_) = QueryError -> Either QueryError [InterpolatedQuery]
forall a b. a -> Either a b
Left (QueryError -> Either QueryError [InterpolatedQuery])
-> QueryError -> Either QueryError [InterpolatedQuery]
forall a b. (a -> b) -> a -> b
$ FullQueryText -> QueryError
QueryValidationError FullQueryText
"JSON interpolation must begin by indexing into RESPONSES"
-- Otherwise, we're good!
validateQuery [InterpolatedQuery]
q = [InterpolatedQuery] -> Either QueryError [InterpolatedQuery]
forall a b. b -> Either a b
Right [InterpolatedQuery]
q

type Parser = Parsec Void T.Text

parseSuiteIndex' :: Parser Index
parseSuiteIndex' :: Parser Index
parseSuiteIndex' = do
  ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT Void FullQueryText Identity FullQueryText
gtlt
  FullQueryText
_ <- Tokens FullQueryText
-> ParsecT Void FullQueryText Identity (Tokens FullQueryText)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens FullQueryText
"RESPONSES" ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens FullQueryText
-> ParsecT Void FullQueryText Identity (Tokens FullQueryText)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens FullQueryText
"SUITE"
  (ArrayIndex Integer
i) <- Parser Index
arrayIndexParser
  Index -> Parser Index
forall (m :: * -> *) a. Monad m => a -> m a
return (Index -> Parser Index) -> Index -> Parser Index
forall a b. (a -> b) -> a -> b
$ Integer -> Index
CaseResultIndex Integer
i

spaceOrDot :: Parser ()
spaceOrDot :: ParsecT Void FullQueryText Identity ()
spaceOrDot = (ParsecT Void FullQueryText Identity ()
-> ParsecT Void FullQueryText Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void FullQueryText Identity ()
 -> ParsecT Void FullQueryText Identity ())
-> ParsecT Void FullQueryText Identity ()
-> ParsecT Void FullQueryText Identity ()
forall a b. (a -> b) -> a -> b
$ Token FullQueryText
-> ParsecT Void FullQueryText Identity (Token FullQueryText)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token FullQueryText
'.' ParsecT Void FullQueryText Identity Char
-> ParsecT Void FullQueryText Identity ()
-> ParsecT Void FullQueryText Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void FullQueryText Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) ParsecT Void FullQueryText Identity ()
-> ParsecT Void FullQueryText Identity ()
-> ParsecT Void FullQueryText Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void FullQueryText Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

lexeme :: Parser a -> Parser a
lexeme :: Parser a -> Parser a
lexeme = ParsecT Void FullQueryText Identity () -> Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void FullQueryText Identity ()
spaceOrDot

symbol :: T.Text -> Parser T.Text
symbol :: FullQueryText -> ParsecT Void FullQueryText Identity FullQueryText
symbol = ParsecT Void FullQueryText Identity ()
-> Tokens FullQueryText
-> ParsecT Void FullQueryText Identity (Tokens FullQueryText)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol ParsecT Void FullQueryText Identity ()
spaceOrDot

inGTLT :: Parser a -> Parser a
inGTLT :: Parser a -> Parser a
inGTLT = ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
-> Parser a
-> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (FullQueryText -> ParsecT Void FullQueryText Identity FullQueryText
symbol FullQueryText
"$<") (Tokens FullQueryText
-> ParsecT Void FullQueryText Identity (Tokens FullQueryText)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens FullQueryText
">")

gtlt :: Parser T.Text
gtlt :: ParsecT Void FullQueryText Identity FullQueryText
gtlt = FullQueryText -> ParsecT Void FullQueryText Identity FullQueryText
symbol FullQueryText
"<" ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FullQueryText -> ParsecT Void FullQueryText Identity FullQueryText
symbol FullQueryText
">"

brackets :: Parser a -> Parser a
brackets :: Parser a -> Parser a
brackets = ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
-> Parser a
-> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (FullQueryText -> ParsecT Void FullQueryText Identity FullQueryText
symbol FullQueryText
"[") (FullQueryText -> ParsecT Void FullQueryText Identity FullQueryText
symbol FullQueryText
"]")

bracket :: Parser T.Text
bracket :: ParsecT Void FullQueryText Identity FullQueryText
bracket = FullQueryText -> ParsecT Void FullQueryText Identity FullQueryText
symbol FullQueryText
"[" ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FullQueryText -> ParsecT Void FullQueryText Identity FullQueryText
symbol FullQueryText
"]"

braces ::  Parser a -> Parser a
braces :: Parser a -> Parser a
braces = ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
-> Parser a
-> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (FullQueryText -> ParsecT Void FullQueryText Identity FullQueryText
symbol FullQueryText
"${") (Tokens FullQueryText
-> ParsecT Void FullQueryText Identity (Tokens FullQueryText)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens FullQueryText
"}")

brace :: Parser T.Text
brace :: ParsecT Void FullQueryText Identity FullQueryText
brace = FullQueryText -> ParsecT Void FullQueryText Identity FullQueryText
symbol FullQueryText
"{" ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FullQueryText -> ParsecT Void FullQueryText Identity FullQueryText
symbol FullQueryText
"}"

integer :: Parser Integer
integer :: Parser Integer
integer = Parser Integer -> Parser Integer
forall a. Parser a -> Parser a
lexeme (Parser Integer -> Parser Integer)
-> Parser Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$ ParsecT Void FullQueryText Identity ()
-> Parser Integer -> Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed ParsecT Void FullQueryText Identity ()
spaceOrDot Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal

dot :: Parser T.Text
dot :: ParsecT Void FullQueryText Identity FullQueryText
dot = FullQueryText -> ParsecT Void FullQueryText Identity FullQueryText
symbol FullQueryText
"."

arrayIndexParser :: Parser Index
arrayIndexParser :: Parser Index
arrayIndexParser = ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT Void FullQueryText Identity FullQueryText
gtlt ParsecT Void FullQueryText Identity ()
-> Parser Index -> Parser Index
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> Index
ArrayIndex (Integer -> Index) -> Parser Integer -> Parser Index
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer -> Parser Integer
forall a. Parser a -> Parser a
brackets Parser Integer
integer

environmentVariableParser :: Parser Query
environmentVariableParser :: Parser Query
environmentVariableParser = do
  ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT Void FullQueryText Identity FullQueryText
endingChars
  (FullQueryText -> Query
EnvironmentVariable (FullQueryText -> Query)
-> (String -> FullQueryText) -> String -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FullQueryText
T.pack) (String -> Query)
-> ParsecT Void FullQueryText Identity String -> Parser Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void FullQueryText Identity String
-> ParsecT Void FullQueryText Identity String
forall a. Parser a -> Parser a
braces (ParsecT Void FullQueryText Identity String
-> ParsecT Void FullQueryText Identity String
forall a. Parser a -> Parser a
lexeme (ParsecT Void FullQueryText Identity String
 -> ParsecT Void FullQueryText Identity String)
-> ParsecT Void FullQueryText Identity String
-> ParsecT Void FullQueryText Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT Void FullQueryText Identity Char
-> ParsecT Void FullQueryText Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ([Token FullQueryText]
-> ParsecT Void FullQueryText Identity (Token FullQueryText)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'[', Char
']', Char
'<', Char
'>', Char
' ', Char
'{', Char
'}']))

endingChars :: Parser T.Text
endingChars :: ParsecT Void FullQueryText Identity FullQueryText
endingChars = ParsecT Void FullQueryText Identity FullQueryText
dot ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void FullQueryText Identity FullQueryText
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void FullQueryText Identity FullQueryText
bracket ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void FullQueryText Identity FullQueryText
gtlt ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void FullQueryText Identity FullQueryText
brace

keyIndexParser :: Parser Index
keyIndexParser :: Parser Index
keyIndexParser = do
  ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT Void FullQueryText Identity FullQueryText
endingChars
  (Parser Index -> Parser Index
forall a. Parser a -> Parser a
lexeme (Parser Index -> Parser Index)
-> (Parser Index -> Parser Index) -> Parser Index -> Parser Index
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Index -> Parser Index
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) ((FullQueryText -> Index
KeyIndex (FullQueryText -> Index)
-> (String -> FullQueryText) -> String -> Index
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FullQueryText
T.pack) (String -> Index)
-> ParsecT Void FullQueryText Identity String -> Parser Index
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void FullQueryText Identity String
p)
  where
    p :: ParsecT Void FullQueryText Identity String
p = (:) (Char -> String -> String)
-> ParsecT Void FullQueryText Identity Char
-> ParsecT Void FullQueryText Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void FullQueryText Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar ParsecT Void FullQueryText Identity Char
-> ParsecT Void FullQueryText Identity Char
-> ParsecT Void FullQueryText Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token FullQueryText
-> ParsecT Void FullQueryText Identity (Token FullQueryText)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token FullQueryText
'_')) ParsecT Void FullQueryText Identity (String -> String)
-> ParsecT Void FullQueryText Identity String
-> ParsecT Void FullQueryText Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void FullQueryText Identity Char
-> ParsecT Void FullQueryText Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ([Token FullQueryText]
-> ParsecT Void FullQueryText Identity (Token FullQueryText)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'.', Char
'[', Char
']', Char
'<', Char
'>', Char
' ', Char
'{', Char
'}'])

jsonIndexParser :: Parser Query
jsonIndexParser :: Parser Query
jsonIndexParser =
  ParsecT Void FullQueryText Identity String
leadingText ParsecT Void FullQueryText Identity String
-> ParsecT Void FullQueryText Identity [Index]
-> ParsecT Void FullQueryText Identity [Index]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  (ParsecT Void FullQueryText Identity [Index]
-> ParsecT Void FullQueryText Identity [Index]
forall a. Parser a -> Parser a
inGTLT (ParsecT Void FullQueryText Identity [Index]
 -> ParsecT Void FullQueryText Identity [Index])
-> ParsecT Void FullQueryText Identity [Index]
-> ParsecT Void FullQueryText Identity [Index]
forall a b. (a -> b) -> a -> b
$ Parser Index -> ParsecT Void FullQueryText Identity [Index]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Parser Index
parseSuiteIndex' Parser Index -> Parser Index -> Parser Index
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Index
keyIndexParser Parser Index -> Parser Index -> Parser Index
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Index
arrayIndexParser)) ParsecT Void FullQueryText Identity [Index]
-> ([Index] -> Parser Query) -> Parser Query
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  Query -> Parser Query
forall (m :: * -> *) a. Monad m => a -> m a
return (Query -> Parser Query)
-> ([Index] -> Query) -> [Index] -> Parser Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Index] -> Query
Query

interpolatedQueryParser :: Parser InterpolatedQuery
interpolatedQueryParser :: Parser InterpolatedQuery
interpolatedQueryParser = do
  String
text <- ParsecT Void FullQueryText Identity String
leadingText
  Query
q <- Parser Query
environmentVariableParser Parser Query -> Parser Query -> Parser Query
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Query
jsonIndexParser
  if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
text then InterpolatedQuery -> Parser InterpolatedQuery
forall (m :: * -> *) a. Monad m => a -> m a
return (InterpolatedQuery -> Parser InterpolatedQuery)
-> InterpolatedQuery -> Parser InterpolatedQuery
forall a b. (a -> b) -> a -> b
$ Query -> InterpolatedQuery
NonInterpolatedQuery Query
q
  else InterpolatedQuery -> Parser InterpolatedQuery
forall (m :: * -> *) a. Monad m => a -> m a
return (InterpolatedQuery -> Parser InterpolatedQuery)
-> InterpolatedQuery -> Parser InterpolatedQuery
forall a b. (a -> b) -> a -> b
$ FullQueryText -> Query -> InterpolatedQuery
InterpolatedQuery (String -> FullQueryText
T.pack String
text) Query
q

leadingText :: Parser String
leadingText :: ParsecT Void FullQueryText Identity String
leadingText = ParsecT Void FullQueryText Identity Char
-> ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void FullQueryText Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (ParsecT Void FullQueryText Identity FullQueryText
 -> ParsecT Void FullQueryText Identity String)
-> ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (FullQueryText -> ParsecT Void FullQueryText Identity FullQueryText
symbol FullQueryText
"$<" ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
-> ParsecT Void FullQueryText Identity FullQueryText
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void FullQueryText Identity FullQueryText
"${")

noQueryText :: Parser InterpolatedQuery
noQueryText :: Parser InterpolatedQuery
noQueryText = do
  String
str <- ParsecT Void FullQueryText Identity Char
-> ParsecT Void FullQueryText Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void FullQueryText Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
  ParsecT Void FullQueryText Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  if String
"$<" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
str
    then String -> Parser InterpolatedQuery
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid `$<` found"
    else if String
"${" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
str
      then String -> Parser InterpolatedQuery
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid `${` found"
      else InterpolatedQuery -> Parser InterpolatedQuery
forall (m :: * -> *) a. Monad m => a -> m a
return (InterpolatedQuery -> Parser InterpolatedQuery)
-> InterpolatedQuery -> Parser InterpolatedQuery
forall a b. (a -> b) -> a -> b
$ FullQueryText -> InterpolatedQuery
LiteralText (FullQueryText -> InterpolatedQuery)
-> FullQueryText -> InterpolatedQuery
forall a b. (a -> b) -> a -> b
$ String -> FullQueryText
T.pack String
str

parseFullTextWithQuery :: Parser [InterpolatedQuery]
parseFullTextWithQuery :: Parsec Void FullQueryText [InterpolatedQuery]
parseFullTextWithQuery = Parser InterpolatedQuery
-> Parsec Void FullQueryText [InterpolatedQuery]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ((Parser InterpolatedQuery -> Parser InterpolatedQuery
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser InterpolatedQuery
interpolatedQueryParser) Parser InterpolatedQuery
-> Parser InterpolatedQuery -> Parser InterpolatedQuery
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser InterpolatedQuery
noQueryText)