{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
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 qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Void
import Futhark.Analysis.Metrics.Type
import Futhark.Data.Parser
import qualified Futhark.Data.Parser as V
import qualified Futhark.Script as Script
import qualified Futhark.Test.Values as V
import Futhark.Util (directoryContents)
import Futhark.Util.Pretty (prettyOneLine)
import System.Exit
import System.FilePath
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 -> String
(Int -> ProgramTest -> ShowS)
-> (ProgramTest -> String)
-> ([ProgramTest] -> ShowS)
-> Show ProgramTest
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
(Int -> TestAction -> ShowS)
-> (TestAction -> String)
-> ([TestAction] -> ShowS)
-> Show TestAction
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
(Int -> InputOutputs -> ShowS)
-> (InputOutputs -> String)
-> ([InputOutputs] -> ShowS)
-> Show InputOutputs
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 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
r
data StructurePipeline
= GpuPipeline
| SOACSPipeline
| SeqMemPipeline
| GpuMemPipeline
| 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
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
(Int -> StructureTest -> ShowS)
-> (StructureTest -> String)
-> ([StructureTest] -> ShowS)
-> Show StructureTest
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 " String -> ShowS
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 -> String
runDescription :: String
}
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
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
(Int -> Values -> ShowS)
-> (Values -> String) -> ([Values] -> ShowS) -> Show Values
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
(Int -> GenValue -> ShowS)
-> (GenValue -> String) -> ([GenValue] -> ShowS) -> Show GenValue
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 -> String
genValueType :: GenValue -> String
genValueType (GenValue (V.ValueType [Int]
ds PrimType
t)) =
(Int -> String) -> [Int] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Int
d -> String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]") [Int]
ds String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (PrimType -> Text
V.primTypeText PrimType
t)
genValueType (GenPrim Value
v) =
Text -> String
T.unpack (Text -> String) -> Text -> String
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
[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
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
(Int -> Success -> ShowS)
-> (Success -> String) -> ([Success] -> ShowS) -> Show Success
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 :: Parser () -> Parser a -> Parser a
lexeme Parser ()
sep Parser a
p = Parser a
p Parser a -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
sep
lexeme' :: Parser a -> Parser a
lexeme' :: Parser a -> Parser a
lexeme' Parser a
p = Parser a
p Parser a -> Parser () -> Parser 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
lexstr' :: T.Text -> Parser ()
lexstr' :: Text -> Parser ()
lexstr' = ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> Parser ())
-> (Text -> ParsecT Void Text Identity Text) -> Text -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text)
-> (Text -> ParsecT Void Text Identity Text)
-> Text
-> ParsecT Void Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme' (ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text)
-> (Text -> ParsecT Void Text Identity Text)
-> Text
-> ParsecT Void Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string
inBraces :: Parser () -> Parser a -> Parser a
inBraces :: Parser () -> Parser a -> Parser a
inBraces Parser ()
sep = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Parser ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity Text
"{") (Parser ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity 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 (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
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 (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Void Text Identity Char
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 :: ParsecT Void Text Identity Text
restOfLine = do
Text
l <- ParsecT Void Text Identity Text
restOfLine_
if Text -> Bool
T.null Text
l then ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol else ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
Text -> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
l
restOfLine_ :: Parser T.Text
restOfLine_ :: ParsecT Void Text Identity 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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
parseDescription :: Parser () -> Parser T.Text
parseDescription :: Parser () -> ParsecT Void Text Identity Text
parseDescription Parser ()
sep =
[Text] -> Text
T.unlines ([Text] -> Text)
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
pDescLine ParsecT Void Text Identity Text
-> Parser () -> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` Parser ()
pDescriptionSeparator
where
pDescLine :: ParsecT Void Text Identity Text
pDescLine = ParsecT Void Text Identity Text
restOfLine ParsecT Void Text Identity Text
-> Parser () -> ParsecT Void Text Identity Text
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
$ ParsecT Void Text Identity Text
"==" ParsecT Void Text Identity Text -> Parser () -> Parser ()
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 = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme' ParsecT Void Text Identity Text
"tags" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity [Text]
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 (ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void Text Identity Text
parseTag) ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text] -> ParsecT Void Text Identity [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
where
parseTag :: ParsecT Void Text Identity Text
parseTag = String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ()
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
tagConstituent)
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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity StructureTest
-> ParsecT Void Text Identity [StructureTest]
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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity WarningTest
-> ParsecT Void Text Identity [WarningTest]
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 (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 (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 =
(ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme' ParsecT Void Text Identity Text
"entry:" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void Text Identity Text
entry ParsecT Void Text Identity [Text]
-> Parser () -> ParsecT Void Text Identity [Text]
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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text] -> ParsecT Void Text Identity [Text]
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 Text
entry = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme' (ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
constituent)
parseRunTags :: Parser [String]
parseRunTags :: Parser [String]
parseRunTags = ParsecT Void Text Identity String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void Text Identity String -> Parser [String])
-> (ParsecT Void Text Identity String
-> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity String
-> Parser [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity String
-> ParsecT Void Text Identity String)
-> (ParsecT Void Text Identity String
-> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a. Parser a -> Parser a
lexeme' (ParsecT Void Text Identity String -> Parser [String])
-> ParsecT Void Text Identity String -> Parser [String]
forall a b. (a -> b) -> a -> b
$ do
String
s <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
tagConstituent
Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"input", String
"structure", String
"warning"]
String -> ParsecT Void Text Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
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 =
(:) (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 (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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [TestRun] -> Parser [TestRun]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
parseRunCase :: Int -> ParsecT Void Text Identity TestRun
parseRunCase Int
i = do
[String]
tags <- Parser [String]
parseRunTags
ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> Parser ())
-> ParsecT Void Text Identity Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity Text
"input"
Values
input <-
if String
"random" String -> [String] -> Bool
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" String -> [String] -> Bool
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
TestRun -> ParsecT Void Text Identity TestRun
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
$ [String]
-> Values -> ExpectedResult Success -> Int -> String -> TestRun
TestRun [String]
tags Values
input ExpectedResult Success
expr Int
i (String -> TestRun) -> String -> TestRun
forall a b. (a -> b) -> a -> b
$ Int -> Values -> String
forall a. Show a => a -> Values -> String
desc Int
i Values
input
desc :: a -> Values -> String
desc a
_ (InFile String
path)
| ShowS
takeExtension String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".gz" = ShowS
dropExtension String
path
| Bool
otherwise = String
path
desc a
i (Values [Value]
vs) =
String
"#" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (String -> [String]
lines String
vs') String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\")"
where
vs' :: String
vs' = case [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Value -> String) -> [Value] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack (Text -> String) -> (Value -> Text) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
V.valueText) [Value]
vs of
String
s
| String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
50 -> Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
50 String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"..."
| Bool
otherwise -> String
s
desc a
_ (GenValues [GenValue]
gens) =
[String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (GenValue -> String) -> [GenValue] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map GenValue -> String
genValueType [GenValue]
gens
desc a
_ (ScriptValues Exp
e) =
Exp -> String
forall a. Pretty a => a -> String
prettyOneLine Exp
e
desc a
_ (ScriptFile String
path) =
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 ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity Text
"auto" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
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
lexeme Parser ()
sep ParsecT Void Text Identity Text
"output" ParsecT Void Text Identity 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 ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity Text
"output" ParsecT Void Text Identity Text -> Parser Values -> Parser Values
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 ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity Text
"error:" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ExpectedError
-> ParsecT Void Text Identity ExpectedError
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 (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)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
restOfLine_ ParsecT Void Text Identity Text
-> Parser () -> ParsecT Void Text Identity Text
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 (f :: * -> *) a. Applicative f => a -> f a
pure ExpectedError
AnyError
else
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
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)
-> ParsecT Void Text Identity Text -> Parser Values
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity Text
"@" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
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
lexeme Parser ()
sep ParsecT Void Text Identity 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 (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 (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)
-> ParsecT Void Text Identity Text -> Parser Values
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity Text
"@" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
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
lexeme Parser ()
sep ParsecT Void Text Identity 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 ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity Text
"warning:" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity WarningTest
-> ParsecT Void Text Identity WarningTest
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)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity 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
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 ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity Text
"structure" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity StructureTest
-> ParsecT Void Text Identity StructureTest
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 (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 ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity Text
"gpu-mem" ParsecT Void Text Identity Text
-> StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
GpuMemPipeline,
Parser ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity Text
"gpu" ParsecT Void Text Identity Text
-> StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
GpuPipeline,
Parser ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity Text
"seq-mem" ParsecT Void Text Identity Text
-> StructurePipeline
-> ParsecT Void Text Identity StructurePipeline
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StructurePipeline
SeqMemPipeline,
Parser ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep ParsecT Void Text Identity Text
"internalised" ParsecT Void Text Identity 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 (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 (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 (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))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Int -> (Text, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ()
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a. Parser () -> Parser a -> Parser a
lexeme Parser ()
sep (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
constituent))) ParsecT Void Text Identity (Int -> (Text, Int))
-> Parser Int -> ParsecT Void Text Identity (Text, Int)
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)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ([Text] -> TestAction -> ProgramTest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> ParsecT Void Text Identity Text
parseDescription Parser ()
sep ParsecT Void Text Identity ([Text] -> TestAction -> ProgramTest)
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity (TestAction -> ProgramTest)
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 (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 :: IOError -> IO (Either String a)
couldNotRead = Either String a -> IO (Either String 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 (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 (ParsecT Void Text Identity Text
"--" ParsecT Void Text Identity Text -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
sep Parser () -> Parser ProgramTest -> Parser ProgramTest
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 (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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> ParsecT Void Text Identity [()]
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 (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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> ParsecT Void Text Identity [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ()
pNonTestLine
ProgramTest -> Parser ProgramTest
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramTest
spec {testAction :: TestAction
testAction = [InputOutputs] -> [StructureTest] -> [WarningTest] -> TestAction
RunCases ([InputOutputs]
old_cases [InputOutputs] -> [InputOutputs] -> [InputOutputs]
forall a. [a] -> [a] -> [a]
++ [[InputOutputs]] -> [InputOutputs]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[InputOutputs]]
cases) [StructureTest]
structures [WarningTest]
warnings}
| Bool
otherwise ->
Parser () -> ParsecT Void Text Identity [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ()
pNonTestLine ParsecT Void Text Identity [()] -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT Void Text Identity Text
"-- ==" Parser () -> Parser ProgramTest -> Parser ProgramTest
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ProgramTest -> Parser ProgramTest
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 (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 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)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
"--" ParsecT Void Text Identity Text -> Parser () -> Parser ()
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 (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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT Void Text Identity Text
"--"
pNonTestLine :: Parser ()
pNonTestLine =
ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> Parser ())
-> ParsecT Void Text Identity Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Text -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT Void Text Identity Text
"-- ==" Parser ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
restOfLine
pInputOutputs :: ParsecT Void Text Identity [InputOutputs]
pInputOutputs =
ParsecT Void Text Identity Text
"--" ParsecT Void Text Identity Text -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
sep Parser ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> ParsecT Void Text Identity Text
parseDescription Parser ()
sep ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [InputOutputs]
-> ParsecT Void Text Identity [InputOutputs]
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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
pEndOfTestBlock
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) 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 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
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
String -> IO ()
putStrLn String
err
IO ProgramTest
forall a. IO a
exitFailure
Right ProgramTest
spec -> ProgramTest -> IO ProgramTest
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
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 (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)
mapM String -> IO (Either String ProgramTest)
testSpecFromProgram [String]
programs
Either String [(String, ProgramTest)]
-> IO (Either String [(String, ProgramTest)])
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)
sequence [Either String ProgramTest]
specs_or_errs
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 (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 (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)
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)
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
String -> IO ()
putStrLn String
err
IO [(String, ProgramTest)]
forall a. IO a
exitFailure
Right [(String, ProgramTest)]
specs -> [(String, ProgramTest)] -> IO [(String, ProgramTest)]
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 =
( (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
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
String -> IO ()
putStrLn String
err
IO ProgramTest
forall a. IO a
exitFailure
Right ProgramTest
spec -> ProgramTest -> IO ProgramTest
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramTest
spec