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)
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.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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ProgramTest] -> ShowS
$cshowList :: [ProgramTest] -> ShowS
show :: ProgramTest -> [Char]
$cshow :: ProgramTest -> [Char]
showsPrec :: Int -> ProgramTest -> ShowS
$cshowsPrec :: Int -> ProgramTest -> ShowS
Show)
data TestAction
= CompileTimeFailure ExpectedError
| RunCases [InputOutputs] [StructureTest] [WarningTest]
deriving (Int -> TestAction -> ShowS
[TestAction] -> ShowS
TestAction -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TestAction] -> ShowS
$cshowList :: [TestAction] -> ShowS
show :: TestAction -> [Char]
$cshow :: TestAction -> [Char]
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [InputOutputs] -> ShowS
$cshowList :: [InputOutputs] -> ShowS
show :: InputOutputs -> [Char]
$cshow :: InputOutputs -> [Char]
showsPrec :: Int -> InputOutputs -> ShowS
$cshowsPrec :: Int -> InputOutputs -> ShowS
Show)
data ExpectedError
= AnyError
| ThisError T.Text Regex
instance Show ExpectedError where
show :: ExpectedError -> [Char]
show ExpectedError
AnyError = [Char]
"AnyError"
show (ThisError Text
r Regex
_) = [Char]
"ThisError " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
r
data StructurePipeline
= GpuPipeline
| SOACSPipeline
| SeqMemPipeline
| GpuMemPipeline
| NoPipeline
deriving (Int -> StructurePipeline -> ShowS
[StructurePipeline] -> ShowS
StructurePipeline -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [StructurePipeline] -> ShowS
$cshowList :: [StructurePipeline] -> ShowS
show :: StructurePipeline -> [Char]
$cshow :: StructurePipeline -> [Char]
showsPrec :: Int -> StructurePipeline -> ShowS
$cshowsPrec :: Int -> StructurePipeline -> ShowS
Show)
data StructureTest = StructureTest StructurePipeline AstMetrics
deriving (Int -> StructureTest -> ShowS
[StructureTest] -> ShowS
StructureTest -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [StructureTest] -> ShowS
$cshowList :: [StructureTest] -> ShowS
show :: StructureTest -> [Char]
$cshow :: StructureTest -> [Char]
showsPrec :: Int -> StructureTest -> ShowS
$cshowsPrec :: Int -> StructureTest -> ShowS
Show)
data WarningTest = ExpectedWarning T.Text Regex
instance Show WarningTest where
show :: WarningTest -> [Char]
show (ExpectedWarning Text
r Regex
_) = [Char]
"ExpectedWarning " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
r
data TestRun = TestRun
{ TestRun -> [[Char]]
runTags :: [String],
TestRun -> Values
runInput :: Values,
TestRun -> ExpectedResult Success
runExpectedResult :: ExpectedResult Success,
TestRun -> Int
runIndex :: Int,
TestRun -> [Char]
runDescription :: String
}
deriving (Int -> TestRun -> ShowS
[TestRun] -> ShowS
TestRun -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TestRun] -> ShowS
$cshowList :: [TestRun] -> ShowS
show :: TestRun -> [Char]
$cshow :: TestRun -> [Char]
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Values] -> ShowS
$cshowList :: [Values] -> ShowS
show :: Values -> [Char]
$cshow :: Values -> [Char]
showsPrec :: Int -> Values -> ShowS
$cshowsPrec :: Int -> Values -> ShowS
Show)
data GenValue
=
GenValue V.ValueType
|
GenPrim V.Value
deriving (Int -> GenValue -> ShowS
[GenValue] -> ShowS
GenValue -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [GenValue] -> ShowS
$cshowList :: [GenValue] -> ShowS
show :: GenValue -> [Char]
$cshow :: GenValue -> [Char]
showsPrec :: Int -> GenValue -> ShowS
$cshowsPrec :: Int -> GenValue -> ShowS
Show)
genValueType :: GenValue -> String
genValueType :: GenValue -> [Char]
genValueType (GenValue (V.ValueType [Int]
ds PrimType
t)) =
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Int
d -> [Char]
"[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
d forall a. [a] -> [a] -> [a]
++ [Char]
"]") [Int]
ds forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (PrimType -> Text
V.primTypeText PrimType
t)
genValueType (GenPrim Value
v) =
Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ 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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ExpectedResult values] -> ShowS
$cshowList :: forall values. Show values => [ExpectedResult values] -> ShowS
show :: ExpectedResult values -> [Char]
$cshow :: forall values. Show values => ExpectedResult values -> [Char]
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Success] -> ShowS
$cshowList :: [Success] -> ShowS
show :: Success -> [Char]
$cshow :: Success -> [Char]
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 [Char] -> (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 = [Char] -> 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
$ [Char] -> 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 [[Char]]
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
[Char]
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
$ [Char]
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[Char]
"input", [Char]
"structure", [Char]
"warning"]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
s
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
[[Char]]
tags <- Parser [[Char]]
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 [Char]
"random" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
tags
then Parser () -> Parser Values
parseRandomValues Parser ()
sep
else
if [Char]
"script" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
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
$ [[Char]]
-> Values -> ExpectedResult Success -> Int -> [Char] -> TestRun
TestRun [[Char]]
tags Values
input ExpectedResult Success
expr Int
i forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => a -> Values -> [Char]
desc Int
i Values
input
desc :: a -> Values -> [Char]
desc a
_ (InFile [Char]
path)
| ShowS
takeExtension [Char]
path forall a. Eq a => a -> a -> Bool
== [Char]
".gz" = ShowS
dropExtension [Char]
path
| Bool
otherwise = [Char]
path
desc a
i (Values [Value]
vs) =
[Char]
"#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
i forall a. [a] -> [a] -> [a]
++ [Char]
" (\"" forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords ([Char] -> [[Char]]
lines [Char]
vs') forall a. [a] -> [a] -> [a]
++ [Char]
"\")"
where
vs' :: [Char]
vs' = case [[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
V.valueText) [Value]
vs of
[Char]
s
| forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s forall a. Ord a => a -> a -> Bool
> Int
50 -> forall a. Int -> [a] -> [a]
take Int
50 [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
"..."
| Bool
otherwise -> [Char]
s
desc a
_ (GenValues [GenValue]
gens) =
[[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map GenValue -> [Char]
genValueType [GenValue]
gens
desc a
_ (ScriptValues Exp
e) =
Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Text
prettyTextOneLine Exp
e
desc a
_ (ScriptFile [Char]
path) =
[Char]
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 -> [Char]
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),
[Char] -> Values
ScriptFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
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 [Char] -> (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),
[Char] -> Values
InFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
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 [Char] -> (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 -> [Char]
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
"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
<$> ([Char] -> 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 [Char] 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 -> [Char]
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 -> [Char] -> m a
<?> [Char]
"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
testSpecFromProgram :: FilePath -> IO (Either String ProgramTest)
testSpecFromProgram :: [Char] -> IO (Either [Char] ProgramTest)
testSpecFromProgram [Char]
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 -> [Char]
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 -> [Char] -> s -> Either (ParseErrorBundle s e) a
parse Parser ProgramTest
pProgramTest [Char]
path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Text
T.readFile [Char]
path
)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. IOError -> IO (Either [Char] a)
couldNotRead
testSpecFromProgramOrDie :: FilePath -> IO ProgramTest
testSpecFromProgramOrDie :: [Char] -> IO ProgramTest
testSpecFromProgramOrDie [Char]
prog = do
Either [Char] ProgramTest
spec_or_err <- [Char] -> IO (Either [Char] ProgramTest)
testSpecFromProgram [Char]
prog
case Either [Char] ProgramTest
spec_or_err of
Left [Char]
err -> do
Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
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 :: [Char] -> IO [[Char]]
testPrograms [Char]
dir = forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
isFut forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [[Char]]
directoryContents [Char]
dir
where
isFut :: [Char] -> Bool
isFut = (forall a. Eq a => a -> a -> Bool
== [Char]
".fut") forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension
testSpecsFromPath :: FilePath -> IO (Either String [(FilePath, ProgramTest)])
testSpecsFromPath :: [Char] -> IO (Either [Char] [([Char], ProgramTest)])
testSpecsFromPath [Char]
path = do
Either [Char] [[Char]]
programs_or_err <- (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [[Char]]
testPrograms [Char]
path) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. IOError -> IO (Either [Char] a)
couldNotRead
case Either [Char] [[Char]]
programs_or_err of
Left [Char]
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 [Char]
err
Right [[Char]]
programs -> do
[Either [Char] ProgramTest]
specs_or_errs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO (Either [Char] ProgramTest)
testSpecFromProgram [[Char]]
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 [[Char]]
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 [Char] ProgramTest]
specs_or_errs
testSpecsFromPaths ::
[FilePath] ->
IO (Either String [(FilePath, ProgramTest)])
testSpecsFromPaths :: [[Char]] -> IO (Either [Char] [([Char], 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 [Char] -> IO (Either [Char] [([Char], ProgramTest)])
testSpecsFromPath
testSpecsFromPathsOrDie ::
[FilePath] ->
IO [(FilePath, ProgramTest)]
testSpecsFromPathsOrDie :: [[Char]] -> IO [([Char], ProgramTest)]
testSpecsFromPathsOrDie [[Char]]
dirs = do
Either [Char] [([Char], ProgramTest)]
specs_or_err <- [[Char]] -> IO (Either [Char] [([Char], ProgramTest)])
testSpecsFromPaths [[Char]]
dirs
case Either [Char] [([Char], ProgramTest)]
specs_or_err of
Left [Char]
err -> do
Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err
forall a. IO a
exitFailure
Right [([Char], ProgramTest)]
specs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [([Char], ProgramTest)]
specs
testSpecFromFile :: FilePath -> IO (Either String ProgramTest)
testSpecFromFile :: [Char] -> IO (Either [Char] ProgramTest)
testSpecFromFile [Char]
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 -> [Char]
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 -> [Char] -> s -> Either (ParseErrorBundle s e) a
parse (Parser () -> Parser ProgramTest
testSpec forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) [Char]
path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Text
T.readFile [Char]
path
)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. IOError -> IO (Either [Char] a)
couldNotRead
testSpecFromFileOrDie :: FilePath -> IO ProgramTest
testSpecFromFileOrDie :: [Char] -> IO ProgramTest
testSpecFromFileOrDie [Char]
dirs = do
Either [Char] ProgramTest
spec_or_err <- [Char] -> IO (Either [Char] ProgramTest)
testSpecFromFile [Char]
dirs
case Either [Char] ProgramTest
spec_or_err of
Left [Char]
err -> do
Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err
forall a. IO a
exitFailure
Right ProgramTest
spec -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramTest
spec