{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Test.Syd.OptParse where
import Autodocodec
import Control.Applicative
import Data.Maybe
import Data.Text (Text)
import GHC.Generics (Generic)
import OptEnvConf
import Path.IO
import Paths_sydtest (version)
import Test.Syd.Run
import Text.Colour
#ifdef mingw32_HOST_OS
import System.Console.ANSI (hSupportsANSIColor)
import System.IO (stdout)
#else
import Text.Colour.Capabilities.FromEnv
#endif
getSettings :: IO Settings
getSettings :: IO Settings
getSettings = Version -> String -> IO Settings
forall a. HasParser a => Version -> String -> IO a
runSettingsParser Version
version String
"A sydtest test suite"
data Settings = Settings
{
Settings -> SeedSetting
settingSeed :: !SeedSetting,
Settings -> Bool
settingRandomiseExecutionOrder :: !Bool,
Settings -> Threads
settingThreads :: !Threads,
Settings -> Int
settingMaxSuccess :: !Int,
Settings -> Int
settingMaxSize :: !Int,
Settings -> Int
settingMaxDiscard :: !Int,
Settings -> Int
settingMaxShrinks :: !Int,
Settings -> Bool
settingGoldenStart :: !Bool,
Settings -> Bool
settingGoldenReset :: !Bool,
Settings -> Maybe Bool
settingColour :: !(Maybe Bool),
Settings -> [Text]
settingFilters :: ![Text],
Settings -> Bool
settingFailFast :: !Bool,
Settings -> Iterations
settingIterations :: !Iterations,
Settings -> Word
settingRetries :: !Word,
Settings -> Bool
settingFailOnFlaky :: !Bool,
Settings -> ReportProgress
settingReportProgress :: !ReportProgress,
Settings -> Bool
settingProfile :: !Bool
}
deriving (Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
(Int -> Settings -> ShowS)
-> (Settings -> String) -> ([Settings] -> ShowS) -> Show Settings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Settings -> ShowS
showsPrec :: Int -> Settings -> ShowS
$cshow :: Settings -> String
show :: Settings -> String
$cshowList :: [Settings] -> ShowS
showList :: [Settings] -> ShowS
Show, Settings -> Settings -> Bool
(Settings -> Settings -> Bool)
-> (Settings -> Settings -> Bool) -> Eq Settings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Settings -> Settings -> Bool
== :: Settings -> Settings -> Bool
$c/= :: Settings -> Settings -> Bool
/= :: Settings -> Settings -> Bool
Eq, (forall x. Settings -> Rep Settings x)
-> (forall x. Rep Settings x -> Settings) -> Generic Settings
forall x. Rep Settings x -> Settings
forall x. Settings -> Rep Settings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Settings -> Rep Settings x
from :: forall x. Settings -> Rep Settings x
$cto :: forall x. Rep Settings x -> Settings
to :: forall x. Rep Settings x -> Settings
Generic)
instance HasParser Settings where
settingsParser :: Parser Settings
settingsParser =
String -> Parser Settings -> Parser Settings
forall a. String -> Parser a -> Parser a
subEnv_ String
"sydtest" (Parser Settings -> Parser Settings)
-> Parser Settings -> Parser Settings
forall a b. (a -> b) -> a -> b
$
Parser (Path Abs File) -> Parser Settings -> Parser Settings
forall a.
HasCallStack =>
Parser (Path Abs File) -> Parser a -> Parser a
withConfigurableYamlConfig (IO (Path Abs File) -> Parser (Path Abs File)
forall a. HasCallStack => IO a -> Parser a
runIO (IO (Path Abs File) -> Parser (Path Abs File))
-> IO (Path Abs File) -> Parser (Path Abs File)
forall a b. (a -> b) -> a -> b
$ String -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => String -> m (Path Abs File)
resolveFile' String
".sydtest.yaml") (Parser Settings -> Parser Settings)
-> Parser Settings -> Parser Settings
forall a b. (a -> b) -> a -> b
$
(Flags -> Either String Settings)
-> Parser Flags -> Parser Settings
forall a b.
HasCallStack =>
(a -> Either String b) -> Parser a -> Parser b
checkMapEither Flags -> Either String Settings
forall {a}. IsString a => Flags -> Either a Settings
combine Parser Flags
forall a. HasParser a => Parser a
settingsParser
where
combine :: Flags -> Either a Settings
combine Flags {Bool
Int
[Text]
Maybe Bool
Maybe Word
Maybe ReportProgress
Maybe Threads
SeedSetting
Iterations
flagSeed :: SeedSetting
flagRandomiseExecutionOrder :: Maybe Bool
flagThreads :: Maybe Threads
flagMaxSize :: Int
flagMaxSuccess :: Int
flagMaxDiscard :: Int
flagMaxShrinks :: Int
flagGoldenStart :: Bool
flagGoldenReset :: Bool
flagColour :: Maybe Bool
flagFilters :: [Text]
flagFailFast :: Maybe Bool
flagIterations :: Iterations
flagRetries :: Maybe Word
flagFailOnFlaky :: Bool
flagReportProgress :: Maybe ReportProgress
flagDebug :: Bool
flagProfile :: Bool
flagSeed :: Flags -> SeedSetting
flagRandomiseExecutionOrder :: Flags -> Maybe Bool
flagThreads :: Flags -> Maybe Threads
flagMaxSize :: Flags -> Int
flagMaxSuccess :: Flags -> Int
flagMaxDiscard :: Flags -> Int
flagMaxShrinks :: Flags -> Int
flagGoldenStart :: Flags -> Bool
flagGoldenReset :: Flags -> Bool
flagColour :: Flags -> Maybe Bool
flagFilters :: Flags -> [Text]
flagFailFast :: Flags -> Maybe Bool
flagIterations :: Flags -> Iterations
flagRetries :: Flags -> Maybe Word
flagFailOnFlaky :: Flags -> Bool
flagReportProgress :: Flags -> Maybe ReportProgress
flagDebug :: Flags -> Bool
flagProfile :: Flags -> Bool
..} = do
let d :: (Settings -> t) -> t
d Settings -> t
func = Settings -> t
func Settings
defaultSettings
let threads :: Threads
threads =
Threads -> Maybe Threads -> Threads
forall a. a -> Maybe a -> a
fromMaybe
( if Bool
flagDebug
then Threads
Synchronous
else (Settings -> Threads) -> Threads
forall {t}. (Settings -> t) -> t
d Settings -> Threads
settingThreads
)
Maybe Threads
flagThreads
ReportProgress
progress <- case Maybe ReportProgress
flagReportProgress of
Maybe ReportProgress
Nothing ->
ReportProgress -> Either a ReportProgress
forall a. a -> Either a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReportProgress -> Either a ReportProgress)
-> ReportProgress -> Either a ReportProgress
forall a b. (a -> b) -> a -> b
$
if Threads
threads Threads -> Threads -> Bool
forall a. Eq a => a -> a -> Bool
== Threads
Synchronous
then
if Bool
flagDebug
then ReportProgress
ReportProgress
else (Settings -> ReportProgress) -> ReportProgress
forall {t}. (Settings -> t) -> t
d Settings -> ReportProgress
settingReportProgress
else (Settings -> ReportProgress) -> ReportProgress
forall {t}. (Settings -> t) -> t
d Settings -> ReportProgress
settingReportProgress
Just ReportProgress
ReportProgress ->
if Threads
threads Threads -> Threads -> Bool
forall a. Eq a => a -> a -> Bool
/= Threads
Synchronous
then a -> Either a ReportProgress
forall a b. a -> Either a b
Left a
"Reporting progress in asynchronous runners is not supported. You can use --synchronous or --debug to use a synchronous runner."
else ReportProgress -> Either a ReportProgress
forall a. a -> Either a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReportProgress
ReportProgress
Just ReportProgress
ReportNoProgress -> ReportProgress -> Either a ReportProgress
forall a. a -> Either a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReportProgress
ReportNoProgress
pure
Settings
{ settingSeed :: SeedSetting
settingSeed = SeedSetting
flagSeed,
settingRandomiseExecutionOrder :: Bool
settingRandomiseExecutionOrder =
Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe
( if Bool
flagDebug
then Bool
False
else (Settings -> Bool) -> Bool
forall {t}. (Settings -> t) -> t
d Settings -> Bool
settingRandomiseExecutionOrder
)
Maybe Bool
flagRandomiseExecutionOrder,
settingThreads :: Threads
settingThreads = Threads
threads,
settingMaxSuccess :: Int
settingMaxSuccess = Int
flagMaxSuccess,
settingMaxSize :: Int
settingMaxSize = Int
flagMaxSize,
settingMaxDiscard :: Int
settingMaxDiscard = Int
flagMaxDiscard,
settingMaxShrinks :: Int
settingMaxShrinks = Int
flagMaxShrinks,
settingGoldenStart :: Bool
settingGoldenStart = Bool
flagGoldenStart,
settingGoldenReset :: Bool
settingGoldenReset = Bool
flagGoldenReset,
settingColour :: Maybe Bool
settingColour = Maybe Bool
flagColour,
settingFilters :: [Text]
settingFilters = [Text]
flagFilters,
settingFailFast :: Bool
settingFailFast =
Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe
( if Bool
flagDebug
then Bool
True
else (Settings -> Bool) -> Bool
forall {t}. (Settings -> t) -> t
d Settings -> Bool
settingFailFast
)
Maybe Bool
flagFailFast,
settingIterations :: Iterations
settingIterations = Iterations
flagIterations,
settingRetries :: Word
settingRetries =
Word -> Maybe Word -> Word
forall a. a -> Maybe a -> a
fromMaybe
( if Bool
flagDebug
then Word
0
else (Settings -> Word) -> Word
forall {t}. (Settings -> t) -> t
d Settings -> Word
settingRetries
)
Maybe Word
flagRetries,
settingFailOnFlaky :: Bool
settingFailOnFlaky = Bool
flagFailOnFlaky,
settingReportProgress :: ReportProgress
settingReportProgress = ReportProgress
progress,
settingProfile :: Bool
settingProfile = Bool
flagProfile
}
defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings =
let d :: (TestRunSettings -> t) -> t
d TestRunSettings -> t
func = TestRunSettings -> t
func TestRunSettings
defaultTestRunSettings
in Settings
{ settingSeed :: SeedSetting
settingSeed = (TestRunSettings -> SeedSetting) -> SeedSetting
forall {t}. (TestRunSettings -> t) -> t
d TestRunSettings -> SeedSetting
testRunSettingSeed,
settingRandomiseExecutionOrder :: Bool
settingRandomiseExecutionOrder = Bool
True,
settingThreads :: Threads
settingThreads = Threads
ByCapabilities,
settingMaxSuccess :: Int
settingMaxSuccess = (TestRunSettings -> Int) -> Int
forall {t}. (TestRunSettings -> t) -> t
d TestRunSettings -> Int
testRunSettingMaxSuccess,
settingMaxSize :: Int
settingMaxSize = (TestRunSettings -> Int) -> Int
forall {t}. (TestRunSettings -> t) -> t
d TestRunSettings -> Int
testRunSettingMaxSize,
settingMaxDiscard :: Int
settingMaxDiscard = (TestRunSettings -> Int) -> Int
forall {t}. (TestRunSettings -> t) -> t
d TestRunSettings -> Int
testRunSettingMaxDiscardRatio,
settingMaxShrinks :: Int
settingMaxShrinks = (TestRunSettings -> Int) -> Int
forall {t}. (TestRunSettings -> t) -> t
d TestRunSettings -> Int
testRunSettingMaxShrinks,
settingGoldenStart :: Bool
settingGoldenStart = (TestRunSettings -> Bool) -> Bool
forall {t}. (TestRunSettings -> t) -> t
d TestRunSettings -> Bool
testRunSettingGoldenStart,
settingGoldenReset :: Bool
settingGoldenReset = (TestRunSettings -> Bool) -> Bool
forall {t}. (TestRunSettings -> t) -> t
d TestRunSettings -> Bool
testRunSettingGoldenReset,
settingColour :: Maybe Bool
settingColour = Maybe Bool
forall a. Maybe a
Nothing,
settingFilters :: [Text]
settingFilters = [Text]
forall a. Monoid a => a
mempty,
settingFailFast :: Bool
settingFailFast = Bool
False,
settingIterations :: Iterations
settingIterations = Iterations
OneIteration,
settingRetries :: Word
settingRetries = Word
defaultRetries,
settingFailOnFlaky :: Bool
settingFailOnFlaky = Bool
False,
settingReportProgress :: ReportProgress
settingReportProgress = ReportProgress
ReportNoProgress,
settingProfile :: Bool
settingProfile = Bool
False
}
defaultRetries :: Word
defaultRetries :: Word
defaultRetries = Word
3
deriveTerminalCapababilities :: Settings -> IO TerminalCapabilities
deriveTerminalCapababilities :: Settings -> IO TerminalCapabilities
deriveTerminalCapababilities Settings
settings = case Settings -> Maybe Bool
settingColour Settings
settings of
Just Bool
False -> TerminalCapabilities -> IO TerminalCapabilities
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TerminalCapabilities
WithoutColours
Just Bool
True -> TerminalCapabilities -> IO TerminalCapabilities
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TerminalCapabilities
With8BitColours
Maybe Bool
Nothing -> IO TerminalCapabilities
detectTerminalCapabilities
#ifdef mingw32_HOST_OS
detectTerminalCapabilities :: IO TerminalCapabilities
detectTerminalCapabilities = do
supports <- hSupportsANSIColor stdout
if supports
then pure With8BitColours
else pure WithoutColours
#else
detectTerminalCapabilities :: IO TerminalCapabilities
detectTerminalCapabilities :: IO TerminalCapabilities
detectTerminalCapabilities = IO TerminalCapabilities
getTerminalCapabilitiesFromEnv
#endif
data Flags = Flags
{ Flags -> SeedSetting
flagSeed :: !SeedSetting,
Flags -> Maybe Bool
flagRandomiseExecutionOrder :: !(Maybe Bool),
Flags -> Maybe Threads
flagThreads :: !(Maybe Threads),
Flags -> Int
flagMaxSize :: !Int,
Flags -> Int
flagMaxSuccess :: !Int,
Flags -> Int
flagMaxDiscard :: !Int,
Flags -> Int
flagMaxShrinks :: !Int,
Flags -> Bool
flagGoldenStart :: !Bool,
Flags -> Bool
flagGoldenReset :: !Bool,
Flags -> Maybe Bool
flagColour :: !(Maybe Bool),
Flags -> [Text]
flagFilters :: ![Text],
Flags -> Maybe Bool
flagFailFast :: !(Maybe Bool),
Flags -> Iterations
flagIterations :: !Iterations,
Flags -> Maybe Word
flagRetries :: !(Maybe Word),
Flags -> Bool
flagFailOnFlaky :: !Bool,
Flags -> Maybe ReportProgress
flagReportProgress :: !(Maybe ReportProgress),
Flags -> Bool
flagDebug :: !Bool,
Flags -> Bool
flagProfile :: !Bool
}
deriving (Int -> Flags -> ShowS
[Flags] -> ShowS
Flags -> String
(Int -> Flags -> ShowS)
-> (Flags -> String) -> ([Flags] -> ShowS) -> Show Flags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Flags -> ShowS
showsPrec :: Int -> Flags -> ShowS
$cshow :: Flags -> String
show :: Flags -> String
$cshowList :: [Flags] -> ShowS
showList :: [Flags] -> ShowS
Show, Flags -> Flags -> Bool
(Flags -> Flags -> Bool) -> (Flags -> Flags -> Bool) -> Eq Flags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Flags -> Flags -> Bool
== :: Flags -> Flags -> Bool
$c/= :: Flags -> Flags -> Bool
/= :: Flags -> Flags -> Bool
Eq, (forall x. Flags -> Rep Flags x)
-> (forall x. Rep Flags x -> Flags) -> Generic Flags
forall x. Rep Flags x -> Flags
forall x. Flags -> Rep Flags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Flags -> Rep Flags x
from :: forall x. Flags -> Rep Flags x
$cto :: forall x. Rep Flags x -> Flags
to :: forall x. Rep Flags x -> Flags
Generic)
instance HasParser Flags where
settingsParser :: Parser Flags
settingsParser = do
SeedSetting
flagSeed <- Parser SeedSetting
forall a. HasParser a => Parser a
settingsParser
Maybe Bool
flagRandomiseExecutionOrder <-
Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Bool -> Parser (Maybe Bool))
-> Parser Bool -> Parser (Maybe Bool)
forall a b. (a -> b) -> a -> b
$
HasCallStack => [Builder Bool] -> Parser Bool
[Builder Bool] -> Parser Bool
yesNoSwitch
[ String -> Builder Bool
forall a. String -> Builder a
help String
"Run test suite in a random order",
String -> Builder Bool
forall a. HasCodec a => String -> Builder a
name String
"randomise-execution-order",
String -> Builder Bool
forall a. HasCodec a => String -> Builder a
name String
"randomize-execution-order"
]
Maybe Threads
flagThreads <- Parser Threads -> Parser (Maybe Threads)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Threads
forall a. HasParser a => Parser a
settingsParser
Int
flagMaxSize <-
[Builder Int] -> Parser Int
forall a. HasCallStack => [Builder a] -> Parser a
setting
[ String -> Builder Int
forall a. String -> Builder a
help String
"Maximum size parameter to pass to generators",
Reader Int -> Builder Int
forall a. Reader a -> Builder a
reader Reader Int
forall a. Read a => Reader a
auto,
String -> Builder Int
forall a. HasCodec a => String -> Builder a
name String
"max-size",
String -> Builder Int
forall a. String -> Builder a
metavar String
"Int",
Int -> Builder Int
forall a. Show a => a -> Builder a
value (Int -> Builder Int) -> Int -> Builder Int
forall a b. (a -> b) -> a -> b
$ Settings -> Int
settingMaxSize Settings
defaultSettings
]
Int
flagMaxSuccess <-
[Builder Int] -> Parser Int
forall a. HasCallStack => [Builder a] -> Parser a
setting
[ String -> Builder Int
forall a. String -> Builder a
help String
"Number of property test examples to run",
Reader Int -> Builder Int
forall a. Reader a -> Builder a
reader Reader Int
forall a. Read a => Reader a
auto,
String -> Builder Int
forall a. HasCodec a => String -> Builder a
name String
"max-success",
String -> Builder Int
forall a. String -> Builder a
metavar String
"Int",
Int -> Builder Int
forall a. Show a => a -> Builder a
value (Int -> Builder Int) -> Int -> Builder Int
forall a b. (a -> b) -> a -> b
$ Settings -> Int
settingMaxSuccess Settings
defaultSettings
]
Int
flagMaxDiscard <-
[Builder Int] -> Parser Int
forall a. HasCallStack => [Builder a] -> Parser a
setting
[ String -> Builder Int
forall a. String -> Builder a
help String
"Maximum number of property test inputs to discard before considering the test failed",
Reader Int -> Builder Int
forall a. Reader a -> Builder a
reader Reader Int
forall a. Read a => Reader a
auto,
String -> Builder Int
forall a. HasCodec a => String -> Builder a
name String
"max-discard",
String -> Builder Int
forall a. String -> Builder a
metavar String
"Int",
Int -> Builder Int
forall a. Show a => a -> Builder a
value (Int -> Builder Int) -> Int -> Builder Int
forall a b. (a -> b) -> a -> b
$ Settings -> Int
settingMaxDiscard Settings
defaultSettings
]
Int
flagMaxShrinks <-
[Builder Int] -> Parser Int
forall a. HasCallStack => [Builder a] -> Parser a
setting
[ String -> Builder Int
forall a. String -> Builder a
help String
"Maximum shrinks to try to apply to a failing property test input",
Reader Int -> Builder Int
forall a. Reader a -> Builder a
reader Reader Int
forall a. Read a => Reader a
auto,
String -> Builder Int
forall a. HasCodec a => String -> Builder a
name String
"max-shrinks",
String -> Builder Int
forall a. String -> Builder a
metavar String
"Int",
Int -> Builder Int
forall a. Show a => a -> Builder a
value (Int -> Builder Int) -> Int -> Builder Int
forall a b. (a -> b) -> a -> b
$ Settings -> Int
settingMaxShrinks Settings
defaultSettings
]
Bool
flagGoldenStart <-
HasCallStack => [Builder Bool] -> Parser Bool
[Builder Bool] -> Parser Bool
yesNoSwitch
[ String -> Builder Bool
forall a. String -> Builder a
help String
"Produce initial golden output if it does not exist yet",
String -> Builder Bool
forall a. HasCodec a => String -> Builder a
name String
"golden-start",
Bool -> Builder Bool
forall a. Show a => a -> Builder a
value (Bool -> Builder Bool) -> Bool -> Builder Bool
forall a b. (a -> b) -> a -> b
$ Settings -> Bool
settingGoldenStart Settings
defaultSettings
]
Bool
flagGoldenReset <-
HasCallStack => [Builder Bool] -> Parser Bool
[Builder Bool] -> Parser Bool
yesNoSwitch
[ String -> Builder Bool
forall a. String -> Builder a
help String
"Overwrite golden output",
String -> Builder Bool
forall a. HasCodec a => String -> Builder a
name String
"golden-reset",
Bool -> Builder Bool
forall a. Show a => a -> Builder a
value (Bool -> Builder Bool) -> Bool -> Builder Bool
forall a b. (a -> b) -> a -> b
$ Settings -> Bool
settingGoldenReset Settings
defaultSettings
]
Maybe Bool
flagColour <-
Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Bool -> Parser (Maybe Bool))
-> Parser Bool -> Parser (Maybe Bool)
forall a b. (a -> b) -> a -> b
$
HasCallStack => [Builder Bool] -> Parser Bool
[Builder Bool] -> Parser Bool
yesNoSwitch
[ String -> Builder Bool
forall a. String -> Builder a
help String
"Use colour in output",
String -> Builder Bool
forall a. HasCodec a => String -> Builder a
name String
"colour",
String -> Builder Bool
forall a. HasCodec a => String -> Builder a
name String
"color"
]
[Text]
flagFilters <-
[Parser [Text]] -> Parser [Text]
forall a. HasCallStack => [Parser a] -> Parser a
choice
[ Parser Text -> Parser [Text]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Parser Text -> Parser [Text]) -> Parser Text -> Parser [Text]
forall a b. (a -> b) -> a -> b
$
[Builder Text] -> Parser Text
forall a. HasCallStack => [Builder a] -> Parser a
setting
[ String -> Builder Text
forall a. String -> Builder a
help String
"Filter to select parts of the test suite",
Reader Text -> Builder Text
forall a. Reader a -> Builder a
reader Reader Text
forall s. IsString s => Reader s
str,
Builder Text
forall a. Builder a
argument,
String -> Builder Text
forall a. String -> Builder a
metavar String
"FILTER"
],
Parser Text -> Parser [Text]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text -> Parser [Text]) -> Parser Text -> Parser [Text]
forall a b. (a -> b) -> a -> b
$
[Builder Text] -> Parser Text
forall a. HasCallStack => [Builder a] -> Parser a
setting
[ String -> Builder Text
forall a. String -> Builder a
help String
"Filter to select parts of the test suite",
Reader Text -> Builder Text
forall a. Reader a -> Builder a
reader Reader Text
forall s. IsString s => Reader s
str,
Builder Text
forall a. Builder a
option,
Char -> Builder Text
forall a. Char -> Builder a
short Char
'f',
String -> Builder Text
forall a. String -> Builder a
long String
"filter",
Char -> Builder Text
forall a. Char -> Builder a
short Char
'm',
String -> Builder Text
forall a. String -> Builder a
long String
"match",
String -> Builder Text
forall a. String -> Builder a
metavar String
"FILTER"
]
]
Maybe Bool
flagFailFast <-
Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Bool -> Parser (Maybe Bool))
-> Parser Bool -> Parser (Maybe Bool)
forall a b. (a -> b) -> a -> b
$
HasCallStack => [Builder Bool] -> Parser Bool
[Builder Bool] -> Parser Bool
yesNoSwitch
[ String -> Builder Bool
forall a. String -> Builder a
help String
"Stop testing when a test failure occurs",
String -> Builder Bool
forall a. HasCodec a => String -> Builder a
name String
"fail-fast"
]
Iterations
flagIterations <- Parser Iterations
forall a. HasParser a => Parser a
settingsParser
Maybe Word
flagRetries <-
Parser Word -> Parser (Maybe Word)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Word -> Parser (Maybe Word))
-> Parser Word -> Parser (Maybe Word)
forall a b. (a -> b) -> a -> b
$
[Builder Word] -> Parser Word
forall a. HasCallStack => [Builder a] -> Parser a
setting
[ String -> Builder Word
forall a. String -> Builder a
help String
"The number of retries to use for flakiness diagnostics. 0 means 'no retries'",
Reader Word -> Builder Word
forall a. Reader a -> Builder a
reader Reader Word
forall a. Read a => Reader a
auto,
String -> Builder Word
forall a. HasCodec a => String -> Builder a
name String
"retries",
String -> Builder Word
forall a. String -> Builder a
metavar String
"INTEGER"
]
Bool
flagFailOnFlaky <-
HasCallStack => [Builder Bool] -> Parser Bool
[Builder Bool] -> Parser Bool
yesNoSwitch
[ String -> Builder Bool
forall a. String -> Builder a
help String
"Fail when any flakiness is detected, even when flakiness is allowed",
String -> Builder Bool
forall a. HasCodec a => String -> Builder a
name String
"fail-on-flaky",
Bool -> Builder Bool
forall a. Show a => a -> Builder a
value (Bool -> Builder Bool) -> Bool -> Builder Bool
forall a b. (a -> b) -> a -> b
$ Settings -> Bool
settingFailOnFlaky Settings
defaultSettings
]
Maybe ReportProgress
flagReportProgress <-
Parser ReportProgress -> Parser (Maybe ReportProgress)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ReportProgress
forall a. HasParser a => Parser a
settingsParser
Bool
flagDebug <-
HasCallStack => [Builder Bool] -> Parser Bool
[Builder Bool] -> Parser Bool
yesNoSwitch
[ String -> Builder Bool
forall a. String -> Builder a
help String
"Turn on debug mode",
String -> Builder Bool
forall a. HasCodec a => String -> Builder a
name String
"debug",
Bool -> Builder Bool
forall a. Show a => a -> Builder a
value Bool
False
]
Bool
flagProfile <-
HasCallStack => [Builder Bool] -> Parser Bool
[Builder Bool] -> Parser Bool
yesNoSwitch
[ String -> Builder Bool
forall a. String -> Builder a
help String
"Turn on profiling mode",
String -> Builder Bool
forall a. HasCodec a => String -> Builder a
name String
"profile",
Bool -> Builder Bool
forall a. Show a => a -> Builder a
value (Bool -> Builder Bool) -> Bool -> Builder Bool
forall a b. (a -> b) -> a -> b
$ Settings -> Bool
settingProfile Settings
defaultSettings
]
pure Flags {Bool
Int
[Text]
Maybe Bool
Maybe Word
Maybe ReportProgress
Maybe Threads
SeedSetting
Iterations
flagSeed :: SeedSetting
flagRandomiseExecutionOrder :: Maybe Bool
flagThreads :: Maybe Threads
flagMaxSize :: Int
flagMaxSuccess :: Int
flagMaxDiscard :: Int
flagMaxShrinks :: Int
flagGoldenStart :: Bool
flagGoldenReset :: Bool
flagColour :: Maybe Bool
flagFilters :: [Text]
flagFailFast :: Maybe Bool
flagIterations :: Iterations
flagRetries :: Maybe Word
flagFailOnFlaky :: Bool
flagReportProgress :: Maybe ReportProgress
flagDebug :: Bool
flagProfile :: Bool
flagSeed :: SeedSetting
flagRandomiseExecutionOrder :: Maybe Bool
flagThreads :: Maybe Threads
flagMaxSize :: Int
flagMaxSuccess :: Int
flagMaxDiscard :: Int
flagMaxShrinks :: Int
flagGoldenStart :: Bool
flagGoldenReset :: Bool
flagColour :: Maybe Bool
flagFilters :: [Text]
flagFailFast :: Maybe Bool
flagIterations :: Iterations
flagRetries :: Maybe Word
flagFailOnFlaky :: Bool
flagReportProgress :: Maybe ReportProgress
flagDebug :: Bool
flagProfile :: Bool
..}
data Threads
=
Synchronous
|
ByCapabilities
|
Asynchronous !Word
deriving (Int -> Threads -> ShowS
[Threads] -> ShowS
Threads -> String
(Int -> Threads -> ShowS)
-> (Threads -> String) -> ([Threads] -> ShowS) -> Show Threads
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Threads -> ShowS
showsPrec :: Int -> Threads -> ShowS
$cshow :: Threads -> String
show :: Threads -> String
$cshowList :: [Threads] -> ShowS
showList :: [Threads] -> ShowS
Show, ReadPrec [Threads]
ReadPrec Threads
Int -> ReadS Threads
ReadS [Threads]
(Int -> ReadS Threads)
-> ReadS [Threads]
-> ReadPrec Threads
-> ReadPrec [Threads]
-> Read Threads
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Threads
readsPrec :: Int -> ReadS Threads
$creadList :: ReadS [Threads]
readList :: ReadS [Threads]
$creadPrec :: ReadPrec Threads
readPrec :: ReadPrec Threads
$creadListPrec :: ReadPrec [Threads]
readListPrec :: ReadPrec [Threads]
Read, Threads -> Threads -> Bool
(Threads -> Threads -> Bool)
-> (Threads -> Threads -> Bool) -> Eq Threads
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Threads -> Threads -> Bool
== :: Threads -> Threads -> Bool
$c/= :: Threads -> Threads -> Bool
/= :: Threads -> Threads -> Bool
Eq, (forall x. Threads -> Rep Threads x)
-> (forall x. Rep Threads x -> Threads) -> Generic Threads
forall x. Rep Threads x -> Threads
forall x. Threads -> Rep Threads x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Threads -> Rep Threads x
from :: forall x. Threads -> Rep Threads x
$cto :: forall x. Rep Threads x -> Threads
to :: forall x. Rep Threads x -> Threads
Generic)
instance HasCodec Threads where
codec :: JSONCodec Threads
codec = (Maybe Word -> Threads)
-> (Threads -> Maybe Word)
-> Codec Value (Maybe Word) (Maybe Word)
-> JSONCodec Threads
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Maybe Word -> Threads
f Threads -> Maybe Word
g Codec Value (Maybe Word) (Maybe Word)
forall value. HasCodec value => JSONCodec value
codec
where
f :: Maybe Word -> Threads
f = \case
Maybe Word
Nothing -> Threads
ByCapabilities
Just Word
1 -> Threads
Synchronous
Just Word
n -> Word -> Threads
Asynchronous Word
n
g :: Threads -> Maybe Word
g = \case
Threads
ByCapabilities -> Maybe Word
forall a. Maybe a
Nothing
Threads
Synchronous -> Word -> Maybe Word
forall a. a -> Maybe a
Just Word
1
Asynchronous Word
n -> Word -> Maybe Word
forall a. a -> Maybe a
Just Word
n
instance HasParser Threads where
settingsParser :: Parser Threads
settingsParser =
[Parser Threads] -> Parser Threads
forall a. HasCallStack => [Parser a] -> Parser a
choice
[ ( \case
Word
1 -> Threads
Synchronous
Word
w -> Word -> Threads
Asynchronous Word
w
)
(Word -> Threads) -> Parser Word -> Parser Threads
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Builder Word] -> Parser Word
forall a. HasCallStack => [Builder a] -> Parser a
setting
[ String -> Builder Word
forall a. String -> Builder a
help String
"How many threads to use to execute tests in asynchrnously",
Reader Word -> Builder Word
forall a. Reader a -> Builder a
reader Reader Word
forall a. Read a => Reader a
auto,
Builder Word
forall a. Builder a
option,
String -> Builder Word
forall a. String -> Builder a
long String
"jobs",
String -> Builder Word
forall a. String -> Builder a
long String
"threads",
String -> Builder Word
forall a. String -> Builder a
env String
"JOBS",
String -> Builder Word
forall a. String -> Builder a
env String
"THREADS",
String -> Builder Word
forall a. String -> Builder a
metavar String
"INT"
],
[Builder Threads] -> Parser Threads
forall a. HasCallStack => [Builder a] -> Parser a
setting
[ String -> Builder Threads
forall a. String -> Builder a
help String
"Use only one thread, to execute tests synchronously",
Threads -> Builder Threads
forall a. a -> Builder a
switch Threads
Synchronous,
String -> Builder Threads
forall a. String -> Builder a
long String
"synchronous"
],
Threads
Synchronous
Threads -> Parser Bool -> Parser Threads
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Builder Bool] -> Parser Bool
forall a. HasCallStack => [Builder a] -> Parser a
setting
[ String -> Builder Bool
forall a. String -> Builder a
help String
"Use only one thread, to execute tests synchronously",
Reader Bool -> Builder Bool
forall a. Reader a -> Builder a
reader Reader Bool
exists,
String -> Builder Bool
forall a. String -> Builder a
env String
"SYNCHRONOUS",
String -> Builder Bool
forall a. String -> Builder a
metavar String
"ANY"
],
[Builder Threads] -> Parser Threads
forall a. HasCallStack => [Builder a] -> Parser a
setting
[ String -> Builder Threads
forall a. String -> Builder a
help String
"How parallel to run the test suite",
String
-> ValueCodec (Maybe Word) (Maybe Threads) -> Builder Threads
forall void a. String -> ValueCodec void (Maybe a) -> Builder a
confWith' String
"threads" (ValueCodec (Maybe Word) (Maybe Threads) -> Builder Threads)
-> ValueCodec (Maybe Word) (Maybe Threads) -> Builder Threads
forall a b. (a -> b) -> a -> b
$
let f :: Maybe Word -> Maybe Threads
f = \case
Maybe Word
Nothing -> Threads -> Maybe Threads
forall a. a -> Maybe a
Just Threads
ByCapabilities
Just Word
1 -> Threads -> Maybe Threads
forall a. a -> Maybe a
Just Threads
Synchronous
Just Word
n -> Threads -> Maybe Threads
forall a. a -> Maybe a
Just (Threads -> Maybe Threads) -> Threads -> Maybe Threads
forall a b. (a -> b) -> a -> b
$ Word -> Threads
Asynchronous Word
n
in Maybe Word -> Maybe Threads
f (Maybe Word -> Maybe Threads)
-> Codec Value (Maybe Word) (Maybe Word)
-> ValueCodec (Maybe Word) (Maybe Threads)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codec Value (Maybe Word) (Maybe Word)
forall value. HasCodec value => JSONCodec value
codec
]
]
data Iterations
=
OneIteration
|
Iterations !Word
|
Continuous
deriving (Int -> Iterations -> ShowS
[Iterations] -> ShowS
Iterations -> String
(Int -> Iterations -> ShowS)
-> (Iterations -> String)
-> ([Iterations] -> ShowS)
-> Show Iterations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Iterations -> ShowS
showsPrec :: Int -> Iterations -> ShowS
$cshow :: Iterations -> String
show :: Iterations -> String
$cshowList :: [Iterations] -> ShowS
showList :: [Iterations] -> ShowS
Show, ReadPrec [Iterations]
ReadPrec Iterations
Int -> ReadS Iterations
ReadS [Iterations]
(Int -> ReadS Iterations)
-> ReadS [Iterations]
-> ReadPrec Iterations
-> ReadPrec [Iterations]
-> Read Iterations
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Iterations
readsPrec :: Int -> ReadS Iterations
$creadList :: ReadS [Iterations]
readList :: ReadS [Iterations]
$creadPrec :: ReadPrec Iterations
readPrec :: ReadPrec Iterations
$creadListPrec :: ReadPrec [Iterations]
readListPrec :: ReadPrec [Iterations]
Read, Iterations -> Iterations -> Bool
(Iterations -> Iterations -> Bool)
-> (Iterations -> Iterations -> Bool) -> Eq Iterations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Iterations -> Iterations -> Bool
== :: Iterations -> Iterations -> Bool
$c/= :: Iterations -> Iterations -> Bool
/= :: Iterations -> Iterations -> Bool
Eq, (forall x. Iterations -> Rep Iterations x)
-> (forall x. Rep Iterations x -> Iterations) -> Generic Iterations
forall x. Rep Iterations x -> Iterations
forall x. Iterations -> Rep Iterations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Iterations -> Rep Iterations x
from :: forall x. Iterations -> Rep Iterations x
$cto :: forall x. Rep Iterations x -> Iterations
to :: forall x. Rep Iterations x -> Iterations
Generic)
instance HasCodec Iterations where
codec :: JSONCodec Iterations
codec = (Maybe Word -> Iterations)
-> (Iterations -> Maybe Word)
-> Codec Value (Maybe Word) (Maybe Word)
-> JSONCodec Iterations
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Maybe Word -> Iterations
f Iterations -> Maybe Word
g Codec Value (Maybe Word) (Maybe Word)
forall value. HasCodec value => JSONCodec value
codec
where
f :: Maybe Word -> Iterations
f = \case
Maybe Word
Nothing -> Iterations
OneIteration
Just Word
0 -> Iterations
Continuous
Just Word
1 -> Iterations
OneIteration
Just Word
n -> Word -> Iterations
Iterations Word
n
g :: Iterations -> Maybe Word
g = \case
Iterations
OneIteration -> Maybe Word
forall a. Maybe a
Nothing
Iterations
Continuous -> Word -> Maybe Word
forall a. a -> Maybe a
Just Word
0
Iterations Word
n -> Word -> Maybe Word
forall a. a -> Maybe a
Just Word
n
instance HasParser Iterations where
settingsParser :: Parser Iterations
settingsParser =
[Parser Iterations] -> Parser Iterations
forall a. HasCallStack => [Parser a] -> Parser a
choice
[ [Builder Iterations] -> Parser Iterations
forall a. HasCallStack => [Builder a] -> Parser a
setting
[ String -> Builder Iterations
forall a. String -> Builder a
help String
"Run the test suite over and over again until it fails, for example to diagnose flakiness",
Iterations -> Builder Iterations
forall a. a -> Builder a
switch Iterations
Continuous,
String -> Builder Iterations
forall a. String -> Builder a
long String
"continuous"
],
( \case
Word
0 -> Iterations
Continuous
Word
1 -> Iterations
OneIteration
Word
i -> Word -> Iterations
Iterations Word
i
)
(Word -> Iterations) -> Parser Word -> Parser Iterations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Builder Word] -> Parser Word
forall a. HasCallStack => [Builder a] -> Parser a
setting
[ String -> Builder Word
forall a. String -> Builder a
help String
"How many iterations of the suite to run, for example to diagnose flakiness",
Reader Word -> Builder Word
forall a. Reader a -> Builder a
reader Reader Word
forall a. Read a => Reader a
auto,
Builder Word
forall a. Builder a
option,
String -> Builder Word
forall a. String -> Builder a
long String
"iterations",
String -> Builder Word
forall a. String -> Builder a
metavar String
"INT"
],
Iterations -> Parser Iterations
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Iterations -> Parser Iterations)
-> Iterations -> Parser Iterations
forall a b. (a -> b) -> a -> b
$ Settings -> Iterations
settingIterations Settings
defaultSettings
]
data ReportProgress
=
ReportNoProgress
|
ReportProgress
deriving (Int -> ReportProgress -> ShowS
[ReportProgress] -> ShowS
ReportProgress -> String
(Int -> ReportProgress -> ShowS)
-> (ReportProgress -> String)
-> ([ReportProgress] -> ShowS)
-> Show ReportProgress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReportProgress -> ShowS
showsPrec :: Int -> ReportProgress -> ShowS
$cshow :: ReportProgress -> String
show :: ReportProgress -> String
$cshowList :: [ReportProgress] -> ShowS
showList :: [ReportProgress] -> ShowS
Show, ReadPrec [ReportProgress]
ReadPrec ReportProgress
Int -> ReadS ReportProgress
ReadS [ReportProgress]
(Int -> ReadS ReportProgress)
-> ReadS [ReportProgress]
-> ReadPrec ReportProgress
-> ReadPrec [ReportProgress]
-> Read ReportProgress
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ReportProgress
readsPrec :: Int -> ReadS ReportProgress
$creadList :: ReadS [ReportProgress]
readList :: ReadS [ReportProgress]
$creadPrec :: ReadPrec ReportProgress
readPrec :: ReadPrec ReportProgress
$creadListPrec :: ReadPrec [ReportProgress]
readListPrec :: ReadPrec [ReportProgress]
Read, ReportProgress -> ReportProgress -> Bool
(ReportProgress -> ReportProgress -> Bool)
-> (ReportProgress -> ReportProgress -> Bool) -> Eq ReportProgress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReportProgress -> ReportProgress -> Bool
== :: ReportProgress -> ReportProgress -> Bool
$c/= :: ReportProgress -> ReportProgress -> Bool
/= :: ReportProgress -> ReportProgress -> Bool
Eq, (forall x. ReportProgress -> Rep ReportProgress x)
-> (forall x. Rep ReportProgress x -> ReportProgress)
-> Generic ReportProgress
forall x. Rep ReportProgress x -> ReportProgress
forall x. ReportProgress -> Rep ReportProgress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReportProgress -> Rep ReportProgress x
from :: forall x. ReportProgress -> Rep ReportProgress x
$cto :: forall x. Rep ReportProgress x -> ReportProgress
to :: forall x. Rep ReportProgress x -> ReportProgress
Generic)
instance HasParser ReportProgress where
settingsParser :: Parser ReportProgress
settingsParser =
[Parser ReportProgress] -> Parser ReportProgress
forall a. HasCallStack => [Parser a] -> Parser a
choice
[ [Builder ReportProgress] -> Parser ReportProgress
forall a. HasCallStack => [Builder a] -> Parser a
setting
[ String -> Builder ReportProgress
forall a. String -> Builder a
help String
"Report per-example progress",
ReportProgress -> Builder ReportProgress
forall a. a -> Builder a
switch ReportProgress
ReportProgress,
String -> Builder ReportProgress
forall a. String -> Builder a
long String
"progress"
],
[Builder ReportProgress] -> Parser ReportProgress
forall a. HasCallStack => [Builder a] -> Parser a
setting
[ String -> Builder ReportProgress
forall a. String -> Builder a
help String
"Don't report per-example progress",
ReportProgress -> Builder ReportProgress
forall a. a -> Builder a
switch ReportProgress
ReportNoProgress,
String -> Builder ReportProgress
forall a. String -> Builder a
long String
"no-progress"
]
]