sydtest 0.15.1.3 → 0.16.0.0
raw patch · 4 files changed
+363/−557 lines, 4 filesdep +opt-env-confdep −autodocodec-yamldep −envparsedep −optparse-applicative
Dependencies added: opt-env-conf
Dependencies removed: autodocodec-yaml, envparse, optparse-applicative
Files
- CHANGELOG.md +21/−0
- src/Test/Syd/OptParse.hs +307/−552
- src/Test/Syd/Run.hs +33/−1
- sydtest.cabal +2/−4
CHANGELOG.md view
@@ -1,32 +1,53 @@ # Changelog +## [0.16.0.0] - 2024-08-03++### Changed++* `opt-env-conf`-based settings parsing.+ ## [0.15.1.3] - 2024-07-20 +### Changed+ * Fix race condition in the asynchronous runner ## [0.15.1.2] - 2024-07-18 +### Changed+ * Fix parsing filter flags so it becomes easy to select tests with spaces in their description ## [0.15.1.1] - 2023-10-04 +### Changed+ * Compatibility with `optparse-applicative > 0.18`. * Compatibility with `GHC >= 9.7`. * Refactored out `fast-myers-diff` into its own package. ## [0.15.1.0] - 2023-07-28 +### Added+ * `setupAroundWithAll`: so it's easier to use multiple outer resources to provide an inner resource, without the need of extra type annotation. ## [0.15.0.0] - 2023-04-08 +### Added+ * `DefBeforeAllWithNode`: so that `beforeAllWith` can be defined in terms of it and have better parallelism properties. * `DefSetupNode`: so that `beforeAll_` can be defined in terms of it and have better parallelism properties. ## [0.14.0.0] - 2023-04-05 +### Added+ * Profiling mode, for figuring out why your test suite is slow. Use `--profile` to turn it on.++### Changed+ * An improved asynchronous test runner. * Made `--debug` imply `--retries 0`
src/Test/Syd/OptParse.hs view
@@ -1,26 +1,20 @@+{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TypeApplications #-} module Test.Syd.OptParse where import Autodocodec-import Autodocodec.Yaml import Control.Applicative-import Control.Monad import Data.Maybe-import Data.String import Data.Text (Text)-import qualified Data.Text as T-import qualified Env import GHC.Generics (Generic)-import Options.Applicative as OptParse-import Path+import OptEnvConf import Path.IO-import System.Exit+import Paths_sydtest (version) import Test.Syd.Run import Text.Colour @@ -32,11 +26,7 @@ #endif getSettings :: IO Settings-getSettings = do- flags <- getFlags- env <- getEnvironment- config <- getConfiguration flags env- combineToSettings flags env config+getSettings = runSettingsParser version "A sydtest test suite" -- | Test suite definition and run settings data Settings = Settings@@ -58,7 +48,7 @@ settingGoldenStart :: !Bool, -- | Whether to overwrite golden tests instead of having them fail settingGoldenReset :: !Bool,- -- | Whether to use colour in the output+ -- | Whether to use colour in the output, 'Nothing' means "detect" settingColour :: !(Maybe Bool), -- | The filters to use to select which tests to run settingFilters :: ![Text],@@ -72,13 +62,79 @@ settingFailOnFlaky :: !Bool, -- | How to report progress settingReportProgress :: !ReportProgress,- -- | Debug mode- settingDebug :: !Bool, -- | Profiling mode settingProfile :: !Bool } deriving (Show, Eq, Generic) +instance HasParser Settings where+ settingsParser =+ subEnv_ "sydtest" $+ withConfigurableYamlConfig (runIO $ resolveFile' ".sydtest.yaml") $+ checkMapEither combine settingsParser+ where+ combine Flags {..} = do+ let d func = func defaultSettings+ let threads =+ fromMaybe+ ( if flagDebug+ then Synchronous+ else d settingThreads+ )+ flagThreads+ progress <- case flagReportProgress of+ Nothing ->+ pure $+ if threads == Synchronous+ then+ if flagDebug+ then ReportProgress+ else d settingReportProgress+ else d settingReportProgress+ Just ReportProgress ->+ if threads /= Synchronous+ then Left "Reporting progress in asynchronous runners is not supported. You can use --synchronous or --debug to use a synchronous runner."+ else pure ReportProgress+ Just ReportNoProgress -> pure ReportNoProgress+ pure+ Settings+ { settingSeed = flagSeed,+ settingRandomiseExecutionOrder =+ fromMaybe+ ( if flagDebug+ then False+ else d settingRandomiseExecutionOrder+ )+ flagRandomiseExecutionOrder,+ settingThreads = threads,+ settingMaxSuccess = flagMaxSuccess,+ settingMaxSize = flagMaxSize,+ settingMaxDiscard = flagMaxDiscard,+ settingMaxShrinks = flagMaxShrinks,+ settingGoldenStart = flagGoldenStart,+ settingGoldenReset = flagGoldenReset,+ settingColour = flagColour,+ settingFilters = flagFilters,+ settingFailFast =+ fromMaybe+ ( if flagDebug+ then True+ else d settingFailFast+ )+ flagFailFast,+ settingIterations = flagIterations,+ settingRetries =+ fromMaybe+ ( if flagDebug+ then 0+ else d settingRetries+ )+ flagRetries,+ settingFailOnFlaky = flagFailOnFlaky,+ settingReportProgress = progress,+ settingProfile = flagProfile+ }+ defaultSettings :: Settings defaultSettings = let d func = func defaultTestRunSettings@@ -99,7 +155,6 @@ settingRetries = defaultRetries, settingFailOnFlaky = False, settingReportProgress = ReportNoProgress,- settingDebug = False, settingProfile = False } @@ -123,7 +178,151 @@ detectTerminalCapabilities :: IO TerminalCapabilities detectTerminalCapabilities = getTerminalCapabilitiesFromEnv #endif+-- We use an intermediate 'Flags' type so that default values can change based+-- on parse settings. For example, the default value for 'flagThreads' depends+-- on the value of 'flagDebug'.+data Flags = Flags+ { 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+ }+ deriving (Show, Eq, Generic) +instance HasParser Flags where+ settingsParser = do+ flagSeed <- settingsParser+ flagRandomiseExecutionOrder <-+ optional $+ yesNoSwitch+ [ help "Run test suite in a random order",+ name "randomise-execution-order",+ name "randomize-execution-order"+ ]+ flagThreads <- optional settingsParser+ flagMaxSize <-+ setting+ [ help "Maximum size parameter to pass to generators",+ reader auto,+ name "max-size",+ metavar "Int",+ value $ settingMaxSize defaultSettings+ ]+ flagMaxSuccess <-+ setting+ [ help "Number of property test examples to run",+ reader auto,+ name "max-success",+ metavar "Int",+ value $ settingMaxSuccess defaultSettings+ ]+ flagMaxDiscard <-+ setting+ [ help "Maximum number of property test inputs to discard before considering the test failed",+ reader auto,+ name "max-discard",+ metavar "Int",+ value $ settingMaxDiscard defaultSettings+ ]+ flagMaxShrinks <-+ setting+ [ help "Maximum shrinks to try to apply to a failing property test input",+ reader auto,+ name "max-shrinks",+ metavar "Int",+ value $ settingMaxShrinks defaultSettings+ ]+ flagGoldenStart <-+ yesNoSwitch+ [ help "Produce initial golden output if it does not exist yet",+ name "golden-start",+ value $ settingGoldenStart defaultSettings+ ]+ flagGoldenReset <-+ yesNoSwitch+ [ help "Overwrite golden output",+ name "golden-reset",+ value $ settingGoldenReset defaultSettings+ ]+ flagColour <-+ optional $+ yesNoSwitch+ [ help "Use colour in output",+ name "colour",+ name "color"+ ]+ flagFilters <-+ choice+ [ some $+ setting+ [ help "Filter to select parts of the test suite",+ reader str,+ argument,+ metavar "FILTER"+ ],+ many $+ setting+ [ help "Filter to select parts of the test suite",+ reader str,+ option,+ short 'f',+ long "filter",+ short 'm',+ long "match",+ metavar "FILTER"+ ]+ ]+ flagFailFast <-+ optional $+ yesNoSwitch+ [ help "Stop testing when a test failure occurs",+ name "fail-fast"+ ]+ flagIterations <- settingsParser+ flagRetries <-+ optional $+ setting+ [ help "The number of retries to use for flakiness diagnostics. 0 means 'no retries'",+ reader auto,+ name "retries",+ metavar "INTEGER"+ ]+ flagFailOnFlaky <-+ yesNoSwitch+ [ help "Fail when any flakiness is detected, even when flakiness is allowed",+ name "fail-on-flaky",+ value $ settingFailOnFlaky defaultSettings+ ]+ flagReportProgress <-+ optional settingsParser+ flagDebug <-+ yesNoSwitch+ [ help "Turn on debug mode",+ name "debug",+ value False+ ]+ flagProfile <-+ yesNoSwitch+ [ help "Turn on profiling mode",+ name "profile",+ value $ settingProfile defaultSettings+ ]+ pure Flags {..}+ data Threads = -- | One thread Synchronous@@ -133,176 +332,6 @@ Asynchronous !Word deriving (Show, Read, Eq, Generic) -data Iterations- = -- | Run the test suite once, the default- OneIteration- | -- | Run the test suite for the given number of iterations, or until we can find flakiness- Iterations !Word- | -- | Run the test suite over and over, until we can find some flakiness- Continuous- deriving (Show, Read, Eq, Generic)--data ReportProgress- = -- | Don't report any progress, the default- ReportNoProgress- | -- | Report progress- ReportProgress- deriving (Show, Read, Eq, Generic)---- | Combine everything to 'Settings'-combineToSettings :: Flags -> Environment -> Maybe Configuration -> IO Settings-combineToSettings Flags {..} Environment {..} mConf = do- let d func = func defaultSettings- let debugMode =- fromMaybe (d settingDebug) $- flagDebug <|> envDebug <|> mc configDebug- let threads =- fromMaybe (if debugMode then Synchronous else d settingThreads) $- flagThreads <|> envThreads <|> mc configThreads- setReportProgress <-- case flagReportProgress <|> envReportProgress <|> mc configReportProgress of- Nothing ->- pure $- if threads == Synchronous- then- if debugMode- then ReportProgress- else d settingReportProgress- else d settingReportProgress- Just progress ->- if progress- then- if threads /= Synchronous- then die "Reporting progress in asynchronous runners is not supported. You can use --synchronous or --debug to use a synchronous runner."- else pure ReportProgress- else pure ReportNoProgress-- pure- Settings- { settingSeed =- fromMaybe (d settingSeed) $- flagSeed <|> envSeed <|> mc configSeed,- settingRandomiseExecutionOrder =- fromMaybe (if debugMode then False else d settingRandomiseExecutionOrder) $- flagRandomiseExecutionOrder <|> envRandomiseExecutionOrder <|> mc configRandomiseExecutionOrder,- settingThreads = threads,- settingMaxSuccess =- fromMaybe (d settingMaxSuccess) $- flagMaxSuccess <|> envMaxSuccess <|> mc configMaxSuccess,- settingMaxSize =- fromMaybe (d settingMaxSize) $- flagMaxSize <|> envMaxSize <|> mc configMaxSize,- settingMaxDiscard =- fromMaybe (d settingMaxDiscard) $- flagMaxDiscard <|> envMaxDiscard <|> mc configMaxDiscard,- settingMaxShrinks =- fromMaybe (d settingMaxShrinks) $- flagMaxShrinks <|> envMaxShrinks <|> mc configMaxShrinks,- settingGoldenStart =- fromMaybe (d settingGoldenStart) $- flagGoldenStart <|> envGoldenStart <|> mc configGoldenStart,- settingGoldenReset =- fromMaybe (d settingGoldenReset) $- flagGoldenReset <|> envGoldenReset <|> mc configGoldenReset,- settingColour = flagColour <|> envColour <|> mc configColour,- settingFilters = flagFilters <|> maybeToList envFilter <|> maybeToList (mc configFilter),- settingFailFast =- fromMaybe- (if debugMode then True else d settingFailFast)- (flagFailFast <|> envFailFast <|> mc configFailFast),- settingIterations =- fromMaybe (d settingIterations) $- flagIterations <|> envIterations <|> mc configIterations,- settingRetries =- fromMaybe (if debugMode then 0 else d settingRetries) $- flagRetries <|> envRetries <|> mc configRetries,- settingFailOnFlaky =- fromMaybe (d settingFailOnFlaky) $- flagFailOnFlaky <|> envFailOnFlaky <|> mc configFailOnFlaky,- settingReportProgress = setReportProgress,- settingDebug = debugMode,- settingProfile =- fromMaybe False $- flagProfile <|> envProfile <|> mc configProfile- }- where- mc :: (Configuration -> Maybe a) -> Maybe a- mc f = mConf >>= f---- | What we find in the configuration variable.------ Do nothing clever here, just represent the configuration file.--- For example, use 'Maybe FilePath', not 'Path Abs File'.------ Use 'readYamlConfigFile' or 'readFirstYamlConfigFile' to read a configuration.-data Configuration = Configuration- { configSeed :: !(Maybe SeedSetting),- configRandomiseExecutionOrder :: !(Maybe Bool),- configThreads :: !(Maybe Threads),- configMaxSize :: !(Maybe Int),- configMaxSuccess :: !(Maybe Int),- configMaxDiscard :: !(Maybe Int),- configMaxShrinks :: !(Maybe Int),- configGoldenStart :: !(Maybe Bool),- configGoldenReset :: !(Maybe Bool),- configColour :: !(Maybe Bool),- configFilter :: !(Maybe Text),- configFailFast :: !(Maybe Bool),- configIterations :: !(Maybe Iterations),- configRetries :: !(Maybe Word),- configFailOnFlaky :: !(Maybe Bool),- configReportProgress :: !(Maybe Bool),- configDebug :: !(Maybe Bool),- configProfile :: !(Maybe Bool)- }- deriving (Show, Eq, Generic)---- | We use 'autodocodec' for parsing a YAML config.-instance HasCodec Configuration where- codec =- object "Configuration" $- Configuration- <$> optionalField "seed" "Seed for random generation of test cases"- .= configSeed- <*> parseAlternative- (optionalField "randomise-execution-order" "Randomise the execution order of the tests in the test suite")- (optionalField "randomize-execution-order" "American spelling")- .= configRandomiseExecutionOrder- <*> optionalField "parallelism" "How parallel to execute the tests"- .= configThreads- <*> optionalField "max-size" "Maximum size parameter to pass to generators"- .= configMaxSize- <*> optionalField "max-success" "Number of quickcheck examples to run"- .= configMaxSuccess- <*> optionalField "max-discard" "Maximum number of discarded tests per successful test before giving up"- .= configMaxDiscard- <*> optionalField "max-shrinks" "Maximum number of shrinks of a failing test input"- .= configMaxShrinks- <*> optionalField "golden-start" "Whether to write golden tests if they do not exist yet"- .= configGoldenStart- <*> optionalField "golden-reset" "Whether to overwrite golden tests instead of having them fail"- .= configGoldenReset- <*> parseAlternative- (optionalField "colour" "Whether to use coloured output")- (optionalField "color" "American spelling")- .= configColour- <*> optionalField "filter" "Filter to select which parts of the test tree to run"- .= configFilter- <*> optionalField "fail-fast" "Whether to stop executing upon the first test failure"- .= configFailFast- <*> optionalField "iterations" "How many iterations to use to look diagnose flakiness"- .= configIterations- <*> optionalField "retries" "The number of retries to use for flakiness diagnostics. 0 means 'no flakiness diagnostics'"- .= configRetries- <*> optionalField "fail-on-flaky" "Whether to fail when any flakiness is detected in tests marked as potentially flaky"- .= configFailOnFlaky- <*> optionalField "progress" "How to report progres"- .= configReportProgress- <*> optionalField "debug" "Turn on debug-mode. This implies randomise-execution-order: false, parallelism: 1 and fail-fast: true"- .= configDebug- <*> optionalField "profile" "Turn on profiling mode"- .= configProfile- instance HasCodec Threads where codec = dimapCodec f g codec where@@ -315,6 +344,55 @@ Synchronous -> Just 1 Asynchronous n -> Just n +instance HasParser Threads where+ settingsParser =+ choice+ [ ( \case+ 1 -> Synchronous+ w -> Asynchronous w+ )+ <$> setting+ [ help "How many threads to use to execute tests in asynchrnously",+ reader auto,+ option,+ long "jobs",+ long "threads",+ env "JOBS",+ env "THREADS",+ metavar "INT"+ ],+ setting+ [ help "Use only one thread, to execute tests synchronously",+ switch Synchronous,+ long "synchronous"+ ],+ Synchronous+ <$ setting+ [ help "Use only one thread, to execute tests synchronously",+ reader exists,+ env "SYNCHRONOUS",+ metavar "ANY"+ ],+ setting+ [ help "How parallel to run the test suite",+ confWith' "threads" $+ let f = \case+ Nothing -> Just ByCapabilities+ Just 1 -> Just Synchronous+ Just n -> Just $ Asynchronous n+ in f <$> codec+ ]+ ]++data Iterations+ = -- | Run the test suite once, the default+ OneIteration+ | -- | Run the test suite for the given number of iterations, or until we can find flakiness+ Iterations !Word+ | -- | Run the test suite over and over, until we can find some flakiness+ Continuous+ deriving (Show, Read, Eq, Generic)+ instance HasCodec Iterations where codec = dimapCodec f g codec where@@ -328,370 +406,47 @@ Continuous -> Just 0 Iterations n -> Just n --- | Get the configuration------ We use the flags and environment because they can contain information to override where to look for the configuration files.--- We return a 'Maybe' because there may not be a configuration file.-getConfiguration :: Flags -> Environment -> IO (Maybe Configuration)-getConfiguration Flags {..} Environment {..} =- case flagConfigFile <|> envConfigFile of- Nothing -> defaultConfigFile >>= readYamlConfigFile- Just cf -> do- afp <- resolveFile' cf- readYamlConfigFile afp---- | Where to get the configuration file by default.-defaultConfigFile :: IO (Path Abs File)-defaultConfigFile = resolveFile' ".sydtest.yaml"---- | What we find in the configuration variable.------ Do nothing clever here, just represent the relevant parts of the environment.--- For example, use 'Text', not 'SqliteConfig'.-data Environment = Environment- { envConfigFile :: Maybe FilePath,- envSeed :: !(Maybe SeedSetting),- envRandomiseExecutionOrder :: !(Maybe Bool),- envThreads :: !(Maybe Threads),- envMaxSize :: !(Maybe Int),- envMaxSuccess :: !(Maybe Int),- envMaxDiscard :: !(Maybe Int),- envMaxShrinks :: !(Maybe Int),- envGoldenStart :: !(Maybe Bool),- envGoldenReset :: !(Maybe Bool),- envColour :: !(Maybe Bool),- envFilter :: !(Maybe Text),- envFailFast :: !(Maybe Bool),- envIterations :: !(Maybe Iterations),- envRetries :: !(Maybe Word),- envFailOnFlaky :: !(Maybe Bool),- envReportProgress :: !(Maybe Bool),- envDebug :: !(Maybe Bool),- envProfile :: !(Maybe Bool)- }- deriving (Show, Eq, Generic)--defaultEnvironment :: Environment-defaultEnvironment =- Environment- { envConfigFile = Nothing,- envSeed = Nothing,- envRandomiseExecutionOrder = Nothing,- envThreads = Nothing,- envMaxSize = Nothing,- envMaxSuccess = Nothing,- envMaxDiscard = Nothing,- envMaxShrinks = Nothing,- envGoldenStart = Nothing,- envGoldenReset = Nothing,- envColour = Nothing,- envFilter = Nothing,- envFailFast = Nothing,- envIterations = Nothing,- envRetries = Nothing,- envFailOnFlaky = Nothing,- envReportProgress = Nothing,- envDebug = Nothing,- envProfile = Nothing- }--getEnvironment :: IO Environment-getEnvironment = Env.parse (Env.header "Environment") environmentParser---- | The 'envparse' parser for the 'Environment'-environmentParser :: Env.Parser Env.Error Environment-environmentParser =- Env.prefixed "SYDTEST_" $- Environment- <$> Env.var (fmap Just . Env.str) "CONFIG_FILE" (Env.def Nothing <> Env.help "Config file")- <*> seedSettingEnvironmentParser- <*> ( Env.var (fmap Just . Env.auto) "RANDOMISE_EXECUTION_ORDER" (Env.def Nothing <> Env.help "Randomise the execution order of the tests in the test suite")- <|> Env.var (fmap Just . Env.auto) "RANDOMIZE_EXECUTION_ORDER" (Env.def Nothing <> Env.help "Randomize the execution order of the tests in the test suite")- )- <*> Env.var (fmap Just . (Env.auto >=> parseThreads)) "PARALLELISM" (Env.def Nothing <> Env.help "How parallel to execute the tests")- <*> Env.var (fmap Just . Env.auto) "MAX_SIZE" (Env.def Nothing <> Env.help "Maximum size parameter to pass to generators")- <*> Env.var (fmap Just . Env.auto) "MAX_SUCCESS" (Env.def Nothing <> Env.help "Number of quickcheck examples to run")- <*> Env.var (fmap Just . Env.auto) "MAX_DISCARD" (Env.def Nothing <> Env.help "Maximum number of discarded tests per successful test before giving up")- <*> Env.var (fmap Just . Env.auto) "MAX_SHRINKS" (Env.def Nothing <> Env.help "Maximum number of shrinks of a failing test input")- <*> Env.var (fmap Just . Env.auto) "GOLDEN_START" (Env.def Nothing <> Env.help "Whether to write golden tests if they do not exist yet")- <*> Env.var (fmap Just . Env.auto) "GOLDEN_RESET" (Env.def Nothing <> Env.help "Whether to overwrite golden tests instead of having them fail")- <*> ( Env.var (fmap Just . Env.auto) "COLOUR" (Env.def Nothing <> Env.help "Whether to use coloured output")- <|> Env.var (fmap Just . Env.auto) "COLOR" (Env.def Nothing <> Env.help "Whether to use colored output")- )- <*> Env.var (fmap Just . Env.str) "FILTER" (Env.def Nothing <> Env.help "Filter to select which parts of the test tree to run")- <*> Env.var (fmap Just . Env.auto) "FAIL_FAST" (Env.def Nothing <> Env.help "Whether to stop executing upon the first test failure")- <*> Env.var (fmap Just . (Env.auto >=> parseIterations)) "ITERATIONS" (Env.def Nothing <> Env.help "How many iterations to use to look diagnose flakiness")- <*> Env.var (fmap Just . Env.auto) "RETRIES" (Env.def Nothing <> Env.help "The number of retries to use for flakiness diagnostics. 0 means 'no flakiness diagnostics'")- <*> Env.var (fmap Just . Env.auto) "FAIL_ON_FLAKY" (Env.def Nothing <> Env.help "Whether to fail when flakiness is detected in tests marked as potentially flaky")- <*> Env.var (fmap Just . Env.auto) "PROGRESS" (Env.def Nothing <> Env.help "Report progress as tests run")- <*> Env.var (fmap Just . Env.auto) "DEBUG" (Env.def Nothing <> Env.help "Turn on debug mode. This implies RANDOMISE_EXECUTION_ORDER=False, PARALLELISM=1 and FAIL_FAST=True.")- <*> Env.var (fmap Just . Env.auto) "PROFILE" (Env.def Nothing <> Env.help "Turn on profiling mode.")- where- parseThreads :: Word -> Either e Threads- parseThreads 1 = Right Synchronous- parseThreads i = Right (Asynchronous i)- parseIterations :: Word -> Either e Iterations- parseIterations 0 = Right Continuous- parseIterations 1 = Right OneIteration- parseIterations i = Right (Iterations i)--seedSettingEnvironmentParser :: Env.Parser Env.Error (Maybe SeedSetting)-seedSettingEnvironmentParser =- combine- <$> Env.var (fmap Just . Env.auto) "SEED" (Env.def Nothing <> Env.help "Seed for random generation of test cases")- <*> Env.switch "RANDOM_SEED" (Env.help "Use a random seed for every test case")- where- combine :: Maybe Int -> Bool -> Maybe SeedSetting- combine mSeed random = if random then Just RandomSeed else FixedSeed <$> mSeed---- | Get the command-line flags-getFlags :: IO Flags-getFlags = customExecParser prefs_ flagsParser---- | The 'optparse-applicative' parsing preferences-prefs_ :: OptParse.ParserPrefs-prefs_ =- -- I like these preferences. Use what you like.- OptParse.defaultPrefs- { OptParse.prefShowHelpOnError = True,- OptParse.prefShowHelpOnEmpty = True- }---- | The @optparse-applicative@ parser for 'Flags'-flagsParser :: OptParse.ParserInfo Flags-flagsParser =- OptParse.info- (OptParse.helper <*> parseFlags)- (OptParse.fullDesc <> OptParse.footerDoc (Just $ fromString footerStr))- where- -- Show the variables from the environment that we parse and the config file format- footerStr =- unlines- [ Env.helpDoc environmentParser,- "",- "Configuration file format:",- T.unpack (renderColouredSchemaViaCodec @Configuration)- ]---- | The flags that are common across commands.-data Flags = Flags- { flagConfigFile :: !(Maybe FilePath),- flagSeed :: !(Maybe SeedSetting),- flagRandomiseExecutionOrder :: !(Maybe Bool),- flagThreads :: !(Maybe Threads),- flagMaxSize :: !(Maybe Int),- flagMaxSuccess :: !(Maybe Int),- flagMaxDiscard :: !(Maybe Int),- flagMaxShrinks :: !(Maybe Int),- flagGoldenStart :: !(Maybe Bool),- flagGoldenReset :: !(Maybe Bool),- flagColour :: !(Maybe Bool),- flagFilters :: ![Text],- flagFailFast :: !(Maybe Bool),- flagIterations :: !(Maybe Iterations),- flagRetries :: !(Maybe Word),- flagFailOnFlaky :: !(Maybe Bool),- flagReportProgress :: !(Maybe Bool),- flagDebug :: !(Maybe Bool),- flagProfile :: !(Maybe Bool)- }- deriving (Show, Eq, Generic)--defaultFlags :: Flags-defaultFlags =- Flags- { flagConfigFile = Nothing,- flagSeed = Nothing,- flagRandomiseExecutionOrder = Nothing,- flagThreads = Nothing,- flagMaxSize = Nothing,- flagMaxSuccess = Nothing,- flagMaxDiscard = Nothing,- flagMaxShrinks = Nothing,- flagGoldenStart = Nothing,- flagGoldenReset = Nothing,- flagColour = Nothing,- flagFilters = mempty,- flagFailFast = Nothing,- flagIterations = Nothing,- flagRetries = Nothing,- flagFailOnFlaky = Nothing,- flagReportProgress = Nothing,- flagDebug = Nothing,- flagProfile = Nothing- }---- | The 'optparse-applicative' parser for the 'Flags'.-parseFlags :: OptParse.Parser Flags-parseFlags =- Flags- <$> optional- ( strOption- ( mconcat- [ long "config-file",- help "Path to an altenative config file",- metavar "FILEPATH"- ]- )- )- <*> seedSettingFlags- <*> doubleSwitch ["randomise-execution-order", "randomize-execution-order"] (help "Randomise the execution order of the tests in the test suite")- <*> optional- ( ( ( \case- 1 -> Synchronous- i -> Asynchronous i- )- <$> option- auto- ( mconcat- [ short 'j',- long "jobs",- help "How parallel to execute the tests",- metavar "JOBS"- ]- )- )- <|> flag'- Synchronous- ( mconcat- [ long "synchronous",- help "Execute tests synchronously"- ]- )- )- <*> optional- ( option- auto- ( mconcat- [ long "max-size",- long "qc-max-size",- help "Maximum size parameter to pass to generators",- metavar "MAXIMUM_SIZE_PARAMETER"- ]- )- )- <*> optional- ( option- auto- ( mconcat- [ long "max-success",- long "qc-max-success",- help "Number of quickcheck examples to run",- metavar "NUMBER_OF_SUCCESSES"- ]- )- )- <*> optional- ( option- auto- ( mconcat- [ long "max-discard",- long "qc-max-discard",- help "Maximum number of discarded tests per successful test before giving up",- metavar "MAXIMUM_DISCARD_RATIO"- ]- )- )- <*> optional- ( option- auto- ( mconcat- [ long "max-shrinks",- long "qc-max-shrinks",- help "Maximum number of shrinks of a failing test input",- metavar "MAXIMUM_SHRINKS"- ]- )- )- <*> doubleSwitch ["golden-start"] (help "Whether to write golden tests if they do not exist yet")- <*> doubleSwitch ["golden-reset"] (help "Whether to overwrite golden tests instead of having them fail")- <*> doubleSwitch ["colour", "color"] (help "Use colour in output")- <*> ( maybeToList- <$> optional- ( strArgument- ( mconcat- [ help "Filter to select which parts of the test tree to run",- metavar "FILTER"- ]- )- )- <|> manyOptional- ( mconcat- [ short 'f',- long "filter",- short 'm',- long "match",- help "Filter to select which parts of the test tree to run",- metavar "FILTER"- ]- )- )- <*> doubleSwitch ["fail-fast"] (help "Stop upon the first test failure")- <*> optional- ( ( ( \case- 0 -> Continuous- 1 -> OneIteration- i -> Iterations i- )- <$> option- auto- ( mconcat- [ long "iterations",- help "How many iterations to use to look diagnose flakiness",- metavar "ITERATIONS"- ]- )+instance HasParser Iterations where+ settingsParser =+ choice+ [ setting+ [ help "Run the test suite over and over again until it fails, for example to diagnose flakiness",+ switch Continuous,+ long "continuous"+ ],+ ( \case+ 0 -> Continuous+ 1 -> OneIteration+ i -> Iterations i )- <|> flag'- Continuous- ( mconcat- [ long "continuous",- help "Run the test suite over and over again until it fails, to diagnose flakiness"- ]- )- )- <*> optional- ( option- auto- ( mconcat- [ long "retries",- help "The number of retries to use for flakiness diagnostics. 0 means 'no flakiness diagnostics'",- metavar "INTEGER"- ]- )- )- <*> doubleSwitch ["fail-on-flaky"] (help "Fail when any flakiness is detected")- <*> doubleSwitch ["progress"] (help "Report progress")- <*> doubleSwitch ["debug"] (help "Turn on debug mode. This implies --no-randomise-execution-order, --synchronous, --progress and --fail-fast.")- <*> doubleSwitch ["profile"] (help "Turn on profiling mode.")--manyOptional :: OptParse.Mod OptionFields Text -> OptParse.Parser [Text]-manyOptional modifier = many (option str modifier)+ <$> setting+ [ help "How many iterations of the suite to run, for example to diagnose flakiness",+ reader auto,+ option,+ long "iterations",+ metavar "INT"+ ],+ pure $ settingIterations defaultSettings+ ] -seedSettingFlags :: OptParse.Parser (Maybe SeedSetting)-seedSettingFlags =- optional $- ( FixedSeed- <$> option- auto- ( mconcat- [ long "seed",- help "Seed for random generation of test cases",- metavar "SEED"- ]- )- )- <|> flag'- RandomSeed- ( mconcat- [ long "random-seed",- help "Use a random seed instead of a fixed seed"- ]- )+data ReportProgress+ = -- | Don't report any progress, the default+ ReportNoProgress+ | -- | Report progress+ ReportProgress+ deriving (Show, Read, Eq, Generic) -doubleSwitch :: [String] -> OptParse.Mod FlagFields (Maybe Bool) -> OptParse.Parser (Maybe Bool)-doubleSwitch suffixes mods =- flag' (Just True) (hidden <> internal <> foldMap long suffixes <> mods)- <|> flag' (Just False) (hidden <> internal <> foldMap (long . ("no-" <>)) suffixes <> mods)- <|> flag' Nothing (foldMap (\suffix -> long ("[no-]" <> suffix)) suffixes <> mods)- <|> pure Nothing+instance HasParser ReportProgress where+ settingsParser =+ choice+ [ setting+ [ help "Report per-example progress",+ switch ReportProgress,+ long "progress"+ ],+ setting+ [ help "Don't report per-example progress",+ switch ReportNoProgress,+ long "no-progress"+ ]+ ]
src/Test/Syd/Run.hs view
@@ -26,6 +26,7 @@ import Data.Word import GHC.Clock (getMonotonicTimeNSec) import GHC.Generics (Generic)+import OptEnvConf import Test.QuickCheck import Test.QuickCheck.Gen import Test.QuickCheck.IO ()@@ -129,7 +130,7 @@ instance IsTest (outerArgs -> ReaderT env IO ()) where type Arg1 (outerArgs -> ReaderT env IO ()) = outerArgs type Arg2 (outerArgs -> ReaderT env IO ()) = env- runTest func = runTest (\outerArgs env -> runReaderT (func outerArgs) env)+ runTest func = runTest (\outerArgs e -> runReaderT (func outerArgs) e) runIOTestWithArg :: (outerArgs -> innerArg -> IO ()) ->@@ -424,6 +425,37 @@ g = \case RandomSeed -> Left "random" FixedSeed i -> Right i++instance HasParser SeedSetting where+ settingsParser =+ choice+ [ setting+ [ help "Use a random seed for pseudo-randomness",+ switch RandomSeed,+ long "random-seed"+ ],+ RandomSeed+ <$ setting+ [ help "Use a random seed for pseudo-randomness",+ OptEnvConf.reader exists,+ env "RANDOM_SEED",+ metavar "ANY"+ ],+ FixedSeed+ <$> setting+ [ help "Seed for pseudo-randomness",+ OptEnvConf.reader auto,+ option,+ long "seed",+ env "SEED",+ metavar "INT"+ ],+ setting+ [ help "Seed for pseudo-randomness",+ conf "seed"+ ],+ pure $ testRunSettingSeed defaultTestRunSettings+ ] data TestRunResult = TestRunResult { testRunResultStatus :: !TestStatus,
sydtest.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: sydtest-version: 0.15.1.3+version: 0.16.0.0 synopsis: A modern testing framework for Haskell with good defaults and advanced testing features. description: A modern testing framework for Haskell with good defaults and advanced testing features. Sydtest aims to make the common easy and the hard possible. See https://github.com/NorfairKing/sydtest#readme for more information. category: Testing@@ -63,16 +63,14 @@ , QuickCheck , async , autodocodec- , autodocodec-yaml >=0.2.0.0 , base >=4.7 && <5 , bytestring , containers , dlist- , envparse , fast-myers-diff , filepath , mtl- , optparse-applicative+ , opt-env-conf >=0.5 , path , path-io , pretty-show