{- -----------------------------------------------------------------------------
Copyright 2020,2023 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 Control.Applicative.Permutations

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


instance ParseFromSource (IntegrationTestHeader SourceContext) where
  sourceParser :: TextParser (IntegrationTestHeader SourceContext)
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"testcase" forall a b. (a -> b) -> a -> b
$ do
    SourceContext
c <- TextParser SourceContext
getSourceContext
    forall a. TextParser a -> TextParser a
sepAfter TextParser ()
kwTestcase
    String -> TextParser ()
string_ String
"\""
    String
name <- forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill TextParser Char
stringChar (String -> TextParser ()
string_ String
"\"")
    TextParser ()
optionalSpace
    forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"{")
    [OutputPattern] -> [OutputPattern] -> ExpectedResult SourceContext
result <- ParsecT
  CompilerMessage
  String
  Identity
  ([OutputPattern]
   -> [OutputPattern] -> ExpectedResult SourceContext)
resultCompiles forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT
  CompilerMessage
  String
  Identity
  ([OutputPattern]
   -> [OutputPattern] -> ExpectedResult SourceContext)
resultError forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT
  CompilerMessage
  String
  Identity
  ([OutputPattern]
   -> [OutputPattern] -> ExpectedResult SourceContext)
resultCrash forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT
  CompilerMessage
  String
  Identity
  ([OutputPattern]
   -> [OutputPattern] -> ExpectedResult SourceContext)
resultSuccess
    IntegrationTestHeader SourceContext
header <- forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ forall {c} {t} {t}.
c
-> String
-> (t -> t -> ExpectedResult c)
-> [String]
-> Maybe Integer
-> (t, t)
-> IntegrationTestHeader c
build SourceContext
c String
name [OutputPattern] -> [OutputPattern] -> ExpectedResult SourceContext
result
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault [] TextParser [String]
parseArgs
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault forall a. Maybe a
Nothing TextParser (Maybe Integer)
parseTimeout
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation TextParser ([OutputPattern], [OutputPattern])
requireOrExclude
    forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"}")
    forall (m :: * -> *) a. Monad m => a -> m a
return IntegrationTestHeader SourceContext
header where
      build :: c
-> String
-> (t -> t -> ExpectedResult c)
-> [String]
-> Maybe Integer
-> (t, t)
-> IntegrationTestHeader c
build c
c String
name t -> t -> ExpectedResult c
result [String]
args Maybe Integer
timeout (t
req,t
exc) =
        forall c.
[c]
-> String
-> [String]
-> Maybe Integer
-> ExpectedResult c
-> IntegrationTestHeader c
IntegrationTestHeader [c
c] String
name [String]
args Maybe Integer
timeout (t -> t -> ExpectedResult c
result t
req t
exc)
      resultCompiles :: ParsecT
  CompilerMessage
  String
  Identity
  ([OutputPattern]
   -> [OutputPattern] -> ExpectedResult SourceContext)
resultCompiles = forall a. String -> TextParser a -> TextParser a
labeled String
"compiles expectation" forall a b. (a -> b) -> a -> b
$ do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        String -> TextParser ()
keyword String
"compiles"
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c] -> [OutputPattern] -> [OutputPattern] -> ExpectedResult c
ExpectCompiles [SourceContext
c]
      resultError :: ParsecT
  CompilerMessage
  String
  Identity
  ([OutputPattern]
   -> [OutputPattern] -> ExpectedResult SourceContext)
resultError = forall a. String -> TextParser a -> TextParser a
labeled String
"error expectation" forall a b. (a -> b) -> a -> b
$ do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        String -> TextParser ()
keyword String
"error"
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c] -> [OutputPattern] -> [OutputPattern] -> ExpectedResult c
ExpectCompilerError [SourceContext
c]
      resultCrash :: ParsecT
  CompilerMessage
  String
  Identity
  ([OutputPattern]
   -> [OutputPattern] -> ExpectedResult SourceContext)
resultCrash = forall a. String -> TextParser a -> TextParser a
labeled String
"failure expectation" forall a b. (a -> b) -> a -> b
$ do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        String -> TextParser ()
keyword String
"failure"
        Maybe ([SourceContext], TypeInstance)
t <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just ParsecT
  CompilerMessage String Identity ([SourceContext], TypeInstance)
parseTestcaseType forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> Maybe ([c], TypeInstance)
-> [OutputPattern]
-> [OutputPattern]
-> ExpectedResult c
ExpectRuntimeError [SourceContext
c] Maybe ([SourceContext], TypeInstance)
t
      resultSuccess :: ParsecT
  CompilerMessage
  String
  Identity
  ([OutputPattern]
   -> [OutputPattern] -> ExpectedResult SourceContext)
resultSuccess = forall a. String -> TextParser a -> TextParser a
labeled String
"success expectation" forall a b. (a -> b) -> a -> b
$ do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        String -> TextParser ()
keyword String
"success"
        Maybe ([SourceContext], TypeInstance)
t <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just ParsecT
  CompilerMessage String Identity ([SourceContext], TypeInstance)
parseTestcaseType forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> Maybe ([c], TypeInstance)
-> [OutputPattern]
-> [OutputPattern]
-> ExpectedResult c
ExpectRuntimeSuccess [SourceContext
c] Maybe ([SourceContext], TypeInstance)
t
      parseTestcaseType :: ParsecT
  CompilerMessage String Identity ([SourceContext], TypeInstance)
parseTestcaseType = do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        TypeInstance
t <- forall a. ParseFromSource a => TextParser a
sourceParser
        forall (m :: * -> *) a. Monad m => a -> m a
return ([SourceContext
c],TypeInstance
t)
      parseArgs :: TextParser [String]
parseArgs = forall a. String -> TextParser a -> TextParser a
labeled String
"testcase args" forall a b. (a -> b) -> a -> b
$ do
        String -> TextParser ()
keyword String
"args"
        forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall a. TextParser a -> TextParser a
sepAfter TextParser String
quotedString)
      parseTimeout :: TextParser (Maybe Integer)
parseTimeout = forall a. String -> TextParser a -> TextParser a
labeled String
"testcase timeout" forall a b. (a -> b) -> a -> b
$ do
        String -> TextParser ()
keyword String
"timeout"
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall a. TextParser a -> TextParser a
sepAfter TextParser (Integer, Integer)
parseDec)
      requireOrExclude :: TextParser ([OutputPattern], [OutputPattern])
requireOrExclude = forall a b. TextParser a -> TextParser b -> TextParser ([a], [b])
parseAny2 ParsecT CompilerMessage String Identity OutputPattern
require ParsecT CompilerMessage String Identity OutputPattern
exclude where
        require :: ParsecT CompilerMessage String Identity OutputPattern
require = do
          String -> TextParser ()
keyword String
"require"
          OutputScope
s <- ParsecT CompilerMessage String Identity OutputScope
outputScope
          String -> TextParser ()
string_ String
"\""
          String
r <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill TextParser String
regexChar (String -> TextParser ()
string_ String
"\"")
          TextParser ()
optionalSpace
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OutputScope -> String -> OutputPattern
OutputPattern OutputScope
s String
r
        exclude :: ParsecT CompilerMessage String Identity OutputPattern
exclude = do
          String -> TextParser ()
keyword String
"exclude"
          OutputScope
s <- ParsecT CompilerMessage String Identity OutputScope
outputScope
          String -> TextParser ()
string_ String
"\""
          String
e <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill TextParser String
regexChar (String -> TextParser ()
string_ String
"\"")
          TextParser ()
optionalSpace
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OutputScope -> String -> OutputPattern
OutputPattern OutputScope
s String
e
      outputScope :: ParsecT CompilerMessage String Identity OutputScope
outputScope = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CompilerMessage String Identity OutputScope
anyScope forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CompilerMessage String Identity OutputScope
compilerScope forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CompilerMessage String Identity OutputScope
stderrScope forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CompilerMessage String Identity OutputScope
stdoutScope forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    forall (m :: * -> *) a. Monad m => a -> m a
return OutputScope
OutputAny
      anyScope :: ParsecT CompilerMessage String Identity OutputScope
anyScope      = String -> TextParser ()
keyword String
"any"      forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return OutputScope
OutputAny
      compilerScope :: ParsecT CompilerMessage String Identity OutputScope
compilerScope = String -> TextParser ()
keyword String
"compiler" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return OutputScope
OutputCompiler
      stderrScope :: ParsecT CompilerMessage String Identity OutputScope
stderrScope   = String -> TextParser ()
keyword String
"stderr"   forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return OutputScope
OutputStderr
      stdoutScope :: ParsecT CompilerMessage String Identity OutputScope
stdoutScope   = String -> TextParser ()
keyword String
"stdout"   forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return OutputScope
OutputStdout

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