{- -----------------------------------------------------------------------------
Copyright 2020 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Safe #-}

module Parser.IntegrationTest (
) where

import Text.Parsec

import Parser.Common
import Parser.DefinedCategory
import Parser.Procedure ()
import Parser.TypeCategory ()
import Types.IntegrationTest


instance ParseFromSource (IntegrationTestHeader SourcePos) where
  sourceParser :: Parser (IntegrationTestHeader SourcePos)
sourceParser = String
-> Parser (IntegrationTestHeader SourcePos)
-> Parser (IntegrationTestHeader SourcePos)
forall a. String -> Parser a -> Parser a
labeled String
"testcase" (Parser (IntegrationTestHeader SourcePos)
 -> Parser (IntegrationTestHeader SourcePos))
-> Parser (IntegrationTestHeader SourcePos)
-> Parser (IntegrationTestHeader SourcePos)
forall a b. (a -> b) -> a -> b
$ do
    SourcePos
c <- ParsecT String () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
    Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter Parser ()
kwTestcase
    String -> Parser ()
string_ String
"\""
    String
name <- ParsecT String () Identity Char
-> Parser () -> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
stringChar (String -> Parser ()
string_ String
"\"")
    Parser ()
optionalSpace
    Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
string_ String
"{")
    ExpectedResult SourcePos
result <- Parser (ExpectedResult SourcePos)
resultError Parser (ExpectedResult SourcePos)
-> Parser (ExpectedResult SourcePos)
-> Parser (ExpectedResult SourcePos)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser (ExpectedResult SourcePos)
resultCrash Parser (ExpectedResult SourcePos)
-> Parser (ExpectedResult SourcePos)
-> Parser (ExpectedResult SourcePos)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser (ExpectedResult SourcePos)
resultSuccess
    Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
string_ String
"}")
    IntegrationTestHeader SourcePos
-> Parser (IntegrationTestHeader SourcePos)
forall (m :: * -> *) a. Monad m => a -> m a
return (IntegrationTestHeader SourcePos
 -> Parser (IntegrationTestHeader SourcePos))
-> IntegrationTestHeader SourcePos
-> Parser (IntegrationTestHeader SourcePos)
forall a b. (a -> b) -> a -> b
$ [SourcePos]
-> String
-> ExpectedResult SourcePos
-> IntegrationTestHeader SourcePos
forall c.
[c] -> String -> ExpectedResult c -> IntegrationTestHeader c
IntegrationTestHeader [SourcePos
c] String
name ExpectedResult SourcePos
result where
      resultError :: Parser (ExpectedResult SourcePos)
resultError = String
-> Parser (ExpectedResult SourcePos)
-> Parser (ExpectedResult SourcePos)
forall a. String -> Parser a -> Parser a
labeled String
"error expectation" (Parser (ExpectedResult SourcePos)
 -> Parser (ExpectedResult SourcePos))
-> Parser (ExpectedResult SourcePos)
-> Parser (ExpectedResult SourcePos)
forall a b. (a -> b) -> a -> b
$ do
        SourcePos
c <- ParsecT String () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
        Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
keyword String
"error")
        ([OutputPattern]
req,[OutputPattern]
exc) <- ParsecT String () Identity ([OutputPattern], [OutputPattern])
requireOrExclude
        ExpectedResult SourcePos -> Parser (ExpectedResult SourcePos)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpectedResult SourcePos -> Parser (ExpectedResult SourcePos))
-> ExpectedResult SourcePos -> Parser (ExpectedResult SourcePos)
forall a b. (a -> b) -> a -> b
$ [SourcePos]
-> [OutputPattern] -> [OutputPattern] -> ExpectedResult SourcePos
forall c.
[c] -> [OutputPattern] -> [OutputPattern] -> ExpectedResult c
ExpectCompileError [SourcePos
c] [OutputPattern]
req [OutputPattern]
exc
      resultCrash :: Parser (ExpectedResult SourcePos)
resultCrash = String
-> Parser (ExpectedResult SourcePos)
-> Parser (ExpectedResult SourcePos)
forall a. String -> Parser a -> Parser a
labeled String
"crash expectation" (Parser (ExpectedResult SourcePos)
 -> Parser (ExpectedResult SourcePos))
-> Parser (ExpectedResult SourcePos)
-> Parser (ExpectedResult SourcePos)
forall a b. (a -> b) -> a -> b
$ do
        SourcePos
c <- ParsecT String () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
        Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
keyword String
"crash")
        Expression SourcePos
e <- String
-> Parser (Expression SourcePos) -> Parser (Expression SourcePos)
forall a. String -> Parser a -> Parser a
labeled String
"test expression" Parser (Expression SourcePos)
forall a. ParseFromSource a => Parser a
sourceParser
        ([OutputPattern]
req,[OutputPattern]
exc) <- ParsecT String () Identity ([OutputPattern], [OutputPattern])
requireOrExclude
        ExpectedResult SourcePos -> Parser (ExpectedResult SourcePos)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpectedResult SourcePos -> Parser (ExpectedResult SourcePos))
-> ExpectedResult SourcePos -> Parser (ExpectedResult SourcePos)
forall a b. (a -> b) -> a -> b
$ [SourcePos]
-> Expression SourcePos
-> [OutputPattern]
-> [OutputPattern]
-> ExpectedResult SourcePos
forall c.
[c]
-> Expression c
-> [OutputPattern]
-> [OutputPattern]
-> ExpectedResult c
ExpectRuntimeError [SourcePos
c] Expression SourcePos
e [OutputPattern]
req [OutputPattern]
exc
      resultSuccess :: Parser (ExpectedResult SourcePos)
resultSuccess = String
-> Parser (ExpectedResult SourcePos)
-> Parser (ExpectedResult SourcePos)
forall a. String -> Parser a -> Parser a
labeled String
"success expectation" (Parser (ExpectedResult SourcePos)
 -> Parser (ExpectedResult SourcePos))
-> Parser (ExpectedResult SourcePos)
-> Parser (ExpectedResult SourcePos)
forall a b. (a -> b) -> a -> b
$ do
        SourcePos
c <- ParsecT String () Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
        Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
keyword String
"success")
        Expression SourcePos
e <- String
-> Parser (Expression SourcePos) -> Parser (Expression SourcePos)
forall a. String -> Parser a -> Parser a
labeled String
"test expression" Parser (Expression SourcePos)
forall a. ParseFromSource a => Parser a
sourceParser
        ([OutputPattern]
req,[OutputPattern]
exc) <- ParsecT String () Identity ([OutputPattern], [OutputPattern])
requireOrExclude
        ExpectedResult SourcePos -> Parser (ExpectedResult SourcePos)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpectedResult SourcePos -> Parser (ExpectedResult SourcePos))
-> ExpectedResult SourcePos -> Parser (ExpectedResult SourcePos)
forall a b. (a -> b) -> a -> b
$ [SourcePos]
-> Expression SourcePos
-> [OutputPattern]
-> [OutputPattern]
-> ExpectedResult SourcePos
forall c.
[c]
-> Expression c
-> [OutputPattern]
-> [OutputPattern]
-> ExpectedResult c
ExpectRuntimeSuccess [SourcePos
c] Expression SourcePos
e [OutputPattern]
req [OutputPattern]
exc
      requireOrExclude :: ParsecT String () Identity ([OutputPattern], [OutputPattern])
requireOrExclude = ParsecT String () Identity [([OutputPattern], [OutputPattern])]
parsed ParsecT String () Identity [([OutputPattern], [OutputPattern])]
-> ([([OutputPattern], [OutputPattern])]
    -> ParsecT String () Identity ([OutputPattern], [OutputPattern]))
-> ParsecT String () Identity ([OutputPattern], [OutputPattern])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([OutputPattern], [OutputPattern])
-> ParsecT String () Identity ([OutputPattern], [OutputPattern])
forall (m :: * -> *) a. Monad m => a -> m a
return (([OutputPattern], [OutputPattern])
 -> ParsecT String () Identity ([OutputPattern], [OutputPattern]))
-> ([([OutputPattern], [OutputPattern])]
    -> ([OutputPattern], [OutputPattern]))
-> [([OutputPattern], [OutputPattern])]
-> ParsecT String () Identity ([OutputPattern], [OutputPattern])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([OutputPattern], [OutputPattern])
 -> ([OutputPattern], [OutputPattern])
 -> ([OutputPattern], [OutputPattern]))
-> ([OutputPattern], [OutputPattern])
-> [([OutputPattern], [OutputPattern])]
-> ([OutputPattern], [OutputPattern])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([OutputPattern], [OutputPattern])
-> ([OutputPattern], [OutputPattern])
-> ([OutputPattern], [OutputPattern])
forall a a. ([a], [a]) -> ([a], [a]) -> ([a], [a])
merge ([OutputPattern], [OutputPattern])
forall a a. ([a], [a])
empty where
        empty :: ([a], [a])
empty = ([],[])
        merge :: ([a], [a]) -> ([a], [a]) -> ([a], [a])
merge ([a]
cs1,[a]
ds1) ([a]
cs2,[a]
ds2) = ([a]
cs1[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
cs2,[a]
ds1[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
ds2)
        parsed :: ParsecT String () Identity [([OutputPattern], [OutputPattern])]
parsed = ParsecT String () Identity ([OutputPattern], [OutputPattern])
-> Parser ()
-> ParsecT String () Identity [([OutputPattern], [OutputPattern])]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
sepBy ParsecT String () Identity ([OutputPattern], [OutputPattern])
anyType Parser ()
optionalSpace
        anyType :: ParsecT String () Identity ([OutputPattern], [OutputPattern])
anyType = ParsecT String () Identity ([OutputPattern], [OutputPattern])
forall a. ParsecT String () Identity ([OutputPattern], [a])
require ParsecT String () Identity ([OutputPattern], [OutputPattern])
-> ParsecT String () Identity ([OutputPattern], [OutputPattern])
-> ParsecT String () Identity ([OutputPattern], [OutputPattern])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity ([OutputPattern], [OutputPattern])
forall a. ParsecT String () Identity ([a], [OutputPattern])
exclude where
          require :: ParsecT String () Identity ([OutputPattern], [a])
require = do
            Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
keyword String
"require")
            OutputScope
s <- ParsecT String () Identity OutputScope
outputScope
            String -> Parser ()
string_ String
"\""
            String
r <- ([String] -> String)
-> ParsecT String () Identity [String]
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ParsecT String () Identity [String]
 -> ParsecT String () Identity String)
-> ParsecT String () Identity [String]
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity String
-> Parser () -> ParsecT String () Identity [String]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity String
regexChar (String -> Parser ()
string_ String
"\"")
            Parser ()
optionalSpace
            ([OutputPattern], [a])
-> ParsecT String () Identity ([OutputPattern], [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([OutputScope -> String -> OutputPattern
OutputPattern OutputScope
s String
r],[])
          exclude :: ParsecT String () Identity ([a], [OutputPattern])
exclude = do
            Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
keyword String
"exclude")
            OutputScope
s <- ParsecT String () Identity OutputScope
outputScope
            String -> Parser ()
string_ String
"\""
            String
e <- ([String] -> String)
-> ParsecT String () Identity [String]
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ParsecT String () Identity [String]
 -> ParsecT String () Identity String)
-> ParsecT String () Identity [String]
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity String
-> Parser () -> ParsecT String () Identity [String]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity String
regexChar (String -> Parser ()
string_ String
"\"")
            Parser ()
optionalSpace
            ([a], [OutputPattern])
-> ParsecT String () Identity ([a], [OutputPattern])
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[OutputScope -> String -> OutputPattern
OutputPattern OutputScope
s String
e])
      outputScope :: ParsecT String () Identity OutputScope
outputScope = ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String () Identity OutputScope
anyScope ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                    ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String () Identity OutputScope
compilerScope ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                    ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String () Identity OutputScope
stderrScope ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                    ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String () Identity OutputScope
stdoutScope ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                    OutputScope -> ParsecT String () Identity OutputScope
forall (m :: * -> *) a. Monad m => a -> m a
return OutputScope
OutputAny
      anyScope :: ParsecT String () Identity OutputScope
anyScope      = Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
keyword String
"any")      Parser ()
-> ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OutputScope -> ParsecT String () Identity OutputScope
forall (m :: * -> *) a. Monad m => a -> m a
return OutputScope
OutputAny
      compilerScope :: ParsecT String () Identity OutputScope
compilerScope = Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
keyword String
"compiler") Parser ()
-> ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OutputScope -> ParsecT String () Identity OutputScope
forall (m :: * -> *) a. Monad m => a -> m a
return OutputScope
OutputCompiler
      stderrScope :: ParsecT String () Identity OutputScope
stderrScope   = Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
keyword String
"stderr")   Parser ()
-> ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OutputScope -> ParsecT String () Identity OutputScope
forall (m :: * -> *) a. Monad m => a -> m a
return OutputScope
OutputStderr
      stdoutScope :: ParsecT String () Identity OutputScope
stdoutScope   = Parser () -> Parser ()
forall a. Parser a -> Parser a
sepAfter (String -> Parser ()
keyword String
"stdout")   Parser ()
-> ParsecT String () Identity OutputScope
-> ParsecT String () Identity OutputScope
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OutputScope -> ParsecT String () Identity OutputScope
forall (m :: * -> *) a. Monad m => a -> m a
return OutputScope
OutputStdout

instance ParseFromSource (IntegrationTest SourcePos) where
  sourceParser :: Parser (IntegrationTest SourcePos)
sourceParser = String
-> Parser (IntegrationTest SourcePos)
-> Parser (IntegrationTest SourcePos)
forall a. String -> Parser a -> Parser a
labeled String
"integration test" (Parser (IntegrationTest SourcePos)
 -> Parser (IntegrationTest SourcePos))
-> Parser (IntegrationTest SourcePos)
-> Parser (IntegrationTest SourcePos)
forall a b. (a -> b) -> a -> b
$ do
    IntegrationTestHeader SourcePos
h <- Parser (IntegrationTestHeader SourcePos)
forall a. ParseFromSource a => Parser a
sourceParser
    ([AnyCategory SourcePos]
cs,[DefinedCategory SourcePos]
ds) <- Parser ([AnyCategory SourcePos], [DefinedCategory SourcePos])
parseAnySource
    IntegrationTest SourcePos -> Parser (IntegrationTest SourcePos)
forall (m :: * -> *) a. Monad m => a -> m a
return (IntegrationTest SourcePos -> Parser (IntegrationTest SourcePos))
-> IntegrationTest SourcePos -> Parser (IntegrationTest SourcePos)
forall a b. (a -> b) -> a -> b
$ IntegrationTestHeader SourcePos
-> [AnyCategory SourcePos]
-> [DefinedCategory SourcePos]
-> IntegrationTest SourcePos
forall c.
IntegrationTestHeader c
-> [AnyCategory c] -> [DefinedCategory c] -> IntegrationTest c
IntegrationTest IntegrationTestHeader SourcePos
h [AnyCategory SourcePos]
cs [DefinedCategory SourcePos]
ds