diff --git a/src/Test/Syd/OptParse.hs b/src/Test/Syd/OptParse.hs --- a/src/Test/Syd/OptParse.hs +++ b/src/Test/Syd/OptParse.hs @@ -55,7 +55,9 @@ -- | Whether to stop upon the first test failure settingFailFast :: !Bool, -- | How many iterations to use to look diagnose flakiness - settingIterations :: Iterations + settingIterations :: Iterations, + -- | Debug mode + settingDebug :: !Bool } deriving (Show, Eq, Generic) @@ -75,7 +77,8 @@ settingColour = Nothing, settingFilter = Nothing, settingFailFast = False, - settingIterations = OneIteration + settingIterations = OneIteration, + settingDebug = False } data Threads @@ -100,11 +103,16 @@ 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 pure Settings { settingSeed = fromMaybe (d settingSeed) $ flagSeed <|> envSeed <|> mc configSeed, - settingRandomiseExecutionOrder = fromMaybe (d settingRandomiseExecutionOrder) $ flagRandomiseExecutionOrder <|> envRandomiseExecutionOrder <|> mc configRandomiseExecutionOrder, - settingThreads = fromMaybe (d settingThreads) $ flagThreads <|> envThreads <|> mc configThreads, + settingRandomiseExecutionOrder = + fromMaybe (if debugMode then False else d settingRandomiseExecutionOrder) $ + flagRandomiseExecutionOrder <|> envRandomiseExecutionOrder <|> mc configRandomiseExecutionOrder, + settingThreads = + fromMaybe (if debugMode then Synchronous else d settingThreads) $ + flagThreads <|> envThreads <|> mc configThreads, settingMaxSuccess = fromMaybe (d settingMaxSuccess) $ flagMaxSuccess <|> envMaxSuccess <|> mc configMaxSuccess, settingMaxSize = fromMaybe (d settingMaxSize) $ flagMaxSize <|> envMaxSize <|> mc configMaxSize, settingMaxDiscard = fromMaybe (d settingMaxDiscard) $ flagMaxDiscard <|> envMaxDiscard <|> mc configMaxDiscard, @@ -113,8 +121,12 @@ settingGoldenReset = fromMaybe (d settingGoldenReset) $ flagGoldenReset <|> envGoldenReset <|> mc configGoldenReset, settingColour = flagColour <|> envColour <|> mc configColour, settingFilter = flagFilter <|> envFilter <|> mc configFilter, - settingFailFast = fromMaybe (d settingFailFast) $ flagFailFast <|> envFailFast <|> mc configFailFast, - settingIterations = fromMaybe (d settingIterations) $ flagIterations <|> envIterations <|> mc configIterations + settingFailFast = + fromMaybe + (if debugMode then True else d settingFailFast) + (flagFailFast <|> envFailFast <|> mc configFailFast), + settingIterations = fromMaybe (d settingIterations) $ flagIterations <|> envIterations <|> mc configIterations, + settingDebug = debugMode } where mc :: (Configuration -> Maybe a) -> Maybe a @@ -139,7 +151,8 @@ configColour :: !(Maybe Bool), configFilter :: !(Maybe Text), configFailFast :: !(Maybe Bool), - configIterations :: !(Maybe Iterations) + configIterations :: !(Maybe Iterations), + configDebug :: !(Maybe Bool) } deriving (Show, Eq, Generic) @@ -170,6 +183,7 @@ <*> optionalField "filter" "Filter to select which parts of the test tree to run" <*> optionalField "fail-fast" "Whether to stop executing upon the first test failure" <*> optionalField "iterations" "How many iterations to use to look diagnose flakiness" + <*> optionalField "debug" "Turn on debug-mode. This implies randomise-execution-order: false, parallelism: 1 and fail-fast: true" instance YamlSchema Threads where yamlSchema = flip fmap yamlSchema $ \case @@ -218,10 +232,31 @@ envColour :: !(Maybe Bool), envFilter :: !(Maybe Text), envFailFast :: !(Maybe Bool), - envIterations :: !(Maybe Iterations) + envIterations :: !(Maybe Iterations), + envDebug :: !(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, + envDebug = Nothing + } + getEnvironment :: IO Environment getEnvironment = Env.parse (Env.header "Environment") environmentParser @@ -248,6 +283,7 @@ <*> Env.var (fmap Just . Env.str) "FILTER" (mE <> Env.help "Filter to select which parts of the test tree to run") <*> Env.var (fmap Just . Env.auto) "FAIL_FAST" (mE <> Env.help "Whether to stop executing upon the first test failure") <*> Env.var (fmap Just . (Env.auto >=> parseIterations)) "ITERATIONS" (mE <> Env.help "How many iterations to use to look diagnose flakiness") + <*> Env.var (fmap Just . Env.auto) "DEBUG" (mE <> Env.help "Turn on debug mode. This implies RANDOMISE_EXECUTION_ORDER=False, PARALLELISM=1 and FAIL_FAST=True.") where parseThreads :: Int -> Either e Threads parseThreads 1 = Right Synchronous @@ -302,10 +338,31 @@ flagColour :: !(Maybe Bool), flagFilter :: !(Maybe Text), flagFailFast :: !(Maybe Bool), - flagIterations :: !(Maybe Iterations) + flagIterations :: !(Maybe Iterations), + flagDebug :: !(Maybe Bool) } deriving (Show, Eq, Generic) +defaultFlags :: Flags +defaultFlags = + Flags + { flagConfigFile = Nothing, + flagSeed = Nothing, + flagRandomiseExecutionOrder = Nothing, + flagThreads = Nothing, + flagMaxSuccess = Nothing, + flagMaxSize = Nothing, + flagMaxDiscard = Nothing, + flagMaxShrinks = Nothing, + flagGoldenStart = Nothing, + flagGoldenReset = Nothing, + flagColour = Nothing, + flagFilter = Nothing, + flagFailFast = Nothing, + flagIterations = Nothing, + flagDebug = Nothing + } + -- | The 'optparse-applicative' parser for the 'Flags'. parseFlags :: OptParse.Parser Flags parseFlags = @@ -324,29 +381,34 @@ auto ( mconcat [ long "seed", - help "Seed for random generation of test cases" - ] - ) - ) - <*> optional - ( flag - True - False - ( mconcat - [ long "no-randomise-execution-order", - long "no-randomize-execution-order", - help "Randomise the execution order of the tests in the test suite" + help "Seed for random generation of test cases", + metavar "SEED" ] ) ) + <*> 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"]) + <$> option + auto + ( mconcat + [ short 'j', + long "jobs", + help "How parallel to execute the tests", + metavar "JOBS" + ] + ) ) - <|> flag ByCapabilities Synchronous (mconcat [long "synchronous", help "execute tests synchronously"]) + <|> flag' + Synchronous + ( mconcat + [ long "synchronous", + help "Execute tests synchronously" + ] + ) ) <*> optional ( option @@ -354,7 +416,8 @@ ( mconcat [ long "max-success", long "qc-max-success", - help "Number of quickcheck examples to run" + help "Number of quickcheck examples to run", + metavar "NUMBER_OF_SUCCESSES" ] ) ) @@ -364,7 +427,8 @@ ( mconcat [ long "max-size", long "qc-max-size", - help "Maximum size parameter to pass to generators" + help "Maximum size parameter to pass to generators", + metavar "MAXIMUM_SIZE_PARAMETER" ] ) ) @@ -374,7 +438,8 @@ ( mconcat [ long "max-discard", long "qc-max-discard", - help "Maximum number of discarded tests per successful test before giving up" + help "Maximum number of discarded tests per successful test before giving up", + metavar "MAXIMUM_DISCARD_RATIO" ] ) ) @@ -384,51 +449,25 @@ ( mconcat [ long "max-shrinks", long "qc-max-shrinks", - help "Maximum number of shrinks of a failing test input" - ] - ) - ) - <*> optional - ( flag - True - False - ( mconcat - [ long "no-golden-start", - help "Whether to write golden tests if they do not exist yet" - ] - ) - ) - <*> optional - ( flag - False - True - ( mconcat - [ long "golden-reset", - help "Whether to overwrite golden tests instead of having them fail" + help "Maximum number of shrinks of a failing test input", + metavar "MAXIMUM_SHRINKS" ] ) ) - <*> optional - ( flag' True (mconcat [long "colour", long "color", help "Always use colour in output"]) - <|> flag' False (mconcat [long "no-colour", long "no-color", help "Never use colour in output"]) - ) + <*> 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") <*> optional ( strOption ( mconcat [ long "filter", long "match", - help "Filter to select which parts of the test tree to run" - ] - ) - ) - <*> optional - ( switch - ( mconcat - [ long "fail-fast", - help "Whether to stop upon the first test failure" + 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 @@ -439,12 +478,12 @@ auto ( mconcat [ long "iterations", - help "How many iterations to use to look diagnose flakiness" + help "How many iterations to use to look diagnose flakiness", + metavar "ITERATIONS" ] ) ) - <|> flag - OneIteration + <|> flag' Continuous ( mconcat [ long "continuous", @@ -452,3 +491,11 @@ ] ) ) + <*> doubleSwitch ["debug"] (help "Turn on debug mode. This implies --no-randomise-execution-order, --synchronous and --fail-fast.") + +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 suffixes <> mods) + <|> flag' Nothing (foldMap (\suffix -> long ("[no-]" <> suffix)) suffixes <> mods) + <|> pure Nothing diff --git a/src/Test/Syd/Output.hs b/src/Test/Syd/Output.hs --- a/src/Test/Syd/Output.hs +++ b/src/Test/Syd/Output.hs @@ -345,8 +345,8 @@ map (padFailureDetails . (: []) . chunk . T.pack) $ case (testRunResultNumTests, testRunResultNumShrinks) of (Nothing, _) -> [] - (Just numTests, Nothing) -> [printf "Failled after %d tests" numTests] - (Just numTests, Just 0) -> [printf "Failled after %d tests" numTests] + (Just numTests, Nothing) -> [printf "Failed after %d tests" numTests] + (Just numTests, Just 0) -> [printf "Failed after %d tests" numTests] (Just numTests, Just numShrinks) -> [printf "Failed after %d tests and %d shrinks" numTests numShrinks], map (padFailureDetails . (\c -> [chunk "Generated: ", c]) . fore yellow . chunk . T.pack) testRunResultFailingInputs, map padFailureDetails $ outputFailureLabels testRunResultLabels, diff --git a/sydtest.cabal b/sydtest.cabal --- a/sydtest.cabal +++ b/sydtest.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: sydtest -version: 0.3.0.3 +version: 0.4.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 @@ -106,6 +106,7 @@ Test.Syd.AroundSpec Test.Syd.FootgunSpec Test.Syd.GoldenSpec + Test.Syd.OptParseSpec Test.Syd.PathSpec Test.Syd.ScenarioSpec Test.Syd.Specify.AllOuterSpec diff --git a/test/Test/Syd/OptParseSpec.hs b/test/Test/Syd/OptParseSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Syd/OptParseSpec.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Syd.OptParseSpec (spec) where + +import Test.Syd +import Test.Syd.OptParse + +spec :: Spec +spec = do + describe "combineToSettings" $ do + it "works for this default settinsg example" $ do + let flags = defaultFlags + environment = defaultEnvironment + mConf = Nothing + settings = defaultSettings + combineToSettings flags environment mConf `shouldReturn` settings + + it "works for this debug example" $ do + let flags = defaultFlags {flagDebug = Just True} + environment = defaultEnvironment + mConf = Nothing + settings = + defaultSettings + { settingThreads = Synchronous, + settingRandomiseExecutionOrder = False, + settingFailFast = True, + settingDebug = True + } + combineToSettings flags environment mConf `shouldReturn` settings