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 (foldl', (\\))
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
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProgramTest] -> ShowS
$cshowList :: [ProgramTest] -> ShowS
show :: ProgramTest -> String
$cshow :: ProgramTest -> String
showsPrec :: Int -> ProgramTest -> ShowS
$cshowsPrec :: Int -> ProgramTest -> ShowS
Show)
data TestAction
= CompileTimeFailure ExpectedError
| RunCases [InputOutputs] [StructureTest] [WarningTest]
deriving (Int -> TestAction -> ShowS
[TestAction] -> ShowS
TestAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestAction] -> ShowS
$cshowList :: [TestAction] -> ShowS
show :: TestAction -> String
$cshow :: TestAction -> String
showsPrec :: Int -> TestAction -> ShowS
$cshowsPrec :: Int -> TestAction -> ShowS
Show)
data InputOutputs = InputOutputs
{ InputOutputs -> Text
iosEntryPoint :: T.Text,
InputOutputs -> [TestRun]
iosTestRuns :: [TestRun]
}
deriving (Int -> InputOutputs -> ShowS
[InputOutputs] -> ShowS
InputOutputs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputOutputs] -> ShowS
$cshowList :: [InputOutputs] -> ShowS
show :: InputOutputs -> String
$cshow :: InputOutputs -> String
showsPrec :: Int -> InputOutputs -> ShowS
$cshowsPrec :: Int -> InputOutputs -> ShowS
Show)
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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
r
data StructurePipeline
= GpuPipeline
| MCPipeline
| SOACSPipeline
| SeqMemPipeline
| GpuMemPipeline
| MCMemPipeline
| NoPipeline
deriving (Int -> StructurePipeline -> ShowS
[StructurePipeline] -> ShowS
StructurePipeline -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StructurePipeline] -> ShowS
$cshowList :: [StructurePipeline] -> ShowS
show :: StructurePipeline -> String
$cshow :: StructurePipeline -> String
showsPrec :: Int -> StructurePipeline -> ShowS
$cshowsPrec :: Int -> StructurePipeline -> ShowS
Show)
data StructureTest = StructureTest StructurePipeline AstMetrics
deriving (Int -> StructureTest -> ShowS
[StructureTest] -> ShowS
StructureTest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StructureTest] -> ShowS
$cshowList :: [StructureTest] -> ShowS
show :: StructureTest -> String
$cshow :: StructureTest -> String
showsPrec :: Int -> StructureTest -> ShowS
$cshowsPrec :: Int -> StructureTest -> ShowS
Show)
data WarningTest = ExpectedWarning T.Text Regex
instance Show WarningTest where
show :: WarningTest -> String
show (ExpectedWarning Text
r Regex
_) = String
"ExpectedWarning " forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
r
data TestRun = TestRun
{ TestRun -> [String]
runTags :: [String],
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestRun] -> ShowS
$cshowList :: [TestRun] -> ShowS
show :: TestRun -> String
$cshow :: TestRun -> String
showsPrec :: Int -> TestRun -> ShowS
$cshowsPrec :: Int -> TestRun -> ShowS
Show)
data Values
= Values [V.Value]
| InFile FilePath
| GenValues [GenValue]
| ScriptValues Script.Exp
| ScriptFile FilePath
deriving (Int -> Values -> ShowS
[Values] -> ShowS
Values -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Values] -> ShowS
$cshowList :: [Values] -> ShowS
show :: Values -> String
$cshow :: Values -> String
showsPrec :: Int -> Values -> ShowS
$cshowsPrec :: Int -> Values -> ShowS
Show)
data GenValue
=
GenValue V.ValueType
|
GenPrim V.Value
deriving (Int -> GenValue -> ShowS
[GenValue] -> ShowS
GenValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenValue] -> ShowS
$cshowList :: [GenValue] -> ShowS
show :: GenValue -> String
$cshow :: GenValue -> String
showsPrec :: Int -> GenValue -> ShowS
$cshowsPrec :: Int -> GenValue -> ShowS
Show)
genValueType :: GenValue -> T.Text
genValueType :: GenValue -> Text
genValueType (GenValue (V.ValueType [Int]
ds PrimType
t)) =
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Int
d -> Text
"[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showText Int
d forall a. Semigroup a => a -> a -> a
<> Text
"]") [Int]
ds forall a. Semigroup a => a -> a -> a
<> PrimType -> Text
V.primTypeText PrimType
t
genValueType (GenPrim Value
v) =
Value -> Text
V.valueText Value
v
data ExpectedResult values
=
Succeeds (Maybe values)
|
RunTimeFailure ExpectedError
deriving (Int -> ExpectedResult values -> ShowS
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
showList :: [ExpectedResult values] -> ShowS
$cshowList :: forall values. Show values => [ExpectedResult values] -> ShowS
show :: ExpectedResult values -> String
$cshow :: forall values. Show values => ExpectedResult values -> String
showsPrec :: Int -> ExpectedResult values -> ShowS
$cshowsPrec :: forall values. Show values => Int -> ExpectedResult values -> ShowS
Show)
data Success
=
SuccessValues Values
|
SuccessGenerateValues
deriving (Int -> Success -> ShowS
[Success] -> ShowS
Success -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Success] -> ShowS
$cshowList :: [Success] -> ShowS
show :: Success -> String
$cshow :: Success -> String
showsPrec :: Int -> Success -> ShowS
$cshowsPrec :: Int -> 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 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
sep
lexeme' :: Parser a -> Parser a
lexeme' :: forall a. Parser a -> Parser a
lexeme' Parser a
p = Parser a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
lexstr' :: T.Text -> Parser ()
lexstr' :: Text -> Parser ()
lexstr' = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Parser a
lexeme' forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep 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 =
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}. Num a => a -> a -> a
addDigit Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
num forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some 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 forall {a}. Num a => a -> a -> a
* a
10 forall {a}. Num a => a -> a -> a
+ a
x
num :: Char -> Int
num Char
c = Char -> Int
ord Char
c 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 forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol else forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
l
restOfLine_ :: Parser T.Text
restOfLine_ :: Parser Text
restOfLine_ = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/= Char
'\n')
parseDescription :: Parser () -> Parser T.Text
parseDescription :: Parser () -> Parser Text
parseDescription Parser ()
sep =
[Text] -> Text
T.unlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
pDescLine forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` Parser ()
pDescriptionSeparator
where
pDescLine :: Parser Text
pDescLine = Parser Text
restOfLine forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
sep
pDescriptionSeparator :: Parser ()
pDescriptionSeparator = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Parser Text
"==" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
sep
parseTags :: Parser () -> Parser [T.Text]
parseTags :: Parser () -> ParsecT Void Text Identity [Text]
parseTags Parser ()
sep = forall a. Parser a -> Parser a
lexeme' Parser Text
"tags" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parser () -> Parser a -> Parser a
inBraces Parser ()
sep (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text
parseTag) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
where
parseTag :: Parser Text
parseTag = String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep (forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
tagConstituent)
tagConstituent :: Char -> Bool
tagConstituent :: Char -> Bool
tagConstituent Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'
parseAction :: Parser () -> Parser TestAction
parseAction :: Parser () -> Parser TestAction
parseAction Parser ()
sep =
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ ExpectedError -> TestAction
CompileTimeFailure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser ()
lexstr' Text
"error:" 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
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser [InputOutputs]
parseInputOutputs Parser ()
sep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser () -> Parser StructureTest
parseExpectedStructure Parser ()
sep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser () -> Parser WarningTest
parseWarning Parser ()
sep)
]
parseInputOutputs :: Parser () -> Parser [InputOutputs]
parseInputOutputs :: Parser () -> Parser [InputOutputs]
parseInputOutputs Parser ()
sep = do
[Text]
entrys <- Parser () -> ParsecT Void Text Identity [Text]
parseEntryPoints Parser ()
sep
[TestRun]
cases <- Parser () -> Parser [TestRun]
parseRunCases Parser ()
sep
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TestRun]
cases
then []
else 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 =
(forall a. Parser a -> Parser a
lexeme' Parser Text
"entry:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text
entry forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
sep) forall (f :: * -> *) a. Alternative f => f a -> f a -> f 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 forall a. Eq a => a -> a -> Bool
/= Char
'}'
entry :: Parser Text
entry = forall a. Parser a -> Parser a
lexeme' forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
constituent)
parseRunTags :: Parser [String]
parseRunTags :: Parser [String]
parseRunTags = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Parser a
lexeme' forall a b. (a -> b) -> a -> b
$ do
String
s <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
tagConstituent
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"input", String
"structure", String
"warning"]
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s
parseStringLiteral :: Parser () -> Parser T.Text
parseStringLiteral :: Parser () -> Parser Text
parseStringLiteral Parser ()
sep =
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
charLiteral (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"')
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 =
(:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Void Text Identity TestRun
parseRunCase Int
i forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser [TestRun]
parseRunCases' (Int
i forall {a}. Num a => a -> a -> a
+ Int
1)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
parseRunCase :: Int -> ParsecT Void Text Identity TestRun
parseRunCase Int
i = do
Maybe Text
name <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ Parser () -> Parser Text
parseStringLiteral Parser ()
sep
[String]
tags <- Parser [String]
parseRunTags
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"input"
Values
input <-
if String
"random" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
tags
then Parser () -> Parser Values
parseRandomValues Parser ()
sep
else
if String
"script" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
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
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [String]
-> Values -> ExpectedResult Success -> Int -> Text -> TestRun
TestRun [String]
tags Values
input ExpectedResult Success
expr Int
i forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall {a}. Show a => a -> Values -> Text
desc Int
i Values
input) Maybe Text
name
desc :: a -> Values -> Text
desc a
_ (InFile String
path)
| ShowS
takeExtension String
path forall a. Eq a => a -> a -> Bool
== String
".gz" = String -> Text
T.pack 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) =
Text
"#" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showText a
i forall a. Semigroup a => a -> a -> a
<> Text
" (\"" forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords (Text -> [Text]
T.lines Text
vs') forall a. Semigroup a => a -> a -> a
<> Text
"\")"
where
vs' :: Text
vs' = case [Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Value -> Text
V.valueText [Value]
vs of
Text
s
| Text -> Int
T.length Text
s forall a. Ord a => a -> a -> Bool
> Int
50 -> Int -> Text -> Text
T.take Int
50 Text
s forall a. Semigroup a => a -> a -> a
<> Text
"..."
| Bool
otherwise -> Text
s
desc a
_ (GenValues [GenValue]
gens) =
[Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map GenValue -> Text
genValueType [GenValue]
gens
desc a
_ (ScriptValues Exp
e) =
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 =
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"auto" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"output" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall values. Maybe values -> ExpectedResult values
Succeeds (forall a. a -> Maybe a
Just Success
SuccessGenerateValues),
forall values. Maybe values -> ExpectedResult values
Succeeds forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values -> Success
SuccessValues forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"output" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> Parser Values
parseValues Parser ()
sep),
forall values. ExpectedError -> ExpectedResult values
RunTimeFailure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"error:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> ParsecT Void Text Identity ExpectedError
parseExpectedError Parser ()
sep),
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall values. Maybe values -> ExpectedResult values
Succeeds forall a. Maybe a
Nothing)
]
parseExpectedError :: Parser () -> Parser ExpectedError
parseExpectedError :: Parser () -> ParsecT Void Text Identity ExpectedError
parseExpectedError Parser ()
sep = forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep forall a b. (a -> b) -> a -> b
$ do
Text
s <- Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
restOfLine_ forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
sep
if Text -> Bool
T.null Text
s
then forall (f :: * -> *) a. Applicative f => a -> f a
pure ExpectedError
AnyError
else
Text -> Regex -> ExpectedError
ThisError Text
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall regex compOpt execOpt source (m :: * -> *).
(RegexMaker regex compOpt execOpt source, MonadFail m) =>
compOpt -> execOpt -> source -> m regex
makeRegexOptsM forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
blankCompOpt 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 =
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ Exp -> Values
ScriptValues forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser () -> Parser a -> Parser a
inBraces Parser ()
sep (Parser () -> Parsec Void Text Exp
Script.parseExp Parser ()
sep),
String -> Values
ScriptFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"@" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity (Tokens Text)
nextWord)
]
where
nextWord :: ParsecT Void Text Identity (Tokens Text)
nextWord = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser () -> Parser a -> Parser a
inBraces Parser ()
sep (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser () -> Parser GenValue
parseGenValue Parser ()
sep))
parseGenValue :: Parser () -> Parser GenValue
parseGenValue :: Parser () -> Parser GenValue
parseGenValue Parser ()
sep =
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ ValueType -> GenValue
GenValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parsec Void Text ValueType
parseType,
Value -> GenValue
GenPrim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parsec Void Text Value
V.parsePrimValue
]
parseValues :: Parser () -> Parser Values
parseValues :: Parser () -> Parser Values
parseValues Parser ()
sep =
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ [Value] -> Values
Values forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser () -> Parser a -> Parser a
inBraces Parser ()
sep (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ Parser () -> Parsec Void Text Value
parseValue Parser ()
sep),
String -> Values
InFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"@" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity (Tokens Text)
nextWord)
]
where
nextWord :: ParsecT Void Text Identity (Tokens Text)
nextWord = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace
parseWarning :: Parser () -> Parser WarningTest
parseWarning :: Parser () -> Parser WarningTest
parseWarning Parser ()
sep = forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"warning:" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser WarningTest
parseExpectedWarning
where
parseExpectedWarning :: Parser WarningTest
parseExpectedWarning = forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep forall a b. (a -> b) -> a -> b
$ do
Text
s <- Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
restOfLine_
Text -> Regex -> WarningTest
ExpectedWarning Text
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall regex compOpt execOpt source (m :: * -> *).
(RegexMaker regex compOpt execOpt source, MonadFail m) =>
compOpt -> execOpt -> source -> m regex
makeRegexOptsM forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
blankCompOpt forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt (Text -> String
T.unpack Text
s)
parseExpectedStructure :: Parser () -> Parser StructureTest
parseExpectedStructure :: Parser () -> Parser StructureTest
parseExpectedStructure Parser ()
sep =
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"structure" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (StructurePipeline -> AstMetrics -> StructureTest
StructureTest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser StructurePipeline
optimisePipeline Parser ()
sep forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser () -> Parser AstMetrics
parseMetrics Parser ()
sep)
optimisePipeline :: Parser () -> Parser StructurePipeline
optimisePipeline :: Parser () -> Parser StructurePipeline
optimisePipeline Parser ()
sep =
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"gpu-mem" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
GpuMemPipeline,
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"gpu" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
GpuPipeline,
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"mc-mem" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
MCMemPipeline,
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"mc" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
MCPipeline,
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"seq-mem" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
SeqMemPipeline,
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser Text
"internalised" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
NoPipeline,
forall (f :: * -> *) a. Applicative f => a -> f a
pure StructurePipeline
SOACSPipeline
]
parseMetrics :: Parser () -> Parser AstMetrics
parseMetrics :: Parser () -> Parser AstMetrics
parseMetrics Parser ()
sep =
forall a. Parser () -> Parser a -> Parser a
inBraces Parser ()
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Text Int -> AstMetrics
AstMetrics forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$
(,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep (forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
constituent))) 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 forall a. Eq a => a -> a -> Bool
== Char
'/'
testSpec :: Parser () -> Parser ProgramTest
testSpec :: Parser () -> Parser ProgramTest
testSpec Parser ()
sep =
Text -> [Text] -> TestAction -> ProgramTest
ProgramTest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser Text
parseDescription Parser ()
sep forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser () -> ParsecT Void Text Identity [Text]
parseTags Parser ()
sep 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
pProgramTest :: Parser ProgramTest
pProgramTest :: Parser ProgramTest
pProgramTest = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ()
pNonTestLine
Maybe ProgramTest
maybe_spec <-
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text
"--" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
sep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> Parser ProgramTest
testSpec Parser ()
sep) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
pEndOfTestBlock forall (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ Parser [InputOutputs]
pInputOutputs forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ()
pNonTestLine
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramTest
spec {testAction :: TestAction
testAction = [InputOutputs] -> [StructureTest] -> [WarningTest] -> TestAction
RunCases ([InputOutputs]
old_cases forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[InputOutputs]]
cases) [StructureTest]
structures [WarningTest]
warnings}
| Bool
otherwise ->
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ()
pNonTestLine
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser Text
"-- =="
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramTest
spec
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 ->
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ProgramTest
noTest
where
sep :: Parser ()
sep = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
"--" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
sep)
noTest :: ProgramTest
noTest =
Text -> [Text] -> TestAction -> ProgramTest
ProgramTest forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty ([InputOutputs] -> [StructureTest] -> [WarningTest] -> TestAction
RunCases forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
pEndOfTestBlock :: Parser ()
pEndOfTestBlock =
(forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser Text
"--"
pNonTestLine :: Parser ()
pNonTestLine =
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser Text
"-- ==" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
restOfLine
pInputOutputs :: Parser [InputOutputs]
pInputOutputs =
Parser Text
"--" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
sep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> Parser Text
parseDescription Parser ()
sep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> Parser [InputOutputs]
parseInputOutputs Parser ()
sep 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 {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramTest
pt
RunCases [InputOutputs]
ios [StructureTest]
_ [WarningTest]
_ -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Text] -> Either String ()
noDups forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map TestRun -> Text
runDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOutputs -> [TestRun]
iosTestRuns) [InputOutputs]
ios
forall a b. b -> Either a b
Right ProgramTest
pt
where
noDups :: [Text] -> Either String ()
noDups [Text]
xs =
let xs' :: [Text]
xs' = forall a. Ord a => [a] -> [a]
nubOrd [Text]
xs
in
case [Text]
xs forall a. Eq a => [a] -> [a] -> [a]
\\ [Text]
xs' of
[] -> forall a b. b -> Either a b
Right ()
Text
x : [Text]
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
path forall a. Semigroup a => a -> a -> a
<> String
": multiple datasets with name " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Text -> String
T.unpack Text
x)
testSpecFromProgram :: FilePath -> IO (Either String ProgramTest)
testSpecFromProgram :: String -> IO (Either String ProgramTest)
testSpecFromProgram String
path =
( forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty) (String -> ProgramTest -> Either String ProgramTest
validate String
path) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parser ProgramTest
pProgramTest String
path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
path
)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. IOError -> IO (Either String a)
couldNotRead
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
forall a. IO a
exitFailure
Right ProgramTest
spec -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramTest
spec
testPrograms :: FilePath -> IO [FilePath]
testPrograms :: String -> IO [String]
testPrograms String
dir = forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isFut forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
directoryContents String
dir
where
isFut :: String -> Bool
isFut = (forall a. Eq a => a -> a -> Bool
== String
".fut") forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension
testSpecsFromPath :: FilePath -> IO (Either String [(FilePath, ProgramTest)])
testSpecsFromPath :: String -> IO (Either String [(String, ProgramTest)])
testSpecsFromPath String
path = do
Either String [String]
programs_or_err <- (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
testPrograms String
path) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. IOError -> IO (Either String a)
couldNotRead
case Either String [String]
programs_or_err of
Left String
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
err
Right [String]
programs -> do
[Either String ProgramTest]
specs_or_errs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Either String ProgramTest)
testSpecFromProgram [String]
programs
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [String]
programs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Either String ProgramTest]
specs_or_errs
testSpecsFromPaths ::
[FilePath] ->
IO (Either String [(FilePath, ProgramTest)])
testSpecsFromPaths :: [String] -> IO (Either String [(String, ProgramTest)])
testSpecsFromPaths = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Either String [(String, ProgramTest)])
testSpecsFromPath
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
forall a. IO a
exitFailure
Right [(String, ProgramTest)]
specs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [(String, ProgramTest)]
specs
testSpecFromFile :: FilePath -> IO (Either String ProgramTest)
testSpecFromFile :: String -> IO (Either String ProgramTest)
testSpecFromFile String
path =
( forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parser () -> Parser ProgramTest
testSpec forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) String
path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
path
)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. IOError -> IO (Either String a)
couldNotRead
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
forall a. IO a
exitFailure
Right ProgramTest
spec -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramTest
spec