{-# 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.Functor ((<&>))
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 Path.IO
import System.Exit
import Test.Syd.Run
import Text.Colour

#ifdef mingw32_HOST_OS
import System.Console.ANSI (hSupportsANSIColor)
import System.IO (stdout)
#else
import Text.Colour.Capabilities.FromEnv
#endif

getSettings :: IO Settings
getSettings :: IO Settings
getSettings = do
  Flags
flags <- IO Flags
getFlags
  Environment
env <- IO Environment
getEnvironment
  Maybe Configuration
config <- Flags -> Environment -> IO (Maybe Configuration)
getConfiguration Flags
flags Environment
env
  Flags -> Environment -> Maybe Configuration -> IO Settings
combineToSettings Flags
flags Environment
env Maybe Configuration
config

-- | 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 -> Maybe Bool
settingColour :: !(Maybe Bool),
    -- | 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 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,
    -- | How to report progress
    Settings -> ReportProgress
settingReportProgress :: !ReportProgress,
    -- | Debug mode
    Settings -> Bool
settingDebug :: !Bool,
    -- | Profiling mode
    Settings -> Bool
settingProfile :: !Bool
  }
  deriving (Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Settings] -> ShowS
$cshowList :: [Settings] -> ShowS
show :: Settings -> String
$cshow :: Settings -> String
showsPrec :: Int -> Settings -> ShowS
$cshowsPrec :: Int -> Settings -> ShowS
Show, Settings -> Settings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Settings -> Settings -> Bool
$c/= :: Settings -> Settings -> Bool
== :: Settings -> Settings -> Bool
$c== :: Settings -> Settings -> Bool
Eq, 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
$cto :: forall x. Rep Settings x -> Settings
$cfrom :: forall x. Settings -> Rep Settings x
Generic)

defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings =
  let d :: (TestRunSettings -> t) -> t
d TestRunSettings -> t
func = TestRunSettings -> t
func TestRunSettings
defaultTestRunSettings
   in Settings
        { settingSeed :: SeedSetting
settingSeed = forall {t}. (TestRunSettings -> t) -> t
d TestRunSettings -> SeedSetting
testRunSettingSeed,
          settingRandomiseExecutionOrder :: Bool
settingRandomiseExecutionOrder = Bool
True,
          settingThreads :: Threads
settingThreads = Threads
ByCapabilities,
          settingMaxSuccess :: Int
settingMaxSuccess = forall {t}. (TestRunSettings -> t) -> t
d TestRunSettings -> Int
testRunSettingMaxSuccess,
          settingMaxSize :: Int
settingMaxSize = forall {t}. (TestRunSettings -> t) -> t
d TestRunSettings -> Int
testRunSettingMaxSize,
          settingMaxDiscard :: Int
settingMaxDiscard = forall {t}. (TestRunSettings -> t) -> t
d TestRunSettings -> Int
testRunSettingMaxDiscardRatio,
          settingMaxShrinks :: Int
settingMaxShrinks = forall {t}. (TestRunSettings -> t) -> t
d TestRunSettings -> Int
testRunSettingMaxShrinks,
          settingGoldenStart :: Bool
settingGoldenStart = forall {t}. (TestRunSettings -> t) -> t
d TestRunSettings -> Bool
testRunSettingGoldenStart,
          settingGoldenReset :: Bool
settingGoldenReset = forall {t}. (TestRunSettings -> t) -> t
d TestRunSettings -> Bool
testRunSettingGoldenReset,
          settingColour :: Maybe Bool
settingColour = forall a. Maybe a
Nothing,
          settingFilters :: [Text]
settingFilters = forall a. Monoid a => a
mempty,
          settingFailFast :: Bool
settingFailFast = Bool
False,
          settingIterations :: Iterations
settingIterations = Iterations
OneIteration,
          settingRetries :: Word
settingRetries = Word
defaultRetries,
          settingFailOnFlaky :: Bool
settingFailOnFlaky = Bool
False,
          settingReportProgress :: ReportProgress
settingReportProgress = ReportProgress
ReportNoProgress,
          settingDebug :: Bool
settingDebug = Bool
False,
          settingProfile :: Bool
settingProfile = Bool
False
        }

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

deriveTerminalCapababilities :: Settings -> IO TerminalCapabilities
deriveTerminalCapababilities :: Settings -> IO TerminalCapabilities
deriveTerminalCapababilities Settings
settings = case Settings -> Maybe Bool
settingColour Settings
settings of
  Just Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TerminalCapabilities
WithoutColours
  Just Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TerminalCapabilities
With8BitColours
  Maybe Bool
Nothing -> IO TerminalCapabilities
detectTerminalCapabilities

#ifdef mingw32_HOST_OS
detectTerminalCapabilities :: IO TerminalCapabilities
detectTerminalCapabilities = do
  supports <- hSupportsANSIColor stdout
  if supports
    then pure With8BitColours
    else pure WithoutColours
#else
detectTerminalCapabilities :: IO TerminalCapabilities
detectTerminalCapabilities :: IO TerminalCapabilities
detectTerminalCapabilities = IO TerminalCapabilities
getTerminalCapabilitiesFromEnv
#endif

data 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Threads] -> ShowS
$cshowList :: [Threads] -> ShowS
show :: Threads -> String
$cshow :: Threads -> String
showsPrec :: Int -> Threads -> ShowS
$cshowsPrec :: Int -> Threads -> ShowS
Show, ReadPrec [Threads]
ReadPrec Threads
Int -> ReadS Threads
ReadS [Threads]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Threads]
$creadListPrec :: ReadPrec [Threads]
readPrec :: ReadPrec Threads
$creadPrec :: ReadPrec Threads
readList :: ReadS [Threads]
$creadList :: ReadS [Threads]
readsPrec :: Int -> ReadS Threads
$creadsPrec :: Int -> ReadS Threads
Read, Threads -> Threads -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Threads -> Threads -> Bool
$c/= :: Threads -> Threads -> Bool
== :: Threads -> Threads -> Bool
$c== :: Threads -> Threads -> Bool
Eq, 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
$cto :: forall x. Rep Threads x -> Threads
$cfrom :: forall x. Threads -> Rep Threads x
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 (Int -> Iterations -> ShowS
[Iterations] -> ShowS
Iterations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Iterations] -> ShowS
$cshowList :: [Iterations] -> ShowS
show :: Iterations -> String
$cshow :: Iterations -> String
showsPrec :: Int -> Iterations -> ShowS
$cshowsPrec :: Int -> Iterations -> ShowS
Show, ReadPrec [Iterations]
ReadPrec Iterations
Int -> ReadS Iterations
ReadS [Iterations]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Iterations]
$creadListPrec :: ReadPrec [Iterations]
readPrec :: ReadPrec Iterations
$creadPrec :: ReadPrec Iterations
readList :: ReadS [Iterations]
$creadList :: ReadS [Iterations]
readsPrec :: Int -> ReadS Iterations
$creadsPrec :: Int -> ReadS Iterations
Read, Iterations -> Iterations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Iterations -> Iterations -> Bool
$c/= :: Iterations -> Iterations -> Bool
== :: Iterations -> Iterations -> Bool
$c== :: Iterations -> Iterations -> Bool
Eq, 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
$cto :: forall x. Rep Iterations x -> Iterations
$cfrom :: forall x. Iterations -> Rep Iterations x
Generic)

data ReportProgress
  = -- | Don't report any progress, the default
    ReportNoProgress
  | -- | Report progress
    ReportProgress
  deriving (Int -> ReportProgress -> ShowS
[ReportProgress] -> ShowS
ReportProgress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReportProgress] -> ShowS
$cshowList :: [ReportProgress] -> ShowS
show :: ReportProgress -> String
$cshow :: ReportProgress -> String
showsPrec :: Int -> ReportProgress -> ShowS
$cshowsPrec :: Int -> ReportProgress -> ShowS
Show, ReadPrec [ReportProgress]
ReadPrec ReportProgress
Int -> ReadS ReportProgress
ReadS [ReportProgress]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReportProgress]
$creadListPrec :: ReadPrec [ReportProgress]
readPrec :: ReadPrec ReportProgress
$creadPrec :: ReadPrec ReportProgress
readList :: ReadS [ReportProgress]
$creadList :: ReadS [ReportProgress]
readsPrec :: Int -> ReadS ReportProgress
$creadsPrec :: Int -> ReadS ReportProgress
Read, ReportProgress -> ReportProgress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReportProgress -> ReportProgress -> Bool
$c/= :: ReportProgress -> ReportProgress -> Bool
== :: ReportProgress -> ReportProgress -> Bool
$c== :: ReportProgress -> ReportProgress -> Bool
Eq, 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
$cto :: forall x. Rep ReportProgress x -> ReportProgress
$cfrom :: forall x. ReportProgress -> Rep ReportProgress x
Generic)

-- | Combine everything to 'Settings'
combineToSettings :: Flags -> Environment -> Maybe Configuration -> IO Settings
combineToSettings :: Flags -> Environment -> Maybe Configuration -> IO Settings
combineToSettings Flags {[Text]
Maybe Bool
Maybe Int
Maybe String
Maybe Word
Maybe SeedSetting
Maybe Iterations
Maybe Threads
flagProfile :: Flags -> Maybe Bool
flagDebug :: Flags -> Maybe Bool
flagReportProgress :: Flags -> Maybe Bool
flagFailOnFlaky :: Flags -> Maybe Bool
flagRetries :: Flags -> Maybe Word
flagIterations :: Flags -> Maybe Iterations
flagFailFast :: Flags -> Maybe Bool
flagFilters :: Flags -> [Text]
flagColour :: Flags -> Maybe Bool
flagGoldenReset :: Flags -> Maybe Bool
flagGoldenStart :: Flags -> Maybe Bool
flagMaxShrinks :: Flags -> Maybe Int
flagMaxDiscard :: Flags -> Maybe Int
flagMaxSuccess :: Flags -> Maybe Int
flagMaxSize :: Flags -> Maybe Int
flagThreads :: Flags -> Maybe Threads
flagRandomiseExecutionOrder :: Flags -> Maybe Bool
flagSeed :: Flags -> Maybe SeedSetting
flagConfigFile :: Flags -> Maybe String
flagProfile :: Maybe Bool
flagDebug :: Maybe Bool
flagReportProgress :: Maybe Bool
flagFailOnFlaky :: Maybe Bool
flagRetries :: Maybe Word
flagIterations :: Maybe Iterations
flagFailFast :: Maybe Bool
flagFilters :: [Text]
flagColour :: Maybe Bool
flagGoldenReset :: Maybe Bool
flagGoldenStart :: Maybe Bool
flagMaxShrinks :: Maybe Int
flagMaxDiscard :: Maybe Int
flagMaxSuccess :: Maybe Int
flagMaxSize :: Maybe Int
flagThreads :: Maybe Threads
flagRandomiseExecutionOrder :: Maybe Bool
flagSeed :: Maybe SeedSetting
flagConfigFile :: Maybe String
..} Environment {Maybe Bool
Maybe Int
Maybe String
Maybe Word
Maybe Text
Maybe SeedSetting
Maybe Iterations
Maybe Threads
envProfile :: Environment -> Maybe Bool
envDebug :: Environment -> Maybe Bool
envReportProgress :: Environment -> Maybe Bool
envFailOnFlaky :: Environment -> Maybe Bool
envRetries :: Environment -> Maybe Word
envIterations :: Environment -> Maybe Iterations
envFailFast :: Environment -> Maybe Bool
envFilter :: Environment -> Maybe Text
envColour :: Environment -> Maybe Bool
envGoldenReset :: Environment -> Maybe Bool
envGoldenStart :: Environment -> Maybe Bool
envMaxShrinks :: Environment -> Maybe Int
envMaxDiscard :: Environment -> Maybe Int
envMaxSuccess :: Environment -> Maybe Int
envMaxSize :: Environment -> Maybe Int
envThreads :: Environment -> Maybe Threads
envRandomiseExecutionOrder :: Environment -> Maybe Bool
envSeed :: Environment -> Maybe SeedSetting
envConfigFile :: Environment -> Maybe String
envProfile :: Maybe Bool
envDebug :: Maybe Bool
envReportProgress :: Maybe Bool
envFailOnFlaky :: Maybe Bool
envRetries :: Maybe Word
envIterations :: Maybe Iterations
envFailFast :: Maybe Bool
envFilter :: Maybe Text
envColour :: Maybe Bool
envGoldenReset :: Maybe Bool
envGoldenStart :: Maybe Bool
envMaxShrinks :: Maybe Int
envMaxDiscard :: Maybe Int
envMaxSuccess :: Maybe Int
envMaxSize :: Maybe Int
envThreads :: Maybe Threads
envRandomiseExecutionOrder :: Maybe Bool
envSeed :: Maybe SeedSetting
envConfigFile :: Maybe String
..} Maybe Configuration
mConf = do
  let d :: (Settings -> t) -> t
d Settings -> t
func = Settings -> t
func Settings
defaultSettings
  let debugMode :: Bool
debugMode =
        forall a. a -> Maybe a -> a
fromMaybe (forall {t}. (Settings -> t) -> t
d Settings -> Bool
settingDebug) forall a b. (a -> b) -> a -> b
$
          Maybe Bool
flagDebug forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envDebug forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configDebug
  let threads :: Threads
threads =
        forall a. a -> Maybe a -> a
fromMaybe (if Bool
debugMode then Threads
Synchronous else forall {t}. (Settings -> t) -> t
d Settings -> Threads
settingThreads) forall a b. (a -> b) -> a -> b
$
          Maybe Threads
flagThreads forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Threads
envThreads forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Threads
configThreads
  ReportProgress
setReportProgress <-
    case Maybe Bool
flagReportProgress forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envReportProgress forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configReportProgress of
      Maybe Bool
Nothing ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
          if Threads
threads forall a. Eq a => a -> a -> Bool
== Threads
Synchronous
            then
              if Bool
debugMode
                then ReportProgress
ReportProgress
                else forall {t}. (Settings -> t) -> t
d Settings -> ReportProgress
settingReportProgress
            else forall {t}. (Settings -> t) -> t
d Settings -> ReportProgress
settingReportProgress
      Just Bool
progress ->
        if Bool
progress
          then
            if Threads
threads forall a. Eq a => a -> a -> Bool
/= Threads
Synchronous
              then forall a. String -> IO a
die String
"Reporting progress in asynchronous runners is not supported. You can use --synchronous or --debug to use a synchronous runner."
              else forall (f :: * -> *) a. Applicative f => a -> f a
pure ReportProgress
ReportProgress
          else forall (f :: * -> *) a. Applicative f => a -> f a
pure ReportProgress
ReportNoProgress

  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Settings
      { settingSeed :: SeedSetting
settingSeed =
          forall a. a -> Maybe a -> a
fromMaybe (forall {t}. (Settings -> t) -> t
d Settings -> SeedSetting
settingSeed) forall a b. (a -> b) -> a -> b
$
            Maybe SeedSetting
flagSeed forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe SeedSetting
envSeed forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe SeedSetting
configSeed,
        settingRandomiseExecutionOrder :: Bool
settingRandomiseExecutionOrder =
          forall a. a -> Maybe a -> a
fromMaybe (if Bool
debugMode then Bool
False else forall {t}. (Settings -> t) -> t
d Settings -> Bool
settingRandomiseExecutionOrder) forall a b. (a -> b) -> a -> b
$
            Maybe Bool
flagRandomiseExecutionOrder forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envRandomiseExecutionOrder forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configRandomiseExecutionOrder,
        settingThreads :: Threads
settingThreads = Threads
threads,
        settingMaxSuccess :: Int
settingMaxSuccess =
          forall a. a -> Maybe a -> a
fromMaybe (forall {t}. (Settings -> t) -> t
d Settings -> Int
settingMaxSuccess) forall a b. (a -> b) -> a -> b
$
            Maybe Int
flagMaxSuccess forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
envMaxSuccess forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Int
configMaxSuccess,
        settingMaxSize :: Int
settingMaxSize =
          forall a. a -> Maybe a -> a
fromMaybe (forall {t}. (Settings -> t) -> t
d Settings -> Int
settingMaxSize) forall a b. (a -> b) -> a -> b
$
            Maybe Int
flagMaxSize forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
envMaxSize forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Int
configMaxSize,
        settingMaxDiscard :: Int
settingMaxDiscard =
          forall a. a -> Maybe a -> a
fromMaybe (forall {t}. (Settings -> t) -> t
d Settings -> Int
settingMaxDiscard) forall a b. (a -> b) -> a -> b
$
            Maybe Int
flagMaxDiscard forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
envMaxDiscard forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Int
configMaxDiscard,
        settingMaxShrinks :: Int
settingMaxShrinks =
          forall a. a -> Maybe a -> a
fromMaybe (forall {t}. (Settings -> t) -> t
d Settings -> Int
settingMaxShrinks) forall a b. (a -> b) -> a -> b
$
            Maybe Int
flagMaxShrinks forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
envMaxShrinks forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Int
configMaxShrinks,
        settingGoldenStart :: Bool
settingGoldenStart =
          forall a. a -> Maybe a -> a
fromMaybe (forall {t}. (Settings -> t) -> t
d Settings -> Bool
settingGoldenStart) forall a b. (a -> b) -> a -> b
$
            Maybe Bool
flagGoldenStart forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envGoldenStart forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configGoldenStart,
        settingGoldenReset :: Bool
settingGoldenReset =
          forall a. a -> Maybe a -> a
fromMaybe (forall {t}. (Settings -> t) -> t
d Settings -> Bool
settingGoldenReset) forall a b. (a -> b) -> a -> b
$
            Maybe Bool
flagGoldenReset forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envGoldenReset forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configGoldenReset,
        settingColour :: Maybe Bool
settingColour = Maybe Bool
flagColour forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envColour forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configColour,
        settingFilters :: [Text]
settingFilters = [Text]
flagFilters forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Maybe a -> [a]
maybeToList Maybe Text
envFilter forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Maybe a -> [a]
maybeToList (forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configFilter),
        settingFailFast :: Bool
settingFailFast =
          forall a. a -> Maybe a -> a
fromMaybe
            (if Bool
debugMode then Bool
True else forall {t}. (Settings -> t) -> t
d Settings -> Bool
settingFailFast)
            (Maybe Bool
flagFailFast forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envFailFast forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configFailFast),
        settingIterations :: Iterations
settingIterations =
          forall a. a -> Maybe a -> a
fromMaybe (forall {t}. (Settings -> t) -> t
d Settings -> Iterations
settingIterations) forall a b. (a -> b) -> a -> b
$
            Maybe Iterations
flagIterations forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Iterations
envIterations forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Iterations
configIterations,
        settingRetries :: Word
settingRetries =
          forall a. a -> Maybe a -> a
fromMaybe (if Bool
debugMode then Word
0 else forall {t}. (Settings -> t) -> t
d Settings -> Word
settingRetries) forall a b. (a -> b) -> a -> b
$
            Maybe Word
flagRetries forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Word
envRetries forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Word
configRetries,
        settingFailOnFlaky :: Bool
settingFailOnFlaky =
          forall a. a -> Maybe a -> a
fromMaybe (forall {t}. (Settings -> t) -> t
d Settings -> Bool
settingFailOnFlaky) forall a b. (a -> b) -> a -> b
$
            Maybe Bool
flagFailOnFlaky forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envFailOnFlaky forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configFailOnFlaky,
        settingReportProgress :: ReportProgress
settingReportProgress = ReportProgress
setReportProgress,
        settingDebug :: Bool
settingDebug = Bool
debugMode,
        settingProfile :: Bool
settingProfile =
          forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$
            Maybe Bool
flagProfile forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envProfile forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configProfile
      }
  where
    mc :: (Configuration -> Maybe a) -> Maybe a
    mc :: forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe a
f = Maybe Configuration
mConf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Configuration -> Maybe a
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
  { Configuration -> Maybe SeedSetting
configSeed :: !(Maybe SeedSetting),
    Configuration -> Maybe Bool
configRandomiseExecutionOrder :: !(Maybe Bool),
    Configuration -> Maybe Threads
configThreads :: !(Maybe Threads),
    Configuration -> Maybe Int
configMaxSize :: !(Maybe Int),
    Configuration -> Maybe Int
configMaxSuccess :: !(Maybe Int),
    Configuration -> Maybe Int
configMaxDiscard :: !(Maybe Int),
    Configuration -> Maybe Int
configMaxShrinks :: !(Maybe Int),
    Configuration -> Maybe Bool
configGoldenStart :: !(Maybe Bool),
    Configuration -> Maybe Bool
configGoldenReset :: !(Maybe Bool),
    Configuration -> Maybe Bool
configColour :: !(Maybe Bool),
    Configuration -> Maybe Text
configFilter :: !(Maybe Text),
    Configuration -> Maybe Bool
configFailFast :: !(Maybe Bool),
    Configuration -> Maybe Iterations
configIterations :: !(Maybe Iterations),
    Configuration -> Maybe Word
configRetries :: !(Maybe Word),
    Configuration -> Maybe Bool
configFailOnFlaky :: !(Maybe Bool),
    Configuration -> Maybe Bool
configReportProgress :: !(Maybe Bool),
    Configuration -> Maybe Bool
configDebug :: !(Maybe Bool),
    Configuration -> Maybe Bool
configProfile :: !(Maybe Bool)
  }
  deriving (Int -> Configuration -> ShowS
[Configuration] -> ShowS
Configuration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Configuration] -> ShowS
$cshowList :: [Configuration] -> ShowS
show :: Configuration -> String
$cshow :: Configuration -> String
showsPrec :: Int -> Configuration -> ShowS
$cshowsPrec :: Int -> Configuration -> ShowS
Show, Configuration -> Configuration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Configuration -> Configuration -> Bool
$c/= :: Configuration -> Configuration -> Bool
== :: Configuration -> Configuration -> Bool
$c== :: Configuration -> Configuration -> Bool
Eq, forall x. Rep Configuration x -> Configuration
forall x. Configuration -> Rep Configuration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Configuration x -> Configuration
$cfrom :: forall x. Configuration -> Rep Configuration x
Generic)

-- | We use 'autodocodec' for parsing a YAML config.
instance HasCodec Configuration where
  codec :: JSONCodec Configuration
codec =
    forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"Configuration" forall a b. (a -> b) -> a -> b
$
      Maybe SeedSetting
-> Maybe Bool
-> Maybe Threads
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Iterations
-> Maybe Word
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Configuration
Configuration
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"seed" Text
"Seed for random generation of test cases"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe SeedSetting
configSeed
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative
          (forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"randomise-execution-order" Text
"Randomise the execution order of the tests in the test suite")
          (forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"randomize-execution-order" Text
"American spelling")
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configRandomiseExecutionOrder
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"parallelism" Text
"How parallel to execute the tests"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Threads
configThreads
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"max-size" Text
"Maximum size parameter to pass to generators"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Int
configMaxSize
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"max-success" Text
"Number of quickcheck examples to run"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Int
configMaxSuccess
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"max-discard" Text
"Maximum number of discarded tests per successful test before giving up"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Int
configMaxDiscard
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"max-shrinks" Text
"Maximum number of shrinks of a failing test input"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Int
configMaxShrinks
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"golden-start" Text
"Whether to write golden tests if they do not exist yet"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configGoldenStart
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"golden-reset" Text
"Whether to overwrite golden tests instead of having them fail"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configGoldenReset
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative
          (forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"colour" Text
"Whether to use coloured output")
          (forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"color" Text
"American spelling")
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configColour
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"filter" Text
"Filter to select which parts of the test tree to run"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Text
configFilter
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"fail-fast" Text
"Whether to stop executing upon the first test failure"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configFailFast
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"iterations" Text
"How many iterations to use to look diagnose flakiness"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Iterations
configIterations
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"retries" Text
"The number of retries to use for flakiness diagnostics. 0 means 'no flakiness diagnostics'"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Word
configRetries
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"fail-on-flaky" Text
"Whether to fail when any flakiness is detected in tests marked as potentially flaky"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configFailOnFlaky
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"progress" Text
"How to report progres"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configReportProgress
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"debug" Text
"Turn on debug-mode. This implies randomise-execution-order: false, parallelism: 1 and fail-fast: true"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configDebug
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"profile" Text
"Turn on profiling mode"
          forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configProfile

instance HasCodec Threads where
  codec :: JSONCodec Threads
codec = 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 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 -> forall a. Maybe a
Nothing
        Threads
Synchronous -> forall a. a -> Maybe a
Just Word
1
        Asynchronous Word
n -> forall a. a -> Maybe a
Just Word
n

instance HasCodec Iterations where
  codec :: JSONCodec Iterations
codec = 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 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 -> forall a. Maybe a
Nothing
        Iterations
Continuous -> forall a. a -> Maybe a
Just Word
0
        Iterations Word
n -> forall a. a -> Maybe a
Just Word
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 -> IO (Maybe Configuration)
getConfiguration Flags {[Text]
Maybe Bool
Maybe Int
Maybe String
Maybe Word
Maybe SeedSetting
Maybe Iterations
Maybe Threads
flagProfile :: Maybe Bool
flagDebug :: Maybe Bool
flagReportProgress :: Maybe Bool
flagFailOnFlaky :: Maybe Bool
flagRetries :: Maybe Word
flagIterations :: Maybe Iterations
flagFailFast :: Maybe Bool
flagFilters :: [Text]
flagColour :: Maybe Bool
flagGoldenReset :: Maybe Bool
flagGoldenStart :: Maybe Bool
flagMaxShrinks :: Maybe Int
flagMaxDiscard :: Maybe Int
flagMaxSuccess :: Maybe Int
flagMaxSize :: Maybe Int
flagThreads :: Maybe Threads
flagRandomiseExecutionOrder :: Maybe Bool
flagSeed :: Maybe SeedSetting
flagConfigFile :: Maybe String
flagProfile :: Flags -> Maybe Bool
flagDebug :: Flags -> Maybe Bool
flagReportProgress :: Flags -> Maybe Bool
flagFailOnFlaky :: Flags -> Maybe Bool
flagRetries :: Flags -> Maybe Word
flagIterations :: Flags -> Maybe Iterations
flagFailFast :: Flags -> Maybe Bool
flagFilters :: Flags -> [Text]
flagColour :: Flags -> Maybe Bool
flagGoldenReset :: Flags -> Maybe Bool
flagGoldenStart :: Flags -> Maybe Bool
flagMaxShrinks :: Flags -> Maybe Int
flagMaxDiscard :: Flags -> Maybe Int
flagMaxSuccess :: Flags -> Maybe Int
flagMaxSize :: Flags -> Maybe Int
flagThreads :: Flags -> Maybe Threads
flagRandomiseExecutionOrder :: Flags -> Maybe Bool
flagSeed :: Flags -> Maybe SeedSetting
flagConfigFile :: Flags -> Maybe String
..} Environment {Maybe Bool
Maybe Int
Maybe String
Maybe Word
Maybe Text
Maybe SeedSetting
Maybe Iterations
Maybe Threads
envProfile :: Maybe Bool
envDebug :: Maybe Bool
envReportProgress :: Maybe Bool
envFailOnFlaky :: Maybe Bool
envRetries :: Maybe Word
envIterations :: Maybe Iterations
envFailFast :: Maybe Bool
envFilter :: Maybe Text
envColour :: Maybe Bool
envGoldenReset :: Maybe Bool
envGoldenStart :: Maybe Bool
envMaxShrinks :: Maybe Int
envMaxDiscard :: Maybe Int
envMaxSuccess :: Maybe Int
envMaxSize :: Maybe Int
envThreads :: Maybe Threads
envRandomiseExecutionOrder :: Maybe Bool
envSeed :: Maybe SeedSetting
envConfigFile :: Maybe String
envProfile :: Environment -> Maybe Bool
envDebug :: Environment -> Maybe Bool
envReportProgress :: Environment -> Maybe Bool
envFailOnFlaky :: Environment -> Maybe Bool
envRetries :: Environment -> Maybe Word
envIterations :: Environment -> Maybe Iterations
envFailFast :: Environment -> Maybe Bool
envFilter :: Environment -> Maybe Text
envColour :: Environment -> Maybe Bool
envGoldenReset :: Environment -> Maybe Bool
envGoldenStart :: Environment -> Maybe Bool
envMaxShrinks :: Environment -> Maybe Int
envMaxDiscard :: Environment -> Maybe Int
envMaxSuccess :: Environment -> Maybe Int
envMaxSize :: Environment -> Maybe Int
envThreads :: Environment -> Maybe Threads
envRandomiseExecutionOrder :: Environment -> Maybe Bool
envSeed :: Environment -> Maybe SeedSetting
envConfigFile :: Environment -> Maybe String
..} =
  case Maybe String
flagConfigFile forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
envConfigFile of
    Maybe String
Nothing -> IO (Path Abs File)
defaultConfigFile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a r. HasCodec a => Path r File -> IO (Maybe a)
readYamlConfigFile
    Just String
cf -> do
      Path Abs File
afp <- forall (m :: * -> *). MonadIO m => String -> m (Path Abs File)
resolveFile' String
cf
      forall a r. HasCodec a => Path r File -> IO (Maybe a)
readYamlConfigFile Path Abs File
afp

-- | Where to get the configuration file by default.
defaultConfigFile :: IO (Path Abs File)
defaultConfigFile :: IO (Path Abs File)
defaultConfigFile = forall (m :: * -> *). MonadIO m => String -> m (Path Abs File)
resolveFile' String
".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
  { Environment -> Maybe String
envConfigFile :: Maybe FilePath,
    Environment -> Maybe SeedSetting
envSeed :: !(Maybe SeedSetting),
    Environment -> Maybe Bool
envRandomiseExecutionOrder :: !(Maybe Bool),
    Environment -> Maybe Threads
envThreads :: !(Maybe Threads),
    Environment -> Maybe Int
envMaxSize :: !(Maybe Int),
    Environment -> Maybe Int
envMaxSuccess :: !(Maybe Int),
    Environment -> Maybe Int
envMaxDiscard :: !(Maybe Int),
    Environment -> Maybe Int
envMaxShrinks :: !(Maybe Int),
    Environment -> Maybe Bool
envGoldenStart :: !(Maybe Bool),
    Environment -> Maybe Bool
envGoldenReset :: !(Maybe Bool),
    Environment -> Maybe Bool
envColour :: !(Maybe Bool),
    Environment -> Maybe Text
envFilter :: !(Maybe Text),
    Environment -> Maybe Bool
envFailFast :: !(Maybe Bool),
    Environment -> Maybe Iterations
envIterations :: !(Maybe Iterations),
    Environment -> Maybe Word
envRetries :: !(Maybe Word),
    Environment -> Maybe Bool
envFailOnFlaky :: !(Maybe Bool),
    Environment -> Maybe Bool
envReportProgress :: !(Maybe Bool),
    Environment -> Maybe Bool
envDebug :: !(Maybe Bool),
    Environment -> Maybe Bool
envProfile :: !(Maybe Bool)
  }
  deriving (Int -> Environment -> ShowS
[Environment] -> ShowS
Environment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Environment] -> ShowS
$cshowList :: [Environment] -> ShowS
show :: Environment -> String
$cshow :: Environment -> String
showsPrec :: Int -> Environment -> ShowS
$cshowsPrec :: Int -> Environment -> ShowS
Show, Environment -> Environment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Environment -> Environment -> Bool
$c/= :: Environment -> Environment -> Bool
== :: Environment -> Environment -> Bool
$c== :: Environment -> Environment -> Bool
Eq, forall x. Rep Environment x -> Environment
forall x. Environment -> Rep Environment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Environment x -> Environment
$cfrom :: forall x. Environment -> Rep Environment x
Generic)

defaultEnvironment :: Environment
defaultEnvironment :: Environment
defaultEnvironment =
  Environment
    { envConfigFile :: Maybe String
envConfigFile = forall a. Maybe a
Nothing,
      envSeed :: Maybe SeedSetting
envSeed = forall a. Maybe a
Nothing,
      envRandomiseExecutionOrder :: Maybe Bool
envRandomiseExecutionOrder = forall a. Maybe a
Nothing,
      envThreads :: Maybe Threads
envThreads = forall a. Maybe a
Nothing,
      envMaxSize :: Maybe Int
envMaxSize = forall a. Maybe a
Nothing,
      envMaxSuccess :: Maybe Int
envMaxSuccess = forall a. Maybe a
Nothing,
      envMaxDiscard :: Maybe Int
envMaxDiscard = forall a. Maybe a
Nothing,
      envMaxShrinks :: Maybe Int
envMaxShrinks = forall a. Maybe a
Nothing,
      envGoldenStart :: Maybe Bool
envGoldenStart = forall a. Maybe a
Nothing,
      envGoldenReset :: Maybe Bool
envGoldenReset = forall a. Maybe a
Nothing,
      envColour :: Maybe Bool
envColour = forall a. Maybe a
Nothing,
      envFilter :: Maybe Text
envFilter = forall a. Maybe a
Nothing,
      envFailFast :: Maybe Bool
envFailFast = forall a. Maybe a
Nothing,
      envIterations :: Maybe Iterations
envIterations = forall a. Maybe a
Nothing,
      envRetries :: Maybe Word
envRetries = forall a. Maybe a
Nothing,
      envFailOnFlaky :: Maybe Bool
envFailOnFlaky = forall a. Maybe a
Nothing,
      envReportProgress :: Maybe Bool
envReportProgress = forall a. Maybe a
Nothing,
      envDebug :: Maybe Bool
envDebug = forall a. Maybe a
Nothing,
      envProfile :: Maybe Bool
envProfile = forall a. Maybe a
Nothing
    }

getEnvironment :: IO Environment
getEnvironment :: IO Environment
getEnvironment = forall e a.
AsUnset e =>
(Info Error -> Info e) -> Parser e a -> IO a
Env.parse (forall e. String -> Info e -> Info e
Env.header String
"Environment") Parser Error Environment
environmentParser

-- | The 'envparse' parser for the 'Environment'
environmentParser :: Env.Parser Env.Error Environment
environmentParser :: Parser Error Environment
environmentParser =
  forall e a. String -> Parser e a -> Parser e a
Env.prefixed String
"SYDTEST_" forall a b. (a -> b) -> a -> b
$
    Maybe String
-> Maybe SeedSetting
-> Maybe Bool
-> Maybe Threads
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Iterations
-> Maybe Word
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Environment
Environment
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. IsString s => Reader e s
Env.str) String
"CONFIG_FILE" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Config file")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Error (Maybe SeedSetting)
seedSettingEnvironmentParser
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"RANDOMISE_EXECUTION_ORDER" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Randomise the execution order of the tests in the test suite")
              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"RANDOMIZE_EXECUTION_ORDER" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Randomize the execution order of the tests in the test suite")
          )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall e a. (AsUnread e, Read a) => Reader e a
Env.auto forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall e. Word -> Either e Threads
parseThreads)) String
"PARALLELISM" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"How parallel to execute the tests")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"MAX_SIZE" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Maximum size parameter to pass to generators")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"MAX_SUCCESS" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Number of quickcheck examples to run")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"MAX_DISCARD" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Maximum number of discarded tests per successful test before giving up")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"MAX_SHRINKS" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Maximum number of shrinks of a failing test input")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"GOLDEN_START" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Whether to write golden tests if they do not exist yet")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"GOLDEN_RESET" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Whether to overwrite golden tests instead of having them fail")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"COLOUR" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Whether to use coloured output")
              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"COLOR" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Whether to use colored output")
          )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. IsString s => Reader e s
Env.str) String
"FILTER" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Filter to select which parts of the test tree to run")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"FAIL_FAST" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Whether to stop executing upon the first test failure")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall e a. (AsUnread e, Read a) => Reader e a
Env.auto forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall e. Word -> Either e Iterations
parseIterations)) String
"ITERATIONS" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"How many iterations to use to look diagnose flakiness")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"RETRIES" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"The number of retries to use for flakiness diagnostics. 0 means 'no flakiness diagnostics'")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"FAIL_ON_FLAKY" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Whether to fail when flakiness is detected in tests marked as potentially flaky")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"PROGRESS" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Report progress as tests run")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"DEBUG" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Turn on debug mode. This implies RANDOMISE_EXECUTION_ORDER=False, PARALLELISM=1 and FAIL_FAST=True.")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"PROFILE" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Turn on profiling mode.")
  where
    parseThreads :: Word -> Either e Threads
    parseThreads :: forall e. Word -> Either e Threads
parseThreads Word
1 = forall a b. b -> Either a b
Right Threads
Synchronous
    parseThreads Word
i = forall a b. b -> Either a b
Right (Word -> Threads
Asynchronous Word
i)
    parseIterations :: Word -> Either e Iterations
    parseIterations :: forall e. Word -> Either e Iterations
parseIterations Word
0 = forall a b. b -> Either a b
Right Iterations
Continuous
    parseIterations Word
1 = forall a b. b -> Either a b
Right Iterations
OneIteration
    parseIterations Word
i = forall a b. b -> Either a b
Right (Word -> Iterations
Iterations Word
i)

seedSettingEnvironmentParser :: Env.Parser Env.Error (Maybe SeedSetting)
seedSettingEnvironmentParser :: Parser Error (Maybe SeedSetting)
seedSettingEnvironmentParser =
  Maybe Int -> Bool -> Maybe SeedSetting
combine
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"SEED" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Seed for random generation of test cases")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e. String -> Mod Flag Bool -> Parser e Bool
Env.switch String
"RANDOM_SEED" (forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Use a random seed for every test case")
  where
    combine :: Maybe Int -> Bool -> Maybe SeedSetting
    combine :: Maybe Int -> Bool -> Maybe SeedSetting
combine Maybe Int
mSeed Bool
random = if Bool
random then forall a. a -> Maybe a
Just SeedSetting
RandomSeed else Int -> SeedSetting
FixedSeed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mSeed

-- | Get the command-line flags
getFlags :: IO Flags
getFlags :: IO Flags
getFlags = forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser ParserPrefs
prefs_ ParserInfo Flags
flagsParser

-- | The 'optparse-applicative' parsing preferences
prefs_ :: OptParse.ParserPrefs
prefs_ :: ParserPrefs
prefs_ =
  -- I like these preferences. Use what you like.
  ParserPrefs
OptParse.defaultPrefs
    { prefShowHelpOnError :: Bool
OptParse.prefShowHelpOnError = Bool
True,
      prefShowHelpOnEmpty :: Bool
OptParse.prefShowHelpOnEmpty = Bool
True
    }

-- | The @optparse-applicative@ parser for 'Flags'
flagsParser :: OptParse.ParserInfo Flags
flagsParser :: ParserInfo Flags
flagsParser =
  forall a. Parser a -> InfoMod a -> ParserInfo a
OptParse.info
    (forall a. Parser (a -> a)
OptParse.helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Flags
parseFlags)
    (forall a. InfoMod a
OptParse.fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. Maybe Doc -> InfoMod a
OptParse.footerDoc (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
footerStr))
  where
    -- Show the variables from the environment that we parse and the config file format
    footerStr :: String
footerStr =
      [String] -> String
unlines
        [ forall e a. Parser e a -> String
Env.helpDoc Parser Error Environment
environmentParser,
          String
"",
          String
"Configuration file format:",
          Text -> String
T.unpack (forall a. HasCodec a => Text
renderColouredSchemaViaCodec @Configuration)
        ]

-- | The flags that are common across commands.
data Flags = Flags
  { Flags -> Maybe String
flagConfigFile :: !(Maybe FilePath),
    Flags -> Maybe SeedSetting
flagSeed :: !(Maybe SeedSetting),
    Flags -> Maybe Bool
flagRandomiseExecutionOrder :: !(Maybe Bool),
    Flags -> Maybe Threads
flagThreads :: !(Maybe Threads),
    Flags -> Maybe Int
flagMaxSize :: !(Maybe Int),
    Flags -> Maybe Int
flagMaxSuccess :: !(Maybe Int),
    Flags -> Maybe Int
flagMaxDiscard :: !(Maybe Int),
    Flags -> Maybe Int
flagMaxShrinks :: !(Maybe Int),
    Flags -> Maybe Bool
flagGoldenStart :: !(Maybe Bool),
    Flags -> Maybe Bool
flagGoldenReset :: !(Maybe Bool),
    Flags -> Maybe Bool
flagColour :: !(Maybe Bool),
    Flags -> [Text]
flagFilters :: ![Text],
    Flags -> Maybe Bool
flagFailFast :: !(Maybe Bool),
    Flags -> Maybe Iterations
flagIterations :: !(Maybe Iterations),
    Flags -> Maybe Word
flagRetries :: !(Maybe Word),
    Flags -> Maybe Bool
flagFailOnFlaky :: !(Maybe Bool),
    Flags -> Maybe Bool
flagReportProgress :: !(Maybe Bool),
    Flags -> Maybe Bool
flagDebug :: !(Maybe Bool),
    Flags -> Maybe Bool
flagProfile :: !(Maybe Bool)
  }
  deriving (Int -> Flags -> ShowS
[Flags] -> ShowS
Flags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flags] -> ShowS
$cshowList :: [Flags] -> ShowS
show :: Flags -> String
$cshow :: Flags -> String
showsPrec :: Int -> Flags -> ShowS
$cshowsPrec :: Int -> Flags -> ShowS
Show, Flags -> Flags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flags -> Flags -> Bool
$c/= :: Flags -> Flags -> Bool
== :: Flags -> Flags -> Bool
$c== :: Flags -> Flags -> Bool
Eq, 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
$cto :: forall x. Rep Flags x -> Flags
$cfrom :: forall x. Flags -> Rep Flags x
Generic)

defaultFlags :: Flags
defaultFlags :: Flags
defaultFlags =
  Flags
    { flagConfigFile :: Maybe String
flagConfigFile = forall a. Maybe a
Nothing,
      flagSeed :: Maybe SeedSetting
flagSeed = forall a. Maybe a
Nothing,
      flagRandomiseExecutionOrder :: Maybe Bool
flagRandomiseExecutionOrder = forall a. Maybe a
Nothing,
      flagThreads :: Maybe Threads
flagThreads = forall a. Maybe a
Nothing,
      flagMaxSize :: Maybe Int
flagMaxSize = forall a. Maybe a
Nothing,
      flagMaxSuccess :: Maybe Int
flagMaxSuccess = forall a. Maybe a
Nothing,
      flagMaxDiscard :: Maybe Int
flagMaxDiscard = forall a. Maybe a
Nothing,
      flagMaxShrinks :: Maybe Int
flagMaxShrinks = forall a. Maybe a
Nothing,
      flagGoldenStart :: Maybe Bool
flagGoldenStart = forall a. Maybe a
Nothing,
      flagGoldenReset :: Maybe Bool
flagGoldenReset = forall a. Maybe a
Nothing,
      flagColour :: Maybe Bool
flagColour = forall a. Maybe a
Nothing,
      flagFilters :: [Text]
flagFilters = forall a. Monoid a => a
mempty,
      flagFailFast :: Maybe Bool
flagFailFast = forall a. Maybe a
Nothing,
      flagIterations :: Maybe Iterations
flagIterations = forall a. Maybe a
Nothing,
      flagRetries :: Maybe Word
flagRetries = forall a. Maybe a
Nothing,
      flagFailOnFlaky :: Maybe Bool
flagFailOnFlaky = forall a. Maybe a
Nothing,
      flagReportProgress :: Maybe Bool
flagReportProgress = forall a. Maybe a
Nothing,
      flagDebug :: Maybe Bool
flagDebug = forall a. Maybe a
Nothing,
      flagProfile :: Maybe Bool
flagProfile = forall a. Maybe a
Nothing
    }

-- | The 'optparse-applicative' parser for the 'Flags'.
parseFlags :: OptParse.Parser Flags
parseFlags :: Parser Flags
parseFlags =
  Maybe String
-> Maybe SeedSetting
-> Maybe Bool
-> Maybe Threads
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> [Text]
-> Maybe Bool
-> Maybe Iterations
-> Maybe Word
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Flags
Flags
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          ( forall a. Monoid a => [a] -> a
mconcat
              [ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"config-file",
                forall (f :: * -> *) a. String -> Mod f a
help String
"Path to an altenative config file",
                forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH"
              ]
          )
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe SeedSetting)
seedSettingFlags
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
doubleSwitch [String
"randomise-execution-order", String
"randomize-execution-order"] (forall (f :: * -> *) a. String -> Mod f a
help String
"Randomise the execution order of the tests in the test suite")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( ( ( \case
              Word
1 -> Threads
Synchronous
              Word
i -> Word -> Threads
Asynchronous Word
i
          )
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod OptionFields a -> Parser a
option
              forall a. Read a => ReadM a
auto
              ( forall a. Monoid a => [a] -> a
mconcat
                  [ forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'j',
                    forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"jobs",
                    forall (f :: * -> *) a. String -> Mod f a
help String
"How parallel to execute the tests",
                    forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"JOBS"
                  ]
              )
        )
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag'
            Threads
Synchronous
            ( forall a. Monoid a => [a] -> a
mconcat
                [ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"synchronous",
                  forall (f :: * -> *) a. String -> Mod f a
help String
"Execute tests synchronously"
                ]
            )
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          forall a. Read a => ReadM a
auto
          ( forall a. Monoid a => [a] -> a
mconcat
              [ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"max-size",
                forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"qc-max-size",
                forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum size parameter to pass to generators",
                forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"MAXIMUM_SIZE_PARAMETER"
              ]
          )
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          forall a. Read a => ReadM a
auto
          ( forall a. Monoid a => [a] -> a
mconcat
              [ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"max-success",
                forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"qc-max-success",
                forall (f :: * -> *) a. String -> Mod f a
help String
"Number of quickcheck examples to run",
                forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NUMBER_OF_SUCCESSES"
              ]
          )
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          forall a. Read a => ReadM a
auto
          ( forall a. Monoid a => [a] -> a
mconcat
              [ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"max-discard",
                forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"qc-max-discard",
                forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum number of discarded tests per successful test before giving up",
                forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"MAXIMUM_DISCARD_RATIO"
              ]
          )
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          forall a. Read a => ReadM a
auto
          ( forall a. Monoid a => [a] -> a
mconcat
              [ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"max-shrinks",
                forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"qc-max-shrinks",
                forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum number of shrinks of a failing test input",
                forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"MAXIMUM_SHRINKS"
              ]
          )
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
doubleSwitch [String
"golden-start"] (forall (f :: * -> *) a. String -> Mod f a
help String
"Whether to write golden tests if they do not exist yet")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
doubleSwitch [String
"golden-reset"] (forall (f :: * -> *) a. String -> Mod f a
help String
"Whether to overwrite golden tests instead of having them fail")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
doubleSwitch [String
"colour", String
"color"] (forall (f :: * -> *) a. String -> Mod f a
help String
"Use colour in output")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( forall a. Maybe a -> [a]
maybeToList
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
              ( forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
                  ( forall a. Monoid a => [a] -> a
mconcat
                      [ forall (f :: * -> *) a. String -> Mod f a
help String
"Filter to select which parts of the test tree to run",
                        forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILTER"
                      ]
                  )
              )
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mod OptionFields [Text] -> Parser [Text]
manyOptional
              ( forall a. Monoid a => [a] -> a
mconcat
                  [ forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f',
                    forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"filter",
                    forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm',
                    forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"match",
                    forall (f :: * -> *) a. String -> Mod f a
help String
"Filter to select which parts of the test tree to run",
                    forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILTER"
                  ]
              )
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
doubleSwitch [String
"fail-fast"] (forall (f :: * -> *) a. String -> Mod f a
help String
"Stop upon the first test failure")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( ( ( \case
              Word
0 -> Iterations
Continuous
              Word
1 -> Iterations
OneIteration
              Word
i -> Word -> Iterations
Iterations Word
i
          )
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod OptionFields a -> Parser a
option
              forall a. Read a => ReadM a
auto
              ( forall a. Monoid a => [a] -> a
mconcat
                  [ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"iterations",
                    forall (f :: * -> *) a. String -> Mod f a
help String
"How many iterations to use to look diagnose flakiness",
                    forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"ITERATIONS"
                  ]
              )
        )
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag'
            Iterations
Continuous
            ( forall a. Monoid a => [a] -> a
mconcat
                [ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"continuous",
                  forall (f :: * -> *) a. String -> Mod f a
help String
"Run the test suite over and over again until it fails, to diagnose flakiness"
                ]
            )
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          forall a. Read a => ReadM a
auto
          ( forall a. Monoid a => [a] -> a
mconcat
              [ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"retries",
                forall (f :: * -> *) a. String -> Mod f a
help String
"The number of retries to use for flakiness diagnostics. 0 means 'no flakiness diagnostics'",
                forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INTEGER"
              ]
          )
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
doubleSwitch [String
"fail-on-flaky"] (forall (f :: * -> *) a. String -> Mod f a
help String
"Fail when any flakiness is detected")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
doubleSwitch [String
"progress"] (forall (f :: * -> *) a. String -> Mod f a
help String
"Report progress")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
doubleSwitch [String
"debug"] (forall (f :: * -> *) a. String -> Mod f a
help String
"Turn on debug mode. This implies --no-randomise-execution-order, --synchronous, --progress and --fail-fast.")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
doubleSwitch [String
"profile"] (forall (f :: * -> *) a. String -> Mod f a
help String
"Turn on profiling mode.")

manyOptional :: OptParse.Mod OptionFields [Text] -> OptParse.Parser [Text]
manyOptional :: Mod OptionFields [Text] -> Parser [Text]
manyOptional Mod OptionFields [Text]
modifier = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall s. IsString s => ReadM s
str forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> [Text]
T.words) Mod OptionFields [Text]
modifier)

seedSettingFlags :: OptParse.Parser (Maybe SeedSetting)
seedSettingFlags :: Parser (Maybe SeedSetting)
seedSettingFlags =
  forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$
    ( Int -> SeedSetting
FixedSeed
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          forall a. Read a => ReadM a
auto
          ( forall a. Monoid a => [a] -> a
mconcat
              [ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"seed",
                forall (f :: * -> *) a. String -> Mod f a
help String
"Seed for random generation of test cases",
                forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SEED"
              ]
          )
    )
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag'
        SeedSetting
RandomSeed
        ( forall a. Monoid a => [a] -> a
mconcat
            [ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"random-seed",
              forall (f :: * -> *) a. String -> Mod f a
help String
"Use a random seed instead of a fixed seed"
            ]
        )

doubleSwitch :: [String] -> OptParse.Mod FlagFields (Maybe Bool) -> OptParse.Parser (Maybe Bool)
doubleSwitch :: [String] -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
doubleSwitch [String]
suffixes Mod FlagFields (Maybe Bool)
mods =
  forall a. a -> Mod FlagFields a -> Parser a
flag' (forall a. a -> Maybe a
Just Bool
True) (forall (f :: * -> *) a. Mod f a
hidden forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
internal forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall (f :: * -> *) a. HasName f => String -> Mod f a
long [String]
suffixes forall a. Semigroup a => a -> a -> a
<> Mod FlagFields (Maybe Bool)
mods)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' (forall a. a -> Maybe a
Just Bool
False) (forall (f :: * -> *) a. Mod f a
hidden forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
internal forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (f :: * -> *) a. HasName f => String -> Mod f a
long forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"no-" forall a. Semigroup a => a -> a -> a
<>)) [String]
suffixes forall a. Semigroup a => a -> a -> a
<> Mod FlagFields (Maybe Bool)
mods)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' forall a. Maybe a
Nothing (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\String
suffix -> forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
"[no-]" forall a. Semigroup a => a -> a -> a
<> String
suffix)) [String]
suffixes forall a. Semigroup a => a -> a -> a
<> Mod FlagFields (Maybe Bool)
mods)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing