-- | Definition and parsing of a test specification.
module Futhark.Test.Spec
  ( testSpecFromProgram,
    testSpecFromProgramOrDie,
    testSpecsFromPaths,
    testSpecsFromPathsOrDie,
    testSpecFromFile,
    testSpecFromFileOrDie,
    ProgramTest (..),
    StructureTest (..),
    StructurePipeline (..),
    WarningTest (..),
    TestAction (..),
    ExpectedError (..),
    InputOutputs (..),
    TestRun (..),
    ExpectedResult (..),
    Success (..),
    Values (..),
    GenValue (..),
    genValueType,
  )
where

import Control.Applicative
import Control.Exception (catch)
import Control.Monad
import Data.Char
import Data.Functor
import Data.List qualified as L
import Data.Map.Strict qualified as M
import Data.Maybe
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Void
import Futhark.Analysis.Metrics.Type
import Futhark.Data.Parser
import Futhark.Data.Parser qualified as V
import Futhark.Script qualified as Script
import Futhark.Test.Values qualified as V
import Futhark.Util (directoryContents, nubOrd, showText)
import Futhark.Util.Pretty (prettyTextOneLine)
import System.Exit
import System.FilePath
import System.IO
import System.IO.Error
import Text.Megaparsec hiding (many, some)
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer (charLiteral)
import Text.Regex.TDFA
import Prelude

-- | Description of a test to be carried out on a Futhark program.
-- The Futhark program is stored separately.
data ProgramTest = ProgramTest
  { ProgramTest -> Text
testDescription :: T.Text,
    ProgramTest -> [Text]
testTags :: [T.Text],
    ProgramTest -> TestAction
testAction :: TestAction
  }
  deriving (Int -> ProgramTest -> ShowS
[ProgramTest] -> ShowS
ProgramTest -> String
(Int -> ProgramTest -> ShowS)
-> (ProgramTest -> String)
-> ([ProgramTest] -> ShowS)
-> Show ProgramTest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProgramTest -> ShowS
showsPrec :: Int -> ProgramTest -> ShowS
$cshow :: ProgramTest -> String
show :: ProgramTest -> String
$cshowList :: [ProgramTest] -> ShowS
showList :: [ProgramTest] -> ShowS
Show)

-- | How to test a program.
data TestAction
  = CompileTimeFailure ExpectedError
  | RunCases [InputOutputs] [StructureTest] [WarningTest]
  deriving (Int -> TestAction -> ShowS
[TestAction] -> ShowS
TestAction -> String
(Int -> TestAction -> ShowS)
-> (TestAction -> String)
-> ([TestAction] -> ShowS)
-> Show TestAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestAction -> ShowS
showsPrec :: Int -> TestAction -> ShowS
$cshow :: TestAction -> String
show :: TestAction -> String
$cshowList :: [TestAction] -> ShowS
showList :: [TestAction] -> ShowS
Show)

-- | Input and output pairs for some entry point(s).
data InputOutputs = InputOutputs
  { InputOutputs -> Text
iosEntryPoint :: T.Text,
    InputOutputs -> [TestRun]
iosTestRuns :: [TestRun]
  }
  deriving (Int -> InputOutputs -> ShowS
[InputOutputs] -> ShowS
InputOutputs -> String
(Int -> InputOutputs -> ShowS)
-> (InputOutputs -> String)
-> ([InputOutputs] -> ShowS)
-> Show InputOutputs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputOutputs -> ShowS
showsPrec :: Int -> InputOutputs -> ShowS
$cshow :: InputOutputs -> String
show :: InputOutputs -> String
$cshowList :: [InputOutputs] -> ShowS
showList :: [InputOutputs] -> ShowS
Show)

-- | The error expected for a negative test.
data ExpectedError
  = AnyError
  | ThisError T.Text Regex

instance Show ExpectedError where
  show :: ExpectedError -> String
show ExpectedError
AnyError = String
"AnyError"
  show (ThisError Text
r Regex
_) = String
"ThisError " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
r

-- | How a program can be transformed.
data StructurePipeline
  = GpuPipeline
  | MCPipeline
  | SOACSPipeline
  | SeqMemPipeline
  | GpuMemPipeline
  | MCMemPipeline
  | NoPipeline
  deriving (Int -> StructurePipeline -> ShowS
[StructurePipeline] -> ShowS
StructurePipeline -> String
(Int -> StructurePipeline -> ShowS)
-> (StructurePipeline -> String)
-> ([StructurePipeline] -> ShowS)
-> Show StructurePipeline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StructurePipeline -> ShowS
showsPrec :: Int -> StructurePipeline -> ShowS
$cshow :: StructurePipeline -> String
show :: StructurePipeline -> String
$cshowList :: [StructurePipeline] -> ShowS
showList :: [StructurePipeline] -> ShowS
Show)

-- | A structure test specifies a compilation pipeline, as well as
-- metrics for the program coming out the other end.
data StructureTest = StructureTest StructurePipeline AstMetrics
  deriving (Int -> StructureTest -> ShowS
[StructureTest] -> ShowS
StructureTest -> String
(Int -> StructureTest -> ShowS)
-> (StructureTest -> String)
-> ([StructureTest] -> ShowS)
-> Show StructureTest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StructureTest -> ShowS
showsPrec :: Int -> StructureTest -> ShowS
$cshow :: StructureTest -> String
show :: StructureTest -> String
$cshowList :: [StructureTest] -> ShowS
showList :: [StructureTest] -> ShowS
Show)

-- | A warning test requires that a warning matching the regular
-- expression is produced.  The program must also compile succesfully.
data WarningTest = ExpectedWarning T.Text Regex

instance Show WarningTest where
  show :: WarningTest -> String
show (ExpectedWarning Text
r Regex
_) = String
"ExpectedWarning " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
r

-- | A condition for execution, input, and expected result.
data TestRun = TestRun
  { TestRun -> [Text]
runTags :: [T.Text],
    TestRun -> Values
runInput :: Values,
    TestRun -> ExpectedResult Success
runExpectedResult :: ExpectedResult Success,
    TestRun -> Int
runIndex :: Int,
    TestRun -> Text
runDescription :: T.Text
  }
  deriving (Int -> TestRun -> ShowS
[TestRun] -> ShowS
TestRun -> String
(Int -> TestRun -> ShowS)
-> (TestRun -> String) -> ([TestRun] -> ShowS) -> Show TestRun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestRun -> ShowS
showsPrec :: Int -> TestRun -> ShowS
$cshow :: TestRun -> String
show :: TestRun -> String
$cshowList :: [TestRun] -> ShowS
showList :: [TestRun] -> ShowS
Show)

-- | Several values - either literally, or by reference to a file, or
-- to be generated on demand.  All paths are relative to test program.
data Values
  = Values [V.Value]
  | InFile FilePath
  | GenValues [GenValue]
  | ScriptValues Script.Exp
  | ScriptFile FilePath
  deriving (Int -> Values -> ShowS
[Values] -> ShowS
Values -> String
(Int -> Values -> ShowS)
-> (Values -> String) -> ([Values] -> ShowS) -> Show Values
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Values -> ShowS
showsPrec :: Int -> Values -> ShowS
$cshow :: Values -> String
show :: Values -> String
$cshowList :: [Values] -> ShowS
showList :: [Values] -> ShowS
Show)

-- | How to generate a single random value.
data GenValue
  = -- | Generate a value of the given rank and primitive
    -- type.  Scalars are considered 0-ary arrays.
    GenValue V.ValueType
  | -- | A fixed non-randomised primitive value.
    GenPrim V.Value
  deriving (Int -> GenValue -> ShowS
[GenValue] -> ShowS
GenValue -> String
(Int -> GenValue -> ShowS)
-> (GenValue -> String) -> ([GenValue] -> ShowS) -> Show GenValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenValue -> ShowS
showsPrec :: Int -> GenValue -> ShowS
$cshow :: GenValue -> String
show :: GenValue -> String
$cshowList :: [GenValue] -> ShowS
showList :: [GenValue] -> ShowS
Show)

-- | A prettyprinted representation of type of value produced by a
-- 'GenValue'.
genValueType :: GenValue -> T.Text
genValueType :: GenValue -> Text
genValueType (GenValue (V.ValueType [Int]
ds PrimType
t)) =
  (Int -> Text) -> [Int] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Int
d -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showText Int
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") [Int]
ds Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PrimType -> Text
V.primTypeText PrimType
t
genValueType (GenPrim Value
v) =
  Value -> Text
V.valueText Value
v

-- | How a test case is expected to terminate.
data ExpectedResult values
  = -- | Execution suceeds, with or without
    -- expected result values.
    Succeeds (Maybe values)
  | -- | Execution fails with this error.
    RunTimeFailure ExpectedError
  deriving (Int -> ExpectedResult values -> ShowS
[ExpectedResult values] -> ShowS
ExpectedResult values -> String
(Int -> ExpectedResult values -> ShowS)
-> (ExpectedResult values -> String)
-> ([ExpectedResult values] -> ShowS)
-> Show (ExpectedResult values)
forall values. Show values => Int -> ExpectedResult values -> ShowS
forall values. Show values => [ExpectedResult values] -> ShowS
forall values. Show values => ExpectedResult values -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall values. Show values => Int -> ExpectedResult values -> ShowS
showsPrec :: Int -> ExpectedResult values -> ShowS
$cshow :: forall values. Show values => ExpectedResult values -> String
show :: ExpectedResult values -> String
$cshowList :: forall values. Show values => [ExpectedResult values] -> ShowS
showList :: [ExpectedResult values] -> ShowS
Show)

-- | The result expected from a succesful execution.
data Success
  = -- | These values are expected.
    SuccessValues Values
  | -- | Compute expected values from executing a known-good
    -- reference implementation.
    SuccessGenerateValues
  deriving (Int -> Success -> ShowS
[Success] -> ShowS
Success -> String
(Int -> Success -> ShowS)
-> (Success -> String) -> ([Success] -> ShowS) -> Show Success
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Success -> ShowS
showsPrec :: Int -> Success -> ShowS
$cshow :: Success -> String
show :: Success -> String
$cshowList :: [Success] -> ShowS
showList :: [Success] -> ShowS
Show)

type Parser = Parsec Void T.Text

lexeme :: Parser () -> Parser a -> Parser a
lexeme :: forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser a
p = Parser a
p Parser a -> Parser () -> Parser a
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
sep

-- Like 'lexeme', but does not consume trailing linebreaks.
lexeme' :: Parser a -> Parser a
lexeme' :: forall a. Parser a -> Parser a
lexeme' Parser a
p = Parser a
p Parser a -> Parser () -> Parser a
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace

-- Like 'lexstr', but does not consume trailing linebreaks.
lexstr' :: T.Text -> Parser ()
lexstr' :: Text -> Parser ()
lexstr' = Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ())
-> (Text -> Parser Text) -> Text -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Text -> Parser Text)
-> (Text -> Parser Text) -> Text -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme' (Parser Text -> Parser Text)
-> (Text -> Parser Text) -> Text -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Parser Text
Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string

inBraces :: Parser () -> Parser a -> Parser a
inBraces :: forall a. Parser () -> Parser a -> Parser a
inBraces Parser ()
sep = Parser Text
-> Parser Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"{") (Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"}")

parseNatural :: Parser () -> Parser Int
parseNatural :: Parser () -> Parser Int
parseNatural Parser ()
sep =
  Parser () -> Parser Int -> Parser Int
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Int -> Int -> Int
forall {a}. Num a => a -> a -> a
addDigit Int
0 ([Int] -> Int) -> (String -> [Int]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
num (String -> Int) -> ParsecT Void Text Identity String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
  where
    addDigit :: a -> a -> a
addDigit a
acc a
x = a
acc a -> a -> a
forall {a}. Num a => a -> a -> a
* a
10 a -> a -> a
forall {a}. Num a => a -> a -> a
+ a
x
    num :: Char -> Int
num Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall {a}. Num a => a -> a -> a
- Char -> Int
ord Char
'0'

restOfLine :: Parser T.Text
restOfLine :: Parser Text
restOfLine = do
  Text
l <- Parser Text
restOfLine_
  if Text -> Bool
T.null Text
l then ParsecT Void Text Identity (Tokens Text) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol else ParsecT Void Text Identity (Tokens Text) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol Parser () -> Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  Text -> Parser Text
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
l

restOfLine_ :: Parser T.Text
restOfLine_ :: Parser Text
restOfLine_ = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token Text
'\n')

parseDescription :: Parser () -> Parser T.Text
parseDescription :: Parser () -> Parser Text
parseDescription Parser ()
sep =
  [Text] -> Text
T.unlines ([Text] -> Text)
-> ParsecT Void Text Identity [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
pDescLine Parser Text -> Parser () -> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` Parser ()
pDescriptionSeparator
  where
    pDescLine :: Parser Text
pDescLine = Parser Text
restOfLine Parser Text -> Parser () -> Parser Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
sep
    pDescriptionSeparator :: Parser ()
pDescriptionSeparator = Parser () -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser Text
"==" Parser Text -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
sep

lTagName :: Parser () -> Parser T.Text
lTagName :: Parser () -> Parser Text
lTagName Parser ()
sep =
  Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$
    Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"tag-constituent character") Char -> Bool
Token Text -> Bool
tagConstituent

parseTags :: Parser () -> Parser [T.Text]
parseTags :: Parser () -> ParsecT Void Text Identity [Text]
parseTags Parser ()
sep =
  [ParsecT Void Text Identity [Text]]
-> ParsecT Void Text Identity [Text]
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme' Parser Text
"tags" Parser Text
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity [Text]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity [Text]
forall a. Parser () -> Parser a -> Parser a
inBraces Parser ()
sep (Parser Text -> ParsecT Void Text Identity [Text]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser () -> Parser Text
lTagName Parser ()
sep)),
      [Text] -> ParsecT Void Text Identity [Text]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    ]

tagConstituent :: Char -> Bool
tagConstituent :: Char -> Bool
tagConstituent Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'

parseAction :: Parser () -> Parser TestAction
parseAction :: Parser () -> Parser TestAction
parseAction Parser ()
sep =
  [Parser TestAction] -> Parser TestAction
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ExpectedError -> TestAction
CompileTimeFailure (ExpectedError -> TestAction)
-> ParsecT Void Text Identity ExpectedError -> Parser TestAction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser ()
lexstr' Text
"error:" Parser ()
-> ParsecT Void Text Identity ExpectedError
-> ParsecT Void Text Identity ExpectedError
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> ParsecT Void Text Identity ExpectedError
parseExpectedError Parser ()
sep),
      [InputOutputs] -> [StructureTest] -> [WarningTest] -> TestAction
RunCases
        ([InputOutputs] -> [StructureTest] -> [WarningTest] -> TestAction)
-> ParsecT Void Text Identity [InputOutputs]
-> ParsecT
     Void Text Identity ([StructureTest] -> [WarningTest] -> TestAction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> ParsecT Void Text Identity [InputOutputs]
parseInputOutputs Parser ()
sep
        ParsecT
  Void Text Identity ([StructureTest] -> [WarningTest] -> TestAction)
-> ParsecT Void Text Identity [StructureTest]
-> ParsecT Void Text Identity ([WarningTest] -> TestAction)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity StructureTest
-> ParsecT Void Text Identity [StructureTest]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser () -> ParsecT Void Text Identity StructureTest
parseExpectedStructure Parser ()
sep)
        ParsecT Void Text Identity ([WarningTest] -> TestAction)
-> ParsecT Void Text Identity [WarningTest] -> Parser TestAction
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity WarningTest
-> ParsecT Void Text Identity [WarningTest]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser () -> ParsecT Void Text Identity WarningTest
parseWarning Parser ()
sep)
    ]

parseInputOutputs :: Parser () -> Parser [InputOutputs]
parseInputOutputs :: Parser () -> ParsecT Void Text Identity [InputOutputs]
parseInputOutputs Parser ()
sep = do
  [Text]
entrys <- Parser () -> ParsecT Void Text Identity [Text]
parseEntryPoints Parser ()
sep
  [TestRun]
cases <- Parser () -> Parser [TestRun]
parseRunCases Parser ()
sep
  [InputOutputs] -> ParsecT Void Text Identity [InputOutputs]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([InputOutputs] -> ParsecT Void Text Identity [InputOutputs])
-> [InputOutputs] -> ParsecT Void Text Identity [InputOutputs]
forall a b. (a -> b) -> a -> b
$
    if [TestRun] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TestRun]
cases
      then []
      else (Text -> InputOutputs) -> [Text] -> [InputOutputs]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> [TestRun] -> InputOutputs
`InputOutputs` [TestRun]
cases) [Text]
entrys

parseEntryPoints :: Parser () -> Parser [T.Text]
parseEntryPoints :: Parser () -> ParsecT Void Text Identity [Text]
parseEntryPoints Parser ()
sep =
  (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme' Parser Text
"entry:" Parser Text
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity [Text]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text -> ParsecT Void Text Identity [Text]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text
entry ParsecT Void Text Identity [Text]
-> Parser () -> ParsecT Void Text Identity [Text]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
sep) ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity [Text]
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text] -> ParsecT Void Text Identity [Text]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
"main"]
  where
    constituent :: Char -> Bool
constituent Char
c = Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}'
    entry :: ParsecT Void Text Identity (Tokens Text)
entry = ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a. Parser a -> Parser a
lexeme' (ParsecT Void Text Identity (Tokens Text)
 -> ParsecT Void Text Identity (Tokens Text))
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
constituent

parseRunTags :: Parser () -> Parser [T.Text]
parseRunTags :: Parser () -> ParsecT Void Text Identity [Text]
parseRunTags Parser ()
sep = Parser Text -> ParsecT Void Text Identity [Text]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text -> ParsecT Void Text Identity [Text])
-> (Parser Text -> Parser Text)
-> Parser Text
-> ParsecT Void Text Identity [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Text -> Parser Text)
-> (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme' (Parser Text -> ParsecT Void Text Identity [Text])
-> Parser Text -> ParsecT Void Text Identity [Text]
forall a b. (a -> b) -> a -> b
$ do
  Text
s <- Parser () -> Parser Text
lTagName Parser ()
sep
  Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text
s Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"input", Text
"structure", Text
"warning"]
  Text -> Parser Text
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s

parseStringLiteral :: Parser () -> Parser T.Text
parseStringLiteral :: Parser () -> Parser Text
parseStringLiteral Parser ()
sep =
  Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep (Parser Text -> Parser Text)
-> (ParsecT Void Text Identity String -> Parser Text)
-> ParsecT Void Text Identity String
-> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (ParsecT Void Text Identity String -> Parser Text)
-> ParsecT Void Text Identity String -> Parser Text
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void 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 Void Text Identity Char
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
charLiteral (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"')

parseRunCases :: Parser () -> Parser [TestRun]
parseRunCases :: Parser () -> Parser [TestRun]
parseRunCases Parser ()
sep = Int -> Parser [TestRun]
parseRunCases' (Int
0 :: Int)
  where
    parseRunCases' :: Int -> Parser [TestRun]
parseRunCases' Int
i =
      (:) (TestRun -> [TestRun] -> [TestRun])
-> ParsecT Void Text Identity TestRun
-> ParsecT Void Text Identity ([TestRun] -> [TestRun])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Void Text Identity TestRun
parseRunCase Int
i ParsecT Void Text Identity ([TestRun] -> [TestRun])
-> Parser [TestRun] -> Parser [TestRun]
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser [TestRun]
parseRunCases' (Int
i Int -> Int -> Int
forall {a}. Num a => a -> a -> a
+ Int
1)
        Parser [TestRun] -> Parser [TestRun] -> Parser [TestRun]
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [TestRun] -> Parser [TestRun]
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    parseRunCase :: Int -> ParsecT Void Text Identity TestRun
parseRunCase Int
i = do
      Maybe Text
name <- Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> ParsecT Void Text Identity (Maybe Text))
-> Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser Text
parseStringLiteral Parser ()
sep
      [Text]
tags <- Parser () -> ParsecT Void Text Identity [Text]
parseRunTags Parser ()
sep
      Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"input"
      Values
input <-
        if Text
"random" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
tags
          then Parser () -> Parser Values
parseRandomValues Parser ()
sep
          else
            if Text
"script" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
tags
              then Parser () -> Parser Values
parseScriptValues Parser ()
sep
              else Parser () -> Parser Values
parseValues Parser ()
sep
      ExpectedResult Success
expr <- Parser () -> Parser (ExpectedResult Success)
parseExpectedResult Parser ()
sep
      TestRun -> ParsecT Void Text Identity TestRun
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestRun -> ParsecT Void Text Identity TestRun)
-> TestRun -> ParsecT Void Text Identity TestRun
forall a b. (a -> b) -> a -> b
$ [Text]
-> Values -> ExpectedResult Success -> Int -> Text -> TestRun
TestRun [Text]
tags Values
input ExpectedResult Success
expr Int
i (Text -> TestRun) -> Text -> TestRun
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Int -> Values -> Text
forall {a}. Show a => a -> Values -> Text
desc Int
i Values
input) Maybe Text
name

    -- If the file is gzipped, we strip the 'gz' extension from
    -- the dataset name.  This makes it more convenient to rename
    -- from 'foo.in' to 'foo.in.gz', as the reported dataset name
    -- does not change (which would make comparisons to historical
    -- data harder).
    desc :: a -> Values -> Text
desc a
_ (InFile String
path)
      | ShowS
takeExtension String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".gz" = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
dropExtension String
path
      | Bool
otherwise = String -> Text
T.pack String
path
    desc a
i (Values [Value]
vs) =
      -- Turn linebreaks into space.
      Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
showText a
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords (Text -> [Text]
T.lines Text
vs') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\")"
      where
        vs' :: Text
vs' = case [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Value -> Text) -> [Value] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Text
V.valueText [Value]
vs of
          Text
s
            | Text -> Int
T.length Text
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
50 -> Int -> Text -> Text
T.take Int
50 Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"..."
            | Bool
otherwise -> Text
s
    desc a
_ (GenValues [GenValue]
gens) =
      [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (GenValue -> Text) -> [GenValue] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map GenValue -> Text
genValueType [GenValue]
gens
    desc a
_ (ScriptValues Exp
e) =
      Exp -> Text
forall a. Pretty a => a -> Text
prettyTextOneLine Exp
e
    desc a
_ (ScriptFile String
path) =
      String -> Text
T.pack String
path

parseExpectedResult :: Parser () -> Parser (ExpectedResult Success)
parseExpectedResult :: Parser () -> Parser (ExpectedResult Success)
parseExpectedResult Parser ()
sep =
  [Parser (ExpectedResult Success)]
-> Parser (ExpectedResult Success)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"auto" Parser Text -> Parser Text -> Parser Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"output" Parser Text
-> ExpectedResult Success -> Parser (ExpectedResult Success)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Success -> ExpectedResult Success
forall values. Maybe values -> ExpectedResult values
Succeeds (Success -> Maybe Success
forall a. a -> Maybe a
Just Success
SuccessGenerateValues),
      Maybe Success -> ExpectedResult Success
forall values. Maybe values -> ExpectedResult values
Succeeds (Maybe Success -> ExpectedResult Success)
-> (Values -> Maybe Success) -> Values -> ExpectedResult Success
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Success -> Maybe Success
forall a. a -> Maybe a
Just (Success -> Maybe Success)
-> (Values -> Success) -> Values -> Maybe Success
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values -> Success
SuccessValues (Values -> ExpectedResult Success)
-> Parser Values -> Parser (ExpectedResult Success)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"output" Parser Text -> Parser Values -> Parser Values
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> Parser Values
parseValues Parser ()
sep),
      ExpectedError -> ExpectedResult Success
forall values. ExpectedError -> ExpectedResult values
RunTimeFailure (ExpectedError -> ExpectedResult Success)
-> ParsecT Void Text Identity ExpectedError
-> Parser (ExpectedResult Success)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"error:" Parser Text
-> ParsecT Void Text Identity ExpectedError
-> ParsecT Void Text Identity ExpectedError
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> ParsecT Void Text Identity ExpectedError
parseExpectedError Parser ()
sep),
      ExpectedResult Success -> Parser (ExpectedResult Success)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Success -> ExpectedResult Success
forall values. Maybe values -> ExpectedResult values
Succeeds Maybe Success
forall a. Maybe a
Nothing)
    ]

parseExpectedError :: Parser () -> Parser ExpectedError
parseExpectedError :: Parser () -> ParsecT Void Text Identity ExpectedError
parseExpectedError Parser ()
sep = Parser ()
-> ParsecT Void Text Identity ExpectedError
-> ParsecT Void Text Identity ExpectedError
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep (ParsecT Void Text Identity ExpectedError
 -> ParsecT Void Text Identity ExpectedError)
-> ParsecT Void Text Identity ExpectedError
-> ParsecT Void Text Identity ExpectedError
forall a b. (a -> b) -> a -> b
$ do
  Text
s <- Text -> Text
T.strip (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
restOfLine_ Parser Text -> Parser () -> Parser Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
sep
  if Text -> Bool
T.null Text
s
    then ExpectedError -> ParsecT Void Text Identity ExpectedError
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExpectedError
AnyError
    else -- blankCompOpt creates a regular expression that treats
    -- newlines like ordinary characters, which is what we want.
      Text -> Regex -> ExpectedError
ThisError Text
s (Regex -> ExpectedError)
-> ParsecT Void Text Identity Regex
-> ParsecT Void Text Identity ExpectedError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompOption
-> ExecOption -> String -> ParsecT Void Text Identity Regex
forall regex compOpt execOpt source (m :: * -> *).
(RegexMaker regex compOpt execOpt source, MonadFail m) =>
compOpt -> execOpt -> source -> m regex
forall (m :: * -> *).
MonadFail m =>
CompOption -> ExecOption -> String -> m Regex
makeRegexOptsM CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
blankCompOpt ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt (Text -> String
T.unpack Text
s)

parseScriptValues :: Parser () -> Parser Values
parseScriptValues :: Parser () -> Parser Values
parseScriptValues Parser ()
sep =
  [Parser Values] -> Parser Values
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Exp -> Values
ScriptValues (Exp -> Values) -> ParsecT Void Text Identity Exp -> Parser Values
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ()
-> ParsecT Void Text Identity Exp -> ParsecT Void Text Identity Exp
forall a. Parser () -> Parser a -> Parser a
inBraces Parser ()
sep (Parser () -> ParsecT Void Text Identity Exp
Script.parseExp Parser ()
sep),
      String -> Values
ScriptFile (String -> Values) -> (Text -> String) -> Text -> Values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Values) -> Parser Text -> Parser Values
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"@" Parser Text -> Parser Text -> Parser Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
ParsecT Void Text Identity (Tokens Text)
nextWord)
    ]
  where
    nextWord :: ParsecT Void Text Identity (Tokens Text)
nextWord = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing ((Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text))
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace

parseRandomValues :: Parser () -> Parser Values
parseRandomValues :: Parser () -> Parser Values
parseRandomValues Parser ()
sep = [GenValue] -> Values
GenValues ([GenValue] -> Values)
-> ParsecT Void Text Identity [GenValue] -> Parser Values
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ()
-> ParsecT Void Text Identity [GenValue]
-> ParsecT Void Text Identity [GenValue]
forall a. Parser () -> Parser a -> Parser a
inBraces Parser ()
sep (ParsecT Void Text Identity GenValue
-> ParsecT Void Text Identity [GenValue]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser () -> ParsecT Void Text Identity GenValue
parseGenValue Parser ()
sep))

parseGenValue :: Parser () -> Parser GenValue
parseGenValue :: Parser () -> ParsecT Void Text Identity GenValue
parseGenValue Parser ()
sep =
  [ParsecT Void Text Identity GenValue]
-> ParsecT Void Text Identity GenValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ValueType -> GenValue
GenValue (ValueType -> GenValue)
-> ParsecT Void Text Identity ValueType
-> ParsecT Void Text Identity GenValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ()
-> ParsecT Void Text Identity ValueType
-> ParsecT Void Text Identity ValueType
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity ValueType
parseType,
      Value -> GenValue
GenPrim (Value -> GenValue)
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity GenValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ()
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity Value
V.parsePrimValue
    ]

parseValues :: Parser () -> Parser Values
parseValues :: Parser () -> Parser Values
parseValues Parser ()
sep =
  [Parser Values] -> Parser Values
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ [Value] -> Values
Values ([Value] -> Values)
-> ParsecT Void Text Identity [Value] -> Parser Values
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ()
-> ParsecT Void Text Identity [Value]
-> ParsecT Void Text Identity [Value]
forall a. Parser () -> Parser a -> Parser a
inBraces Parser ()
sep (ParsecT Void Text Identity Value
-> ParsecT Void Text Identity [Value]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void Text Identity Value
 -> ParsecT Void Text Identity [Value])
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity [Value]
forall a b. (a -> b) -> a -> b
$ Parser () -> ParsecT Void Text Identity Value
parseValue Parser ()
sep),
      String -> Values
InFile (String -> Values) -> (Text -> String) -> Text -> Values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Values) -> Parser Text -> Parser Values
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"@" Parser Text -> Parser Text -> Parser Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
ParsecT Void Text Identity (Tokens Text)
nextWord)
    ]
  where
    nextWord :: ParsecT Void Text Identity (Tokens Text)
nextWord = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing ((Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text))
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace

parseWarning :: Parser () -> Parser WarningTest
parseWarning :: Parser () -> ParsecT Void Text Identity WarningTest
parseWarning Parser ()
sep = Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"warning:" Parser Text
-> ParsecT Void Text Identity WarningTest
-> ParsecT Void Text Identity WarningTest
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity WarningTest
parseExpectedWarning
  where
    parseExpectedWarning :: ParsecT Void Text Identity WarningTest
parseExpectedWarning = Parser ()
-> ParsecT Void Text Identity WarningTest
-> ParsecT Void Text Identity WarningTest
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep (ParsecT Void Text Identity WarningTest
 -> ParsecT Void Text Identity WarningTest)
-> ParsecT Void Text Identity WarningTest
-> ParsecT Void Text Identity WarningTest
forall a b. (a -> b) -> a -> b
$ do
      Text
s <- Text -> Text
T.strip (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
restOfLine_
      Text -> Regex -> WarningTest
ExpectedWarning Text
s (Regex -> WarningTest)
-> ParsecT Void Text Identity Regex
-> ParsecT Void Text Identity WarningTest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompOption
-> ExecOption -> String -> ParsecT Void Text Identity Regex
forall regex compOpt execOpt source (m :: * -> *).
(RegexMaker regex compOpt execOpt source, MonadFail m) =>
compOpt -> execOpt -> source -> m regex
forall (m :: * -> *).
MonadFail m =>
CompOption -> ExecOption -> String -> m Regex
makeRegexOptsM CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
blankCompOpt ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt (Text -> String
T.unpack Text
s)

parseExpectedStructure :: Parser () -> Parser StructureTest
parseExpectedStructure :: Parser () -> ParsecT Void Text Identity StructureTest
parseExpectedStructure Parser ()
sep =
  Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"structure" Parser Text
-> ParsecT Void Text Identity StructureTest
-> ParsecT Void Text Identity StructureTest
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (StructurePipeline -> AstMetrics -> StructureTest
StructureTest (StructurePipeline -> AstMetrics -> StructureTest)
-> ParsecT Void Text Identity StructurePipeline
-> ParsecT Void Text Identity (AstMetrics -> StructureTest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> ParsecT Void Text Identity StructurePipeline
optimisePipeline Parser ()
sep ParsecT Void Text Identity (AstMetrics -> StructureTest)
-> ParsecT Void Text Identity AstMetrics
-> ParsecT Void Text Identity StructureTest
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser () -> ParsecT Void Text Identity AstMetrics
parseMetrics Parser ()
sep)

optimisePipeline :: Parser () -> Parser StructurePipeline
optimisePipeline :: Parser () -> ParsecT Void Text Identity StructurePipeline
optimisePipeline Parser ()
sep =
  [ParsecT Void Text Identity StructurePipeline]
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"gpu-mem" Parser Text
-> StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
GpuMemPipeline,
      Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"gpu" Parser Text
-> StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
GpuPipeline,
      Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"mc-mem" Parser Text
-> StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
MCMemPipeline,
      Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"mc" Parser Text
-> StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
MCPipeline,
      Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"seq-mem" Parser Text
-> StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
SeqMemPipeline,
      Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"internalised" Parser Text
-> StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
NoPipeline,
      StructurePipeline -> ParsecT Void Text Identity StructurePipeline
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StructurePipeline
SOACSPipeline
    ]

parseMetrics :: Parser () -> Parser AstMetrics
parseMetrics :: Parser () -> ParsecT Void Text Identity AstMetrics
parseMetrics Parser ()
sep =
  Parser ()
-> ParsecT Void Text Identity AstMetrics
-> ParsecT Void Text Identity AstMetrics
forall a. Parser () -> Parser a -> Parser a
inBraces Parser ()
sep (ParsecT Void Text Identity AstMetrics
 -> ParsecT Void Text Identity AstMetrics)
-> (ParsecT Void Text Identity (Text, Int)
    -> ParsecT Void Text Identity AstMetrics)
-> ParsecT Void Text Identity (Text, Int)
-> ParsecT Void Text Identity AstMetrics
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, Int)] -> AstMetrics)
-> ParsecT Void Text Identity [(Text, Int)]
-> ParsecT Void Text Identity AstMetrics
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Text Int -> AstMetrics
AstMetrics (Map Text Int -> AstMetrics)
-> ([(Text, Int)] -> Map Text Int) -> [(Text, Int)] -> AstMetrics
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Int)] -> Map Text Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList) (ParsecT Void Text Identity [(Text, Int)]
 -> ParsecT Void Text Identity AstMetrics)
-> (ParsecT Void Text Identity (Text, Int)
    -> ParsecT Void Text Identity [(Text, Int)])
-> ParsecT Void Text Identity (Text, Int)
-> ParsecT Void Text Identity AstMetrics
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity (Text, Int)
-> ParsecT Void Text Identity [(Text, Int)]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void Text Identity (Text, Int)
 -> ParsecT Void Text Identity AstMetrics)
-> ParsecT Void Text Identity (Text, Int)
-> ParsecT Void Text Identity AstMetrics
forall a b. (a -> b) -> a -> b
$
    (,) (Text -> Int -> (Text, Int))
-> Parser Text -> ParsecT Void Text Identity (Int -> (Text, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser Text -> Parser Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep (Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
constituent) ParsecT Void Text Identity (Int -> (Text, Int))
-> Parser Int -> ParsecT Void Text Identity (Text, Int)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser () -> Parser Int
parseNatural Parser ()
sep
  where
    constituent :: Char -> Bool
constituent Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'

testSpec :: Parser () -> Parser ProgramTest
testSpec :: Parser () -> Parser ProgramTest
testSpec Parser ()
sep =
  Text -> [Text] -> TestAction -> ProgramTest
ProgramTest (Text -> [Text] -> TestAction -> ProgramTest)
-> Parser Text
-> ParsecT Void Text Identity ([Text] -> TestAction -> ProgramTest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser Text
parseDescription Parser ()
sep ParsecT Void Text Identity ([Text] -> TestAction -> ProgramTest)
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity (TestAction -> ProgramTest)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser () -> ParsecT Void Text Identity [Text]
parseTags Parser ()
sep ParsecT Void Text Identity (TestAction -> ProgramTest)
-> Parser TestAction -> Parser ProgramTest
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser () -> Parser TestAction
parseAction Parser ()
sep

couldNotRead :: IOError -> IO (Either String a)
couldNotRead :: forall a. IOError -> IO (Either String a)
couldNotRead = Either String a -> IO (Either String a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String a -> IO (Either String a))
-> (IOError -> Either String a) -> IOError -> IO (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a)
-> (IOError -> String) -> IOError -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> String
forall a. Show a => a -> String
show

pProgramTest :: Parser ProgramTest
pProgramTest :: Parser ProgramTest
pProgramTest = do
  ParsecT Void Text Identity [()] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity [()] -> Parser ())
-> ParsecT Void Text Identity [()] -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser () -> ParsecT Void Text Identity [()]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ()
pNonTestLine
  Maybe ProgramTest
maybe_spec <-
    Parser ProgramTest
-> ParsecT Void Text Identity (Maybe ProgramTest)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text
"--" Parser Text -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
sep Parser () -> Parser ProgramTest -> Parser ProgramTest
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> Parser ProgramTest
testSpec Parser ()
sep) ParsecT Void Text Identity (Maybe ProgramTest)
-> Parser () -> ParsecT Void Text Identity (Maybe ProgramTest)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
pEndOfTestBlock ParsecT Void Text Identity (Maybe ProgramTest)
-> ParsecT Void Text Identity [()]
-> ParsecT Void Text Identity (Maybe ProgramTest)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> ParsecT Void Text Identity [()]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ()
pNonTestLine
  case Maybe ProgramTest
maybe_spec of
    Just ProgramTest
spec
      | RunCases [InputOutputs]
old_cases [StructureTest]
structures [WarningTest]
warnings <- ProgramTest -> TestAction
testAction ProgramTest
spec -> do
          [[InputOutputs]]
cases <- ParsecT Void Text Identity [InputOutputs]
-> ParsecT Void Text Identity [[InputOutputs]]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void Text Identity [InputOutputs]
 -> ParsecT Void Text Identity [[InputOutputs]])
-> ParsecT Void Text Identity [InputOutputs]
-> ParsecT Void Text Identity [[InputOutputs]]
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity [InputOutputs]
pInputOutputs ParsecT Void Text Identity [InputOutputs]
-> ParsecT Void Text Identity [()]
-> ParsecT Void Text Identity [InputOutputs]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> ParsecT Void Text Identity [()]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ()
pNonTestLine
          ProgramTest -> Parser ProgramTest
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramTest
spec {testAction = RunCases (old_cases ++ concat cases) structures warnings}
      | Bool
otherwise ->
          Parser () -> ParsecT Void Text Identity [()]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ()
pNonTestLine
            ParsecT Void Text Identity [()] -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser Text
"-- =="
            Parser () -> Parser ProgramTest -> Parser ProgramTest
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ProgramTest -> Parser ProgramTest
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramTest
spec
            Parser ProgramTest -> String -> Parser ProgramTest
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"no more test blocks, since first test block specifies type error."
    Maybe ProgramTest
Nothing ->
      Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof Parser () -> ProgramTest -> Parser ProgramTest
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ProgramTest
noTest
  where
    sep :: Parser ()
sep = ParsecT Void Text Identity (Maybe ()) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity (Maybe ()) -> Parser ())
-> ParsecT Void Text Identity (Maybe ()) -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace Parser ()
-> ParsecT Void Text Identity (Maybe ())
-> ParsecT Void Text Identity (Maybe ())
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> ParsecT Void Text Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser () -> Parser ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol ParsecT Void Text Identity (Tokens Text)
-> Parser Text -> Parser Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
"--" Parser Text -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
sep)

    noTest :: ProgramTest
noTest =
      Text -> [Text] -> TestAction -> ProgramTest
ProgramTest Text
forall a. Monoid a => a
mempty [Text]
forall a. Monoid a => a
mempty ([InputOutputs] -> [StructureTest] -> [WarningTest] -> TestAction
RunCases [InputOutputs]
forall a. Monoid a => a
mempty [StructureTest]
forall a. Monoid a => a
mempty [WarningTest]
forall a. Monoid a => a
mempty)

    pEndOfTestBlock :: Parser ()
pEndOfTestBlock =
      (ParsecT Void Text Identity (Tokens Text) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol Parser () -> Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Parser () -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser Text
"--"
    pNonTestLine :: Parser ()
pNonTestLine =
      Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser Text -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser Text
"-- ==" Parser () -> Parser Text -> Parser Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
restOfLine
    pInputOutputs :: ParsecT Void Text Identity [InputOutputs]
pInputOutputs =
      Parser Text
"--" Parser Text -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
sep Parser () -> Parser Text -> Parser Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> Parser Text
parseDescription Parser ()
sep Parser Text
-> ParsecT Void Text Identity [InputOutputs]
-> ParsecT Void Text Identity [InputOutputs]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> ParsecT Void Text Identity [InputOutputs]
parseInputOutputs Parser ()
sep ParsecT Void Text Identity [InputOutputs]
-> Parser () -> ParsecT Void Text Identity [InputOutputs]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
pEndOfTestBlock

validate :: FilePath -> ProgramTest -> Either String ProgramTest
validate :: String -> ProgramTest -> Either String ProgramTest
validate String
path ProgramTest
pt = do
  case ProgramTest -> TestAction
testAction ProgramTest
pt of
    CompileTimeFailure {} -> ProgramTest -> Either String ProgramTest
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramTest
pt
    RunCases [InputOutputs]
ios [StructureTest]
_ [WarningTest]
_ -> do
      (InputOutputs -> Either String ())
-> [InputOutputs] -> Either String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Text] -> Either String ()
noDups ([Text] -> Either String ())
-> (InputOutputs -> [Text]) -> InputOutputs -> Either String ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestRun -> Text) -> [TestRun] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TestRun -> Text
runDescription ([TestRun] -> [Text])
-> (InputOutputs -> [TestRun]) -> InputOutputs -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOutputs -> [TestRun]
iosTestRuns) [InputOutputs]
ios
      ProgramTest -> Either String ProgramTest
forall a b. b -> Either a b
Right ProgramTest
pt
  where
    noDups :: [Text] -> Either String ()
noDups [Text]
xs =
      let xs' :: [Text]
xs' = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubOrd [Text]
xs
       in -- Works because \\ only removes first instance.
          case [Text]
xs [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [Text]
xs' of
            [] -> () -> Either String ()
forall a b. b -> Either a b
Right ()
            Text
x : [Text]
_ -> String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
path String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": multiple datasets with name " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show (Text -> String
T.unpack Text
x)

-- | Read the test specification from the given Futhark program.
testSpecFromProgram :: FilePath -> IO (Either String ProgramTest)
testSpecFromProgram :: String -> IO (Either String ProgramTest)
testSpecFromProgram String
path =
  ( (ParseErrorBundle Text Void -> Either String ProgramTest)
-> (ProgramTest -> Either String ProgramTest)
-> Either (ParseErrorBundle Text Void) ProgramTest
-> Either String ProgramTest
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String ProgramTest
forall a b. a -> Either a b
Left (String -> Either String ProgramTest)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Either String ProgramTest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty) (String -> ProgramTest -> Either String ProgramTest
validate String
path) (Either (ParseErrorBundle Text Void) ProgramTest
 -> Either String ProgramTest)
-> (Text -> Either (ParseErrorBundle Text Void) ProgramTest)
-> Text
-> Either String ProgramTest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser ProgramTest
-> String
-> Text
-> Either (ParseErrorBundle Text Void) ProgramTest
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parser ProgramTest
pProgramTest String
path
      (Text -> Either String ProgramTest)
-> IO Text -> IO (Either String ProgramTest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
path
  )
    IO (Either String ProgramTest)
-> (IOError -> IO (Either String ProgramTest))
-> IO (Either String ProgramTest)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO (Either String ProgramTest)
forall a. IOError -> IO (Either String a)
couldNotRead

-- | Like 'testSpecFromProgram', but exits the process on error.
testSpecFromProgramOrDie :: FilePath -> IO ProgramTest
testSpecFromProgramOrDie :: String -> IO ProgramTest
testSpecFromProgramOrDie String
prog = do
  Either String ProgramTest
spec_or_err <- String -> IO (Either String ProgramTest)
testSpecFromProgram String
prog
  case Either String ProgramTest
spec_or_err of
    Left String
err -> do
      Handle -> String -> IO ()
hPutStrLn Handle
stderr String
err
      IO ProgramTest
forall a. IO a
exitFailure
    Right ProgramTest
spec -> ProgramTest -> IO ProgramTest
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramTest
spec

testPrograms :: FilePath -> IO [FilePath]
testPrograms :: String -> IO [String]
testPrograms String
dir = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isFut ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
directoryContents String
dir
  where
    isFut :: String -> Bool
isFut = (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".fut") (String -> Bool) -> ShowS -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension

-- | Read test specifications from the given path, which can be a file
-- or directory containing @.fut@ files and further directories.
testSpecsFromPath :: FilePath -> IO (Either String [(FilePath, ProgramTest)])
testSpecsFromPath :: String -> IO (Either String [(String, ProgramTest)])
testSpecsFromPath String
path = do
  Either String [String]
programs_or_err <- ([String] -> Either String [String]
forall a b. b -> Either a b
Right ([String] -> Either String [String])
-> IO [String] -> IO (Either String [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
testPrograms String
path) IO (Either String [String])
-> (IOError -> IO (Either String [String]))
-> IO (Either String [String])
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO (Either String [String])
forall a. IOError -> IO (Either String a)
couldNotRead
  case Either String [String]
programs_or_err of
    Left String
err -> Either String [(String, ProgramTest)]
-> IO (Either String [(String, ProgramTest)])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String [(String, ProgramTest)]
 -> IO (Either String [(String, ProgramTest)]))
-> Either String [(String, ProgramTest)]
-> IO (Either String [(String, ProgramTest)])
forall a b. (a -> b) -> a -> b
$ String -> Either String [(String, ProgramTest)]
forall a b. a -> Either a b
Left String
err
    Right [String]
programs -> do
      [Either String ProgramTest]
specs_or_errs <- (String -> IO (Either String ProgramTest))
-> [String] -> IO [Either String ProgramTest]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO (Either String ProgramTest)
testSpecFromProgram [String]
programs
      Either String [(String, ProgramTest)]
-> IO (Either String [(String, ProgramTest)])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String [(String, ProgramTest)]
 -> IO (Either String [(String, ProgramTest)]))
-> Either String [(String, ProgramTest)]
-> IO (Either String [(String, ProgramTest)])
forall a b. (a -> b) -> a -> b
$ [String] -> [ProgramTest] -> [(String, ProgramTest)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
programs ([ProgramTest] -> [(String, ProgramTest)])
-> Either String [ProgramTest]
-> Either String [(String, ProgramTest)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either String ProgramTest] -> Either String [ProgramTest]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Either String ProgramTest]
specs_or_errs

-- | Read test specifications from the given paths, which can be a
-- files or directories containing @.fut@ files and further
-- directories.
testSpecsFromPaths ::
  [FilePath] ->
  IO (Either String [(FilePath, ProgramTest)])
testSpecsFromPaths :: [String] -> IO (Either String [(String, ProgramTest)])
testSpecsFromPaths = ([Either String [(String, ProgramTest)]]
 -> Either String [(String, ProgramTest)])
-> IO [Either String [(String, ProgramTest)]]
-> IO (Either String [(String, ProgramTest)])
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([[(String, ProgramTest)]] -> [(String, ProgramTest)])
-> Either String [[(String, ProgramTest)]]
-> Either String [(String, ProgramTest)]
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[(String, ProgramTest)]] -> [(String, ProgramTest)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Either String [[(String, ProgramTest)]]
 -> Either String [(String, ProgramTest)])
-> ([Either String [(String, ProgramTest)]]
    -> Either String [[(String, ProgramTest)]])
-> [Either String [(String, ProgramTest)]]
-> Either String [(String, ProgramTest)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String [(String, ProgramTest)]]
-> Either String [[(String, ProgramTest)]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence) (IO [Either String [(String, ProgramTest)]]
 -> IO (Either String [(String, ProgramTest)]))
-> ([String] -> IO [Either String [(String, ProgramTest)]])
-> [String]
-> IO (Either String [(String, ProgramTest)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO (Either String [(String, ProgramTest)]))
-> [String] -> IO [Either String [(String, ProgramTest)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO (Either String [(String, ProgramTest)])
testSpecsFromPath

-- | Like 'testSpecsFromPaths', but kills the process on errors.
testSpecsFromPathsOrDie ::
  [FilePath] ->
  IO [(FilePath, ProgramTest)]
testSpecsFromPathsOrDie :: [String] -> IO [(String, ProgramTest)]
testSpecsFromPathsOrDie [String]
dirs = do
  Either String [(String, ProgramTest)]
specs_or_err <- [String] -> IO (Either String [(String, ProgramTest)])
testSpecsFromPaths [String]
dirs
  case Either String [(String, ProgramTest)]
specs_or_err of
    Left String
err -> do
      Handle -> String -> IO ()
hPutStrLn Handle
stderr String
err
      IO [(String, ProgramTest)]
forall a. IO a
exitFailure
    Right [(String, ProgramTest)]
specs -> [(String, ProgramTest)] -> IO [(String, ProgramTest)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(String, ProgramTest)]
specs

-- | Read a test specification from a file.  Expects only a single
-- block, and no comment prefixes.
testSpecFromFile :: FilePath -> IO (Either String ProgramTest)
testSpecFromFile :: String -> IO (Either String ProgramTest)
testSpecFromFile String
path =
  ( (ParseErrorBundle Text Void -> Either String ProgramTest)
-> (ProgramTest -> Either String ProgramTest)
-> Either (ParseErrorBundle Text Void) ProgramTest
-> Either String ProgramTest
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String ProgramTest
forall a b. a -> Either a b
Left (String -> Either String ProgramTest)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Either String ProgramTest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty) ProgramTest -> Either String ProgramTest
forall a b. b -> Either a b
Right (Either (ParseErrorBundle Text Void) ProgramTest
 -> Either String ProgramTest)
-> (Text -> Either (ParseErrorBundle Text Void) ProgramTest)
-> Text
-> Either String ProgramTest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser ProgramTest
-> String
-> Text
-> Either (ParseErrorBundle Text Void) ProgramTest
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parser () -> Parser ProgramTest
testSpec Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) String
path
      (Text -> Either String ProgramTest)
-> IO Text -> IO (Either String ProgramTest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
path
  )
    IO (Either String ProgramTest)
-> (IOError -> IO (Either String ProgramTest))
-> IO (Either String ProgramTest)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO (Either String ProgramTest)
forall a. IOError -> IO (Either String a)
couldNotRead

-- | Like 'testSpecFromFile', but kills the process on errors.
testSpecFromFileOrDie :: FilePath -> IO ProgramTest
testSpecFromFileOrDie :: String -> IO ProgramTest
testSpecFromFileOrDie String
dirs = do
  Either String ProgramTest
spec_or_err <- String -> IO (Either String ProgramTest)
testSpecFromFile String
dirs
  case Either String ProgramTest
spec_or_err of
    Left String
err -> do
      Handle -> String -> IO ()
hPutStrLn Handle
stderr String
err
      IO ProgramTest
forall a. IO a
exitFailure
    Right ProgramTest
spec -> ProgramTest -> IO ProgramTest
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramTest
spec