{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.Syd.OptParse where

import Autodocodec
import Control.Applicative
import Control.Concurrent (getNumCapabilities)
import Control.Monad
import Control.Monad.IO.Class
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text.IO as TIO
import GHC.Generics (Generic)
import OptEnvConf
import Path
import Path.IO
import Paths_sydtest (version)
import Test.Syd.Run
import Text.Colour

#ifdef mingw32_HOST_OS
import System.Console.ANSI (hSupportsANSIColor)
#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"

-- | Test suite definition and run settings
data Settings = Settings
  { -- | The seed to use for deterministic randomness
    Settings -> SeedSetting
settingSeed :: !SeedSetting,
    -- | Randomise the execution order of the tests in the test suite
    Settings -> Bool
settingRandomiseExecutionOrder :: !Bool,
    -- | How parallel to run the test suite
    Settings -> Threads
settingThreads :: !Threads,
    -- | How many examples to run a property test with
    Settings -> Int
settingMaxSuccess :: !Int,
    -- | The maximum size parameter to supply to generators
    Settings -> Int
settingMaxSize :: !Int,
    -- | The maximum number of discarded examples per tested example
    Settings -> Int
settingMaxDiscard :: !Int,
    -- | The maximum number of tries to use while shrinking a counterexample.
    Settings -> Int
settingMaxShrinks :: !Int,
    -- | Whether to write golden tests if they do not exist yet
    Settings -> Bool
settingGoldenStart :: !Bool,
    -- | Whether to overwrite golden tests instead of having them fail
    Settings -> Bool
settingGoldenReset :: !Bool,
    -- | Whether to use colour in the output
    Settings -> TerminalCapabilities
settingTerminalCapabilities :: !TerminalCapabilities,
    -- | The filters to use to select which tests to run
    Settings -> [Text]
settingFilters :: ![Text],
    -- | Whether to stop upon the first test failure
    Settings -> Bool
settingFailFast :: !Bool,
    -- | How many iterations to use to look diagnose flakiness
    Settings -> Iterations
settingIterations :: !Iterations,
    -- | How many microseconds wait for a test to finish before considering it failed
    Settings -> Timeout
settingTimeout :: !Timeout,
    -- | How many times to retry a test for flakiness diagnostics
    Settings -> Word
settingRetries :: !Word,
    -- | Whether to fail when any flakiness is detected in tests declared as flaky
    Settings -> Bool
settingFailOnFlaky :: !Bool,
    -- | Whether to skip running tests that have already passed.
    Settings -> Bool
settingSkipPassed :: !Bool,
    -- | Where to store the report
    Settings -> Maybe (Path Abs File)
settingReportFile :: !(Maybe (Path Abs File)),
    -- | How to report progress
    Settings -> ReportProgress
settingReportProgress :: !ReportProgress,
    -- | Profiling mode
    Settings -> Bool
settingProfile :: !Bool,
    -- | Output format
    Settings -> OutputFormat
settingOutputFormat :: !OutputFormat
  }
  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)

-- | Output format for test results
data OutputFormat
  = -- | Pretty output with colors, unicode symbols, and detailed formatting
    OutputFormatPretty
  | -- | Terse output optimized for machine/AI consumption
    OutputFormatTerse
  deriving (Int -> OutputFormat -> ShowS
[OutputFormat] -> ShowS
OutputFormat -> String
(Int -> OutputFormat -> ShowS)
-> (OutputFormat -> String)
-> ([OutputFormat] -> ShowS)
-> Show OutputFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutputFormat -> ShowS
showsPrec :: Int -> OutputFormat -> ShowS
$cshow :: OutputFormat -> String
show :: OutputFormat -> String
$cshowList :: [OutputFormat] -> ShowS
showList :: [OutputFormat] -> ShowS
Show, OutputFormat -> OutputFormat -> Bool
(OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> Bool) -> Eq OutputFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputFormat -> OutputFormat -> Bool
== :: OutputFormat -> OutputFormat -> Bool
$c/= :: OutputFormat -> OutputFormat -> Bool
/= :: OutputFormat -> OutputFormat -> Bool
Eq, (forall x. OutputFormat -> Rep OutputFormat x)
-> (forall x. Rep OutputFormat x -> OutputFormat)
-> Generic OutputFormat
forall x. Rep OutputFormat x -> OutputFormat
forall x. OutputFormat -> Rep OutputFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OutputFormat -> Rep OutputFormat x
from :: forall x. OutputFormat -> Rep OutputFormat x
$cto :: forall x. Rep OutputFormat x -> OutputFormat
to :: forall x. Rep OutputFormat x -> OutputFormat
Generic, Int -> OutputFormat
OutputFormat -> Int
OutputFormat -> [OutputFormat]
OutputFormat -> OutputFormat
OutputFormat -> OutputFormat -> [OutputFormat]
OutputFormat -> OutputFormat -> OutputFormat -> [OutputFormat]
(OutputFormat -> OutputFormat)
-> (OutputFormat -> OutputFormat)
-> (Int -> OutputFormat)
-> (OutputFormat -> Int)
-> (OutputFormat -> [OutputFormat])
-> (OutputFormat -> OutputFormat -> [OutputFormat])
-> (OutputFormat -> OutputFormat -> [OutputFormat])
-> (OutputFormat -> OutputFormat -> OutputFormat -> [OutputFormat])
-> Enum OutputFormat
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: OutputFormat -> OutputFormat
succ :: OutputFormat -> OutputFormat
$cpred :: OutputFormat -> OutputFormat
pred :: OutputFormat -> OutputFormat
$ctoEnum :: Int -> OutputFormat
toEnum :: Int -> OutputFormat
$cfromEnum :: OutputFormat -> Int
fromEnum :: OutputFormat -> Int
$cenumFrom :: OutputFormat -> [OutputFormat]
enumFrom :: OutputFormat -> [OutputFormat]
$cenumFromThen :: OutputFormat -> OutputFormat -> [OutputFormat]
enumFromThen :: OutputFormat -> OutputFormat -> [OutputFormat]
$cenumFromTo :: OutputFormat -> OutputFormat -> [OutputFormat]
enumFromTo :: OutputFormat -> OutputFormat -> [OutputFormat]
$cenumFromThenTo :: OutputFormat -> OutputFormat -> OutputFormat -> [OutputFormat]
enumFromThenTo :: OutputFormat -> OutputFormat -> OutputFormat -> [OutputFormat]
Enum, OutputFormat
OutputFormat -> OutputFormat -> Bounded OutputFormat
forall a. a -> a -> Bounded a
$cminBound :: OutputFormat
minBound :: OutputFormat
$cmaxBound :: OutputFormat
maxBound :: OutputFormat
Bounded)

instance HasCodec OutputFormat where
  codec :: JSONCodec OutputFormat
codec =
    NonEmpty (OutputFormat, Text) -> JSONCodec OutputFormat
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec (NonEmpty (OutputFormat, Text) -> JSONCodec OutputFormat)
-> NonEmpty (OutputFormat, Text) -> JSONCodec OutputFormat
forall a b. (a -> b) -> a -> b
$
      (OutputFormat
OutputFormatPretty, Text
"pretty")
        (OutputFormat, Text)
-> [(OutputFormat, Text)] -> NonEmpty (OutputFormat, Text)
forall a. a -> [a] -> NonEmpty a
:| [(OutputFormat
OutputFormatTerse, Text
"terse")]

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 -> IO (Either String Settings))
-> Parser Flags -> Parser Settings
forall a b.
HasCallStack =>
(a -> IO (Either String b)) -> Parser a -> Parser b
checkMapIO Flags -> IO (Either String Settings)
combine Parser Flags
forall a. HasParser a => Parser a
settingsParser
    where
      combine :: Flags -> IO (Either String Settings)
      combine :: Flags -> IO (Either String Settings)
combine Flags {Bool
Int
[Text]
Maybe Bool
Maybe Word
Maybe (Path Abs File)
Maybe ReportProgress
Maybe Threads
Maybe OutputFormat
SeedSetting
Iterations
Timeout
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
flagTimeout :: Timeout
flagFailOnFlaky :: Bool
flagSkipPassed :: Bool
flagReportFile :: Maybe (Path Abs File)
flagReportProgress :: Maybe ReportProgress
flagDebug :: Bool
flagProfile :: Bool
flagAiExecutor :: Maybe Bool
flagOutputFormat :: Maybe OutputFormat
flagOutputFormat :: Flags -> Maybe OutputFormat
flagAiExecutor :: Flags -> Maybe Bool
flagProfile :: Flags -> Bool
flagDebug :: Flags -> Bool
flagReportProgress :: Flags -> Maybe ReportProgress
flagReportFile :: Flags -> Maybe (Path Abs File)
flagSkipPassed :: Flags -> Bool
flagFailOnFlaky :: Flags -> Bool
flagTimeout :: Flags -> Timeout
flagRetries :: Flags -> Maybe Word
flagIterations :: Flags -> Iterations
flagFailFast :: Flags -> Maybe Bool
flagFilters :: Flags -> [Text]
flagColour :: Flags -> Maybe Bool
flagGoldenReset :: Flags -> Bool
flagGoldenStart :: Flags -> Bool
flagMaxShrinks :: Flags -> Int
flagMaxDiscard :: Flags -> Int
flagMaxSuccess :: Flags -> Int
flagMaxSize :: Flags -> Int
flagThreads :: Flags -> Maybe Threads
flagRandomiseExecutionOrder :: Flags -> Maybe Bool
flagSeed :: Flags -> SeedSetting
..} = do
        let d :: forall a. (Settings -> a) -> a
            d :: forall a. (Settings -> a) -> a
d Settings -> a
func = Settings -> a
func Settings
defaultSettings
        TerminalCapabilities
terminalCapabilities <- case Maybe Bool
flagColour 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 -> case Maybe Bool
flagAiExecutor of
            Just Bool
True -> TerminalCapabilities -> IO TerminalCapabilities
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TerminalCapabilities
WithoutColours
            Maybe Bool
_ -> IO TerminalCapabilities
detectTerminalCapabilities

        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 a. (Settings -> a) -> a
d Settings -> Threads
settingThreads
                )
                Maybe Threads
flagThreads
        case Threads
threads of
          Threads
ByCapabilities -> do
            Int
i <- IO Int
getNumCapabilities

            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
              let outputLine :: [Chunk] -> IO ()
                  outputLine :: [Chunk] -> IO ()
outputLine [Chunk]
lineChunks = IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    TerminalCapabilities -> [Chunk] -> IO ()
putChunksLocaleWith TerminalCapabilities
terminalCapabilities [Chunk]
lineChunks
                    Text -> IO ()
TIO.putStrLn Text
""
              (Chunk -> IO ()) -> [Chunk] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
                ( [Chunk] -> IO ()
outputLine
                    ([Chunk] -> IO ()) -> (Chunk -> [Chunk]) -> Chunk -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [])
                    (Chunk -> [Chunk]) -> (Chunk -> Chunk) -> Chunk -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colour -> Chunk -> Chunk
fore Colour
red
                )
                [ Text -> Chunk
chunk Text
"WARNING: Only one CPU core detected, make sure to compile your test suite with these ghc options:",
                  Text -> Chunk
chunk Text
"         -threaded -rtsopts -with-rtsopts=-N",
                  Text -> Chunk
chunk Text
"         (This is important for correctness as well as speed, as a parallel test suite can find thread safety problems.)"
                ]
          Threads
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Either String ReportProgress
errOrProgress <- case Maybe ReportProgress
flagReportProgress of
          Maybe ReportProgress
Nothing ->
            Either String ReportProgress -> IO (Either String ReportProgress)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ReportProgress -> IO (Either String ReportProgress))
-> Either String ReportProgress
-> IO (Either String ReportProgress)
forall a b. (a -> b) -> a -> b
$
              ReportProgress -> Either String ReportProgress
forall a b. b -> Either a b
Right (ReportProgress -> Either String ReportProgress)
-> ReportProgress -> Either String 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 a. (Settings -> a) -> a
d Settings -> ReportProgress
settingReportProgress
                  else (Settings -> ReportProgress) -> ReportProgress
forall a. (Settings -> a) -> a
d Settings -> ReportProgress
settingReportProgress
          Just ReportProgress
ReportNoProgress -> Either String ReportProgress -> IO (Either String ReportProgress)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ReportProgress -> IO (Either String ReportProgress))
-> Either String ReportProgress
-> IO (Either String ReportProgress)
forall a b. (a -> b) -> a -> b
$ ReportProgress -> Either String ReportProgress
forall a b. b -> Either a b
Right ReportProgress
ReportNoProgress
          Just ReportProgress
ReportProgress ->
            if Threads
threads Threads -> Threads -> Bool
forall a. Eq a => a -> a -> Bool
/= Threads
Synchronous
              then Either String ReportProgress -> IO (Either String ReportProgress)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ReportProgress -> IO (Either String ReportProgress))
-> Either String ReportProgress
-> IO (Either String ReportProgress)
forall a b. (a -> b) -> a -> b
$ String -> Either String ReportProgress
forall a b. a -> Either a b
Left String
"Reporting progress in asynchronous runners is not supported. You can use --synchronous or --debug to use a synchronous runner."
              else Either String ReportProgress -> IO (Either String ReportProgress)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ReportProgress -> IO (Either String ReportProgress))
-> Either String ReportProgress
-> IO (Either String ReportProgress)
forall a b. (a -> b) -> a -> b
$ ReportProgress -> Either String ReportProgress
forall a b. b -> Either a b
Right ReportProgress
ReportProgress
        Either String ReportProgress
-> (ReportProgress -> IO Settings) -> IO (Either String Settings)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Either String ReportProgress
errOrProgress ((ReportProgress -> IO Settings) -> IO (Either String Settings))
-> (ReportProgress -> IO Settings) -> IO (Either String Settings)
forall a b. (a -> b) -> a -> b
$ \ReportProgress
progress -> do
          Settings -> IO Settings
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Settings -> IO Settings) -> Settings -> IO Settings
forall a b. (a -> b) -> a -> b
$
            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 a. (Settings -> a) -> a
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,
                settingTerminalCapabilities :: TerminalCapabilities
settingTerminalCapabilities = TerminalCapabilities
terminalCapabilities,
                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 a. (Settings -> a) -> a
d Settings -> Bool
settingFailFast
                    )
                    Maybe Bool
flagFailFast,
                settingIterations :: Iterations
settingIterations = Iterations
flagIterations,
                settingTimeout :: Timeout
settingTimeout = Timeout
flagTimeout,
                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 a. (Settings -> a) -> a
d Settings -> Word
settingRetries
                    )
                    Maybe Word
flagRetries,
                settingFailOnFlaky :: Bool
settingFailOnFlaky = Bool
flagFailOnFlaky,
                settingSkipPassed :: Bool
settingSkipPassed = Bool
flagSkipPassed,
                settingReportFile :: Maybe (Path Abs File)
settingReportFile = Maybe (Path Abs File)
flagReportFile,
                settingReportProgress :: ReportProgress
settingReportProgress = ReportProgress
progress,
                settingProfile :: Bool
settingProfile = Bool
flagProfile,
                settingOutputFormat :: OutputFormat
settingOutputFormat =
                  OutputFormat -> Maybe OutputFormat -> OutputFormat
forall a. a -> Maybe a -> a
fromMaybe
                    ( case Maybe Bool
flagAiExecutor of
                        Maybe Bool
Nothing -> OutputFormat
OutputFormatPretty
                        Just Bool
False -> OutputFormat
OutputFormatPretty
                        Just Bool
True -> OutputFormat
OutputFormatTerse
                    )
                    Maybe OutputFormat
flagOutputFormat
              }

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,
          settingTerminalCapabilities :: TerminalCapabilities
settingTerminalCapabilities = TerminalCapabilities
With8BitColours,
          settingFilters :: [Text]
settingFilters = [Text]
forall a. Monoid a => a
mempty,
          settingFailFast :: Bool
settingFailFast = Bool
False,
          settingIterations :: Iterations
settingIterations = Iterations
OneIteration,
          settingTimeout :: Timeout
settingTimeout = Int -> Timeout
TimeoutAfterMicros Int
defaultTimeout,
          settingRetries :: Word
settingRetries = Word
defaultRetries,
          settingFailOnFlaky :: Bool
settingFailOnFlaky = Bool
False,
          settingSkipPassed :: Bool
settingSkipPassed = Bool
False,
          settingReportProgress :: ReportProgress
settingReportProgress = ReportProgress
ReportNoProgress,
          settingReportFile :: Maybe (Path Abs File)
settingReportFile = Maybe (Path Abs File)
forall a. Maybe a
Nothing,
          settingProfile :: Bool
settingProfile = Bool
False,
          settingOutputFormat :: OutputFormat
settingOutputFormat = OutputFormat
OutputFormatPretty
        }

-- 60 seconds
defaultTimeout :: Int
defaultTimeout :: Int
defaultTimeout = Int
60_000_000

defaultRetries :: Word
defaultRetries :: Word
defaultRetries = Word
3

#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

-- 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
  { 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 -> Timeout
flagTimeout :: !Timeout,
    Flags -> Bool
flagFailOnFlaky :: !Bool,
    Flags -> Bool
flagSkipPassed :: !Bool,
    Flags -> Maybe (Path Abs File)
flagReportFile :: !(Maybe (Path Abs File)),
    Flags -> Maybe ReportProgress
flagReportProgress :: !(Maybe ReportProgress),
    Flags -> Bool
flagDebug :: !Bool,
    Flags -> Bool
flagProfile :: !Bool,
    Flags -> Maybe Bool
flagAiExecutor :: !(Maybe Bool),
    Flags -> Maybe OutputFormat
flagOutputFormat :: !(Maybe OutputFormat)
  }
  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
    Timeout
flagTimeout <- Parser Timeout
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
        ]
    Bool
flagSkipPassed <-
      HasCallStack => [Builder Bool] -> Parser Bool
[Builder Bool] -> Parser Bool
yesNoSwitch
        [ String -> Builder Bool
forall a. String -> Builder a
help (String -> Builder Bool) -> String -> Builder Bool
forall a b. (a -> b) -> a -> b
$
            [String] -> String
unlines
              [ String
"Skip tests that have already passed. When every test has passed, rerun them all.",
                String
"Note that you have to run with this flag once before it can activate."
              ],
          String -> Builder Bool
forall a. HasCodec a => String -> Builder a
name String
"skip-passed",
          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
settingSkipPassed Settings
defaultSettings
        ]
    Maybe (Path Abs File)
flagReportFile <-
      Parser (Path Abs File) -> Parser (Maybe (Path Abs File))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser (Path Abs File) -> Parser (Maybe (Path Abs File)))
-> Parser (Path Abs File) -> Parser (Maybe (Path Abs File))
forall a b. (a -> b) -> a -> b
$
        HasCallStack => [Builder String] -> Parser (Path Abs File)
[Builder String] -> Parser (Path Abs File)
filePathSetting
          [ String -> Builder String
forall a. String -> Builder a
help String
"Where to store the the test report for --skip-passed",
            String -> Builder String
forall a. HasCodec a => String -> Builder a
name String
"report-file"
          ]
    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
        ]
    Maybe Bool
flagAiExecutor <-
      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
$
        [Parser Bool] -> Parser Bool
forall a. HasCallStack => [Parser a] -> Parser a
choice
          [ [Builder Bool] -> Parser Bool
forall a. HasCallStack => [Builder a] -> Parser a
setting
              [ String -> Builder Bool
forall a. String -> Builder a
help String
"Indicate that an AI is executing tests, sets defaults to 'no colours' and 'terse output'",
                Bool -> Builder Bool
forall a. a -> Builder a
switch Bool
True,
                String -> Builder Bool
forall a. String -> Builder a
long String
"ai-executor"
              ],
            [Builder Bool] -> Parser Bool
forall a. HasCallStack => [Builder a] -> Parser a
setting
              [ String -> Builder Bool
forall a. String -> Builder a
help String
"Turn off ai mode. This lets AIs opt out of ai-executor mode",
                Bool -> Builder Bool
forall a. a -> Builder a
switch Bool
False,
                String -> Builder Bool
forall a. String -> Builder a
long String
"no-ai-executor"
              ],
            [Builder Bool] -> Parser Bool
forall a. HasCallStack => [Builder a] -> Parser a
setting
              [ String -> Builder Bool
forall a. String -> Builder a
help String
"Activate AI executor mode based on env vars",
                Reader Bool -> Builder Bool
forall a. Reader a -> Builder a
reader Reader Bool
exists,
                -- Feel free to add env vars here.
                String -> Builder Bool
forall a. String -> Builder a
unprefixedEnv String
"CLAUDECODE",
                String -> Builder Bool
forall a. String -> Builder a
metavar String
"ANY"
              ]
          ]

    Maybe OutputFormat
flagOutputFormat <-
      Parser OutputFormat -> Parser (Maybe OutputFormat)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser OutputFormat -> Parser (Maybe OutputFormat))
-> Parser OutputFormat -> Parser (Maybe OutputFormat)
forall a b. (a -> b) -> a -> b
$
        [Parser OutputFormat] -> Parser OutputFormat
forall a. HasCallStack => [Parser a] -> Parser a
choice
          [ [Builder OutputFormat] -> Parser OutputFormat
forall a. HasCallStack => [Builder a] -> Parser a
setting
              [ String -> Builder OutputFormat
forall a. String -> Builder a
help String
"Use terse output (compact, no colors, failures only)",
                OutputFormat -> Builder OutputFormat
forall a. a -> Builder a
switch OutputFormat
OutputFormatTerse,
                String -> Builder OutputFormat
forall a. String -> Builder a
long String
"terse"
              ],
            [Builder OutputFormat] -> Parser OutputFormat
forall a. HasCallStack => [Builder a] -> Parser a
setting
              [ String -> Builder OutputFormat
forall a. String -> Builder a
help String
"Use pretty output (colors, unicode, detailed formatting)",
                OutputFormat -> Builder OutputFormat
forall a. a -> Builder a
switch OutputFormat
OutputFormatPretty,
                String -> Builder OutputFormat
forall a. String -> Builder a
long String
"pretty"
              ]
          ]
    pure Flags {Bool
Int
[Text]
Maybe Bool
Maybe Word
Maybe (Path Abs File)
Maybe ReportProgress
Maybe Threads
Maybe OutputFormat
SeedSetting
Iterations
Timeout
flagOutputFormat :: Maybe OutputFormat
flagAiExecutor :: Maybe Bool
flagProfile :: Bool
flagDebug :: Bool
flagReportProgress :: Maybe ReportProgress
flagReportFile :: Maybe (Path Abs File)
flagSkipPassed :: Bool
flagFailOnFlaky :: Bool
flagTimeout :: Timeout
flagRetries :: Maybe Word
flagIterations :: Iterations
flagFailFast :: Maybe Bool
flagFilters :: [Text]
flagColour :: Maybe Bool
flagGoldenReset :: Bool
flagGoldenStart :: Bool
flagMaxShrinks :: Int
flagMaxDiscard :: Int
flagMaxSuccess :: Int
flagMaxSize :: Int
flagThreads :: Maybe Threads
flagRandomiseExecutionOrder :: Maybe Bool
flagSeed :: SeedSetting
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
flagTimeout :: Timeout
flagRetries :: Maybe Word
flagFailOnFlaky :: Bool
flagSkipPassed :: Bool
flagReportFile :: Maybe (Path Abs File)
flagReportProgress :: Maybe ReportProgress
flagDebug :: Bool
flagProfile :: Bool
flagAiExecutor :: Maybe Bool
flagOutputFormat :: Maybe OutputFormat
..}

data Timeout
  = DoNotTimeout
  | TimeoutAfterMicros !Int
  deriving (Int -> Timeout -> ShowS
[Timeout] -> ShowS
Timeout -> String
(Int -> Timeout -> ShowS)
-> (Timeout -> String) -> ([Timeout] -> ShowS) -> Show Timeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Timeout -> ShowS
showsPrec :: Int -> Timeout -> ShowS
$cshow :: Timeout -> String
show :: Timeout -> String
$cshowList :: [Timeout] -> ShowS
showList :: [Timeout] -> ShowS
Show, ReadPrec [Timeout]
ReadPrec Timeout
Int -> ReadS Timeout
ReadS [Timeout]
(Int -> ReadS Timeout)
-> ReadS [Timeout]
-> ReadPrec Timeout
-> ReadPrec [Timeout]
-> Read Timeout
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Timeout
readsPrec :: Int -> ReadS Timeout
$creadList :: ReadS [Timeout]
readList :: ReadS [Timeout]
$creadPrec :: ReadPrec Timeout
readPrec :: ReadPrec Timeout
$creadListPrec :: ReadPrec [Timeout]
readListPrec :: ReadPrec [Timeout]
Read, Timeout -> Timeout -> Bool
(Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool) -> Eq Timeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Timeout -> Timeout -> Bool
== :: Timeout -> Timeout -> Bool
$c/= :: Timeout -> Timeout -> Bool
/= :: Timeout -> Timeout -> Bool
Eq, (forall x. Timeout -> Rep Timeout x)
-> (forall x. Rep Timeout x -> Timeout) -> Generic Timeout
forall x. Rep Timeout x -> Timeout
forall x. Timeout -> Rep Timeout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Timeout -> Rep Timeout x
from :: forall x. Timeout -> Rep Timeout x
$cto :: forall x. Rep Timeout x -> Timeout
to :: forall x. Rep Timeout x -> Timeout
Generic)

instance HasCodec Timeout where
  codec :: JSONCodec Timeout
codec = (Maybe Int -> Timeout)
-> (Timeout -> Maybe Int)
-> Codec Value (Maybe Int) (Maybe Int)
-> JSONCodec Timeout
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Maybe Int -> Timeout
f Timeout -> Maybe Int
g Codec Value (Maybe Int) (Maybe Int)
forall value. HasCodec value => JSONCodec value
codec
    where
      f :: Maybe Int -> Timeout
f = \case
        Maybe Int
Nothing -> Timeout
DoNotTimeout
        Just Int
i -> Int -> Timeout
TimeoutAfterMicros Int
i
      g :: Timeout -> Maybe Int
g = \case
        Timeout
DoNotTimeout -> Maybe Int
forall a. Maybe a
Nothing
        TimeoutAfterMicros Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i

instance HasParser Timeout where
  settingsParser :: Parser Timeout
settingsParser =
    [Parser Timeout] -> Parser Timeout
forall a. HasCallStack => [Parser a] -> Parser a
choice
      [ [Builder Timeout] -> Parser Timeout
forall a. HasCallStack => [Builder a] -> Parser a
setting
          [ String -> Builder Timeout
forall a. String -> Builder a
help String
"Don't timeout",
            Timeout -> Builder Timeout
forall a. a -> Builder a
switch Timeout
DoNotTimeout,
            String -> Builder Timeout
forall a. String -> Builder a
long String
"no-timeout"
          ],
        Int -> Timeout
TimeoutAfterMicros
          (Int -> Timeout) -> Parser Int -> Parser Timeout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Builder Int] -> Parser Int
forall a. HasCallStack => [Builder a] -> Parser a
setting
            [ String -> Builder Int
forall a. String -> Builder a
help String
"After how many microseconds to consider a 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
"timeout",
              Int -> Builder Int
forall a. Show a => a -> Builder a
value Int
defaultTimeout,
              String -> Builder Int
forall a. String -> Builder a
metavar String
"MICROSECONDS"
            ]
      ]

data Threads
  = -- | One thread
    Synchronous
  | -- | As many threads as 'getNumCapabilities' tells you you have
    ByCapabilities
  | -- | A given number of threads
    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
  = -- | 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 (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
  = -- | Don't report any progress, the default
    ReportNoProgress
  | -- | Report progress
    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"
          ]
      ]