{- -----------------------------------------------------------------------------
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 #-}

module Parser.IntegrationTest (
) where

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


instance ParseFromSource (IntegrationTestHeader SourceContext) where
  sourceParser :: TextParser (IntegrationTestHeader SourceContext)
sourceParser = String
-> TextParser (IntegrationTestHeader SourceContext)
-> TextParser (IntegrationTestHeader SourceContext)
forall a. String -> TextParser a -> TextParser a
labeled String
"testcase" (TextParser (IntegrationTestHeader SourceContext)
 -> TextParser (IntegrationTestHeader SourceContext))
-> TextParser (IntegrationTestHeader SourceContext)
-> TextParser (IntegrationTestHeader SourceContext)
forall a b. (a -> b) -> a -> b
$ do
    SourceContext
c <- TextParser SourceContext
getSourceContext
    TextParser () -> TextParser ()
forall a. TextParser a -> TextParser a
sepAfter TextParser ()
kwTestcase
    String -> TextParser ()
string_ String
"\""
    String
name <- ParsecT CompilerMessage String Identity Char
-> TextParser () -> ParsecT CompilerMessage String Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT CompilerMessage String Identity Char
stringChar (String -> TextParser ()
string_ String
"\"")
    TextParser ()
optionalSpace
    TextParser () -> TextParser ()
forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"{")
    ExpectedResult SourceContext
result <- TextParser (ExpectedResult SourceContext)
resultCompiles TextParser (ExpectedResult SourceContext)
-> TextParser (ExpectedResult SourceContext)
-> TextParser (ExpectedResult SourceContext)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (ExpectedResult SourceContext)
resultError TextParser (ExpectedResult SourceContext)
-> TextParser (ExpectedResult SourceContext)
-> TextParser (ExpectedResult SourceContext)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (ExpectedResult SourceContext)
resultCrash TextParser (ExpectedResult SourceContext)
-> TextParser (ExpectedResult SourceContext)
-> TextParser (ExpectedResult SourceContext)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (ExpectedResult SourceContext)
resultSuccess
    [String]
args <- TextParser [String]
parseArgs TextParser [String] -> TextParser [String] -> TextParser [String]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [String] -> TextParser [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    TextParser () -> TextParser ()
forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"}")
    IntegrationTestHeader SourceContext
-> TextParser (IntegrationTestHeader SourceContext)
forall (m :: * -> *) a. Monad m => a -> m a
return (IntegrationTestHeader SourceContext
 -> TextParser (IntegrationTestHeader SourceContext))
-> IntegrationTestHeader SourceContext
-> TextParser (IntegrationTestHeader SourceContext)
forall a b. (a -> b) -> a -> b
$ [SourceContext]
-> String
-> [String]
-> ExpectedResult SourceContext
-> IntegrationTestHeader SourceContext
forall c.
[c]
-> String
-> [String]
-> ExpectedResult c
-> IntegrationTestHeader c
IntegrationTestHeader [SourceContext
c] String
name [String]
args ExpectedResult SourceContext
result where
      resultCompiles :: TextParser (ExpectedResult SourceContext)
resultCompiles = String
-> TextParser (ExpectedResult SourceContext)
-> TextParser (ExpectedResult SourceContext)
forall a. String -> TextParser a -> TextParser a
labeled String
"compiles expectation" (TextParser (ExpectedResult SourceContext)
 -> TextParser (ExpectedResult SourceContext))
-> TextParser (ExpectedResult SourceContext)
-> TextParser (ExpectedResult SourceContext)
forall a b. (a -> b) -> a -> b
$ do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        String -> TextParser ()
keyword String
"compiles"
        ([OutputPattern]
req,[OutputPattern]
exc) <- TextParser ([OutputPattern], [OutputPattern])
requireOrExclude
        ExpectedResult SourceContext
-> TextParser (ExpectedResult SourceContext)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpectedResult SourceContext
 -> TextParser (ExpectedResult SourceContext))
-> ExpectedResult SourceContext
-> TextParser (ExpectedResult SourceContext)
forall a b. (a -> b) -> a -> b
$ [SourceContext]
-> [OutputPattern]
-> [OutputPattern]
-> ExpectedResult SourceContext
forall c.
[c] -> [OutputPattern] -> [OutputPattern] -> ExpectedResult c
ExpectCompiles [SourceContext
c] [OutputPattern]
req [OutputPattern]
exc
      resultError :: TextParser (ExpectedResult SourceContext)
resultError = String
-> TextParser (ExpectedResult SourceContext)
-> TextParser (ExpectedResult SourceContext)
forall a. String -> TextParser a -> TextParser a
labeled String
"error expectation" (TextParser (ExpectedResult SourceContext)
 -> TextParser (ExpectedResult SourceContext))
-> TextParser (ExpectedResult SourceContext)
-> TextParser (ExpectedResult SourceContext)
forall a b. (a -> b) -> a -> b
$ do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        String -> TextParser ()
keyword String
"error"
        ([OutputPattern]
req,[OutputPattern]
exc) <- TextParser ([OutputPattern], [OutputPattern])
requireOrExclude
        ExpectedResult SourceContext
-> TextParser (ExpectedResult SourceContext)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpectedResult SourceContext
 -> TextParser (ExpectedResult SourceContext))
-> ExpectedResult SourceContext
-> TextParser (ExpectedResult SourceContext)
forall a b. (a -> b) -> a -> b
$ [SourceContext]
-> [OutputPattern]
-> [OutputPattern]
-> ExpectedResult SourceContext
forall c.
[c] -> [OutputPattern] -> [OutputPattern] -> ExpectedResult c
ExpectCompilerError [SourceContext
c] [OutputPattern]
req [OutputPattern]
exc
      resultCrash :: TextParser (ExpectedResult SourceContext)
resultCrash = String
-> TextParser (ExpectedResult SourceContext)
-> TextParser (ExpectedResult SourceContext)
forall a. String -> TextParser a -> TextParser a
labeled String
"crash expectation" (TextParser (ExpectedResult SourceContext)
 -> TextParser (ExpectedResult SourceContext))
-> TextParser (ExpectedResult SourceContext)
-> TextParser (ExpectedResult SourceContext)
forall a b. (a -> b) -> a -> b
$ do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        String -> TextParser ()
keyword String
"crash"
        ([OutputPattern]
req,[OutputPattern]
exc) <- TextParser ([OutputPattern], [OutputPattern])
requireOrExclude
        ExpectedResult SourceContext
-> TextParser (ExpectedResult SourceContext)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpectedResult SourceContext
 -> TextParser (ExpectedResult SourceContext))
-> ExpectedResult SourceContext
-> TextParser (ExpectedResult SourceContext)
forall a b. (a -> b) -> a -> b
$ [SourceContext]
-> [OutputPattern]
-> [OutputPattern]
-> ExpectedResult SourceContext
forall c.
[c] -> [OutputPattern] -> [OutputPattern] -> ExpectedResult c
ExpectRuntimeError [SourceContext
c] [OutputPattern]
req [OutputPattern]
exc
      resultSuccess :: TextParser (ExpectedResult SourceContext)
resultSuccess = String
-> TextParser (ExpectedResult SourceContext)
-> TextParser (ExpectedResult SourceContext)
forall a. String -> TextParser a -> TextParser a
labeled String
"success expectation" (TextParser (ExpectedResult SourceContext)
 -> TextParser (ExpectedResult SourceContext))
-> TextParser (ExpectedResult SourceContext)
-> TextParser (ExpectedResult SourceContext)
forall a b. (a -> b) -> a -> b
$ do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        String -> TextParser ()
keyword String
"success"
        ([OutputPattern]
req,[OutputPattern]
exc) <- TextParser ([OutputPattern], [OutputPattern])
requireOrExclude
        ExpectedResult SourceContext
-> TextParser (ExpectedResult SourceContext)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpectedResult SourceContext
 -> TextParser (ExpectedResult SourceContext))
-> ExpectedResult SourceContext
-> TextParser (ExpectedResult SourceContext)
forall a b. (a -> b) -> a -> b
$ [SourceContext]
-> [OutputPattern]
-> [OutputPattern]
-> ExpectedResult SourceContext
forall c.
[c] -> [OutputPattern] -> [OutputPattern] -> ExpectedResult c
ExpectRuntimeSuccess [SourceContext
c] [OutputPattern]
req [OutputPattern]
exc
      parseArgs :: TextParser [String]
parseArgs = String -> TextParser [String] -> TextParser [String]
forall a. String -> TextParser a -> TextParser a
labeled String
"testcase args" (TextParser [String] -> TextParser [String])
-> TextParser [String] -> TextParser [String]
forall a b. (a -> b) -> a -> b
$ do
        String -> TextParser ()
keyword String
"args"
        ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CompilerMessage String Identity String
-> ParsecT CompilerMessage String Identity String
forall a. TextParser a -> TextParser a
sepAfter ParsecT CompilerMessage String Identity String
quotedString)
      requireOrExclude :: TextParser ([OutputPattern], [OutputPattern])
requireOrExclude = TextParser OutputPattern
-> TextParser OutputPattern
-> TextParser ([OutputPattern], [OutputPattern])
forall a b. TextParser a -> TextParser b -> TextParser ([a], [b])
parseAny2 TextParser OutputPattern
require TextParser OutputPattern
exclude where
        require :: TextParser OutputPattern
require = do
          String -> TextParser ()
keyword String
"require"
          OutputScope
s <- ParsecT CompilerMessage String Identity OutputScope
outputScope
          String -> TextParser ()
string_ String
"\""
          String
r <- ([String] -> String)
-> TextParser [String]
-> ParsecT CompilerMessage 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 (TextParser [String]
 -> ParsecT CompilerMessage String Identity String)
-> TextParser [String]
-> ParsecT CompilerMessage String Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT CompilerMessage String Identity String
-> TextParser () -> TextParser [String]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT CompilerMessage String Identity String
regexChar (String -> TextParser ()
string_ String
"\"")
          TextParser ()
optionalSpace
          OutputPattern -> TextParser OutputPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (OutputPattern -> TextParser OutputPattern)
-> OutputPattern -> TextParser OutputPattern
forall a b. (a -> b) -> a -> b
$ OutputScope -> String -> OutputPattern
OutputPattern OutputScope
s String
r
        exclude :: TextParser OutputPattern
exclude = do
          String -> TextParser ()
keyword String
"exclude"
          OutputScope
s <- ParsecT CompilerMessage String Identity OutputScope
outputScope
          String -> TextParser ()
string_ String
"\""
          String
e <- ([String] -> String)
-> TextParser [String]
-> ParsecT CompilerMessage 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 (TextParser [String]
 -> ParsecT CompilerMessage String Identity String)
-> TextParser [String]
-> ParsecT CompilerMessage String Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT CompilerMessage String Identity String
-> TextParser () -> TextParser [String]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT CompilerMessage String Identity String
regexChar (String -> TextParser ()
string_ String
"\"")
          TextParser ()
optionalSpace
          OutputPattern -> TextParser OutputPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (OutputPattern -> TextParser OutputPattern)
-> OutputPattern -> TextParser OutputPattern
forall a b. (a -> b) -> a -> b
$ OutputScope -> String -> OutputPattern
OutputPattern OutputScope
s String
e
      outputScope :: ParsecT CompilerMessage String Identity OutputScope
outputScope = ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CompilerMessage String Identity OutputScope
anyScope ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CompilerMessage String Identity OutputScope
compilerScope ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CompilerMessage String Identity OutputScope
stderrScope ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CompilerMessage String Identity OutputScope
stdoutScope ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    OutputScope -> ParsecT CompilerMessage String Identity OutputScope
forall (m :: * -> *) a. Monad m => a -> m a
return OutputScope
OutputAny
      anyScope :: ParsecT CompilerMessage String Identity OutputScope
anyScope      = String -> TextParser ()
keyword String
"any"      TextParser ()
-> ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OutputScope -> ParsecT CompilerMessage String Identity OutputScope
forall (m :: * -> *) a. Monad m => a -> m a
return OutputScope
OutputAny
      compilerScope :: ParsecT CompilerMessage String Identity OutputScope
compilerScope = String -> TextParser ()
keyword String
"compiler" TextParser ()
-> ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OutputScope -> ParsecT CompilerMessage String Identity OutputScope
forall (m :: * -> *) a. Monad m => a -> m a
return OutputScope
OutputCompiler
      stderrScope :: ParsecT CompilerMessage String Identity OutputScope
stderrScope   = String -> TextParser ()
keyword String
"stderr"   TextParser ()
-> ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OutputScope -> ParsecT CompilerMessage String Identity OutputScope
forall (m :: * -> *) a. Monad m => a -> m a
return OutputScope
OutputStderr
      stdoutScope :: ParsecT CompilerMessage String Identity OutputScope
stdoutScope   = String -> TextParser ()
keyword String
"stdout"   TextParser ()
-> ParsecT CompilerMessage String Identity OutputScope
-> ParsecT CompilerMessage String Identity OutputScope
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OutputScope -> ParsecT CompilerMessage String Identity OutputScope
forall (m :: * -> *) a. Monad m => a -> m a
return OutputScope
OutputStdout

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