{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}

module Test.Syd.OptParse where

import Autodocodec
import Autodocodec.Yaml
import Control.Applicative
import Control.Monad
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Env
import GHC.Generics (Generic)
import Options.Applicative as OptParse
import qualified Options.Applicative.Help as OptParse (string)
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 filter to use to select which tests to run
    Settings -> Maybe Text
settingFilter :: !(Maybe 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,
    -- | Whether to fail when any flakiness is detected
    Settings -> Bool
settingFailOnFlaky :: !Bool,
    -- | How to report progress
    Settings -> ReportProgress
settingReportProgress :: !ReportProgress,
    -- | Debug mode
    Settings -> Bool
settingDebug :: !Bool
  }
  deriving (Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
(Int -> Settings -> ShowS)
-> (Settings -> String) -> ([Settings] -> ShowS) -> Show Settings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Settings] -> ShowS
$cshowList :: [Settings] -> ShowS
show :: Settings -> String
$cshow :: Settings -> String
showsPrec :: Int -> Settings -> ShowS
$cshowsPrec :: Int -> Settings -> ShowS
Show, Settings -> Settings -> Bool
(Settings -> Settings -> Bool)
-> (Settings -> Settings -> Bool) -> Eq Settings
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. 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
$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 :: SeedSetting
-> Bool
-> Threads
-> Int
-> Int
-> Int
-> Int
-> Bool
-> Bool
-> Maybe Bool
-> Maybe Text
-> Bool
-> Iterations
-> Bool
-> ReportProgress
-> Bool
-> Settings
Settings
        { settingSeed :: SeedSetting
settingSeed = (TestRunSettings -> SeedSetting) -> SeedSetting
forall t. (TestRunSettings -> t) -> t
d TestRunSettings -> SeedSetting
testRunSettingSeed,
          settingRandomiseExecutionOrder :: Bool
settingRandomiseExecutionOrder = Bool
True,
          settingThreads :: Threads
settingThreads = Threads
ByCapabilities,
          settingMaxSuccess :: Int
settingMaxSuccess = (TestRunSettings -> Int) -> Int
forall t. (TestRunSettings -> t) -> t
d TestRunSettings -> Int
testRunSettingMaxSuccess,
          settingMaxSize :: Int
settingMaxSize = (TestRunSettings -> Int) -> Int
forall t. (TestRunSettings -> t) -> t
d TestRunSettings -> Int
testRunSettingMaxSize,
          settingMaxDiscard :: Int
settingMaxDiscard = (TestRunSettings -> Int) -> Int
forall t. (TestRunSettings -> t) -> t
d TestRunSettings -> Int
testRunSettingMaxDiscardRatio,
          settingMaxShrinks :: Int
settingMaxShrinks = (TestRunSettings -> Int) -> Int
forall t. (TestRunSettings -> t) -> t
d TestRunSettings -> Int
testRunSettingMaxShrinks,
          settingGoldenStart :: Bool
settingGoldenStart = (TestRunSettings -> Bool) -> Bool
forall t. (TestRunSettings -> t) -> t
d TestRunSettings -> Bool
testRunSettingGoldenStart,
          settingGoldenReset :: Bool
settingGoldenReset = (TestRunSettings -> Bool) -> Bool
forall t. (TestRunSettings -> t) -> t
d TestRunSettings -> Bool
testRunSettingGoldenReset,
          settingColour :: Maybe Bool
settingColour = Maybe Bool
forall a. Maybe a
Nothing,
          settingFilter :: Maybe Text
settingFilter = Maybe Text
forall a. Maybe a
Nothing,
          settingFailFast :: Bool
settingFailFast = Bool
False,
          settingIterations :: Iterations
settingIterations = Iterations
OneIteration,
          settingFailOnFlaky :: Bool
settingFailOnFlaky = Bool
False,
          settingReportProgress :: ReportProgress
settingReportProgress = ReportProgress
ReportNoProgress,
          settingDebug :: Bool
settingDebug = Bool
False
        }

deriveTerminalCapababilities :: Settings -> IO TerminalCapabilities
deriveTerminalCapababilities :: Settings -> IO TerminalCapabilities
deriveTerminalCapababilities Settings
settings = case Settings -> Maybe Bool
settingColour Settings
settings of
  Just Bool
False -> TerminalCapabilities -> IO TerminalCapabilities
forall (f :: * -> *) a. Applicative f => a -> f a
pure TerminalCapabilities
WithoutColours
  Just Bool
True -> TerminalCapabilities -> IO TerminalCapabilities
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
(Int -> Threads -> ShowS)
-> (Threads -> String) -> ([Threads] -> ShowS) -> Show Threads
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]
(Int -> ReadS Threads)
-> ReadS [Threads]
-> ReadPrec Threads
-> ReadPrec [Threads]
-> Read 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
(Threads -> Threads -> Bool)
-> (Threads -> Threads -> Bool) -> Eq Threads
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. 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
$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
(Int -> Iterations -> ShowS)
-> (Iterations -> String)
-> ([Iterations] -> ShowS)
-> Show Iterations
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]
(Int -> ReadS Iterations)
-> ReadS [Iterations]
-> ReadPrec Iterations
-> ReadPrec [Iterations]
-> Read 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
(Iterations -> Iterations -> Bool)
-> (Iterations -> Iterations -> Bool) -> Eq Iterations
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. 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
$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
(Int -> ReportProgress -> ShowS)
-> (ReportProgress -> String)
-> ([ReportProgress] -> ShowS)
-> Show ReportProgress
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]
(Int -> ReadS ReportProgress)
-> ReadS [ReportProgress]
-> ReadPrec ReportProgress
-> ReadPrec [ReportProgress]
-> Read 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
(ReportProgress -> ReportProgress -> Bool)
-> (ReportProgress -> ReportProgress -> Bool) -> Eq ReportProgress
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. 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
$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 {Maybe Bool
Maybe Int
Maybe String
Maybe Text
Maybe SeedSetting
Maybe Iterations
Maybe Threads
flagDebug :: Flags -> Maybe Bool
flagReportProgress :: Flags -> Maybe Bool
flagFailOnFlaky :: Flags -> Maybe Bool
flagIterations :: Flags -> Maybe Iterations
flagFailFast :: Flags -> Maybe Bool
flagFilter :: Flags -> Maybe 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
flagDebug :: Maybe Bool
flagReportProgress :: Maybe Bool
flagFailOnFlaky :: Maybe Bool
flagIterations :: Maybe Iterations
flagFailFast :: Maybe Bool
flagFilter :: Maybe 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 Text
Maybe SeedSetting
Maybe Iterations
Maybe Threads
envDebug :: Environment -> Maybe Bool
envReportProgress :: Environment -> Maybe Bool
envFailOnFlaky :: Environment -> Maybe Bool
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
envDebug :: Maybe Bool
envReportProgress :: Maybe Bool
envFailOnFlaky :: Maybe Bool
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 = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe ((Settings -> Bool) -> Bool
forall t. (Settings -> t) -> t
d Settings -> Bool
settingDebug) (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagDebug Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envDebug Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configDebug
  let threads :: Threads
threads =
        Threads -> Maybe Threads -> Threads
forall a. a -> Maybe a -> a
fromMaybe (if Bool
debugMode then Threads
Synchronous else (Settings -> Threads) -> Threads
forall t. (Settings -> t) -> t
d Settings -> Threads
settingThreads) (Maybe Threads -> Threads) -> Maybe Threads -> Threads
forall a b. (a -> b) -> a -> b
$
          Maybe Threads
flagThreads Maybe Threads -> Maybe Threads -> Maybe Threads
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Threads
envThreads Maybe Threads -> Maybe Threads -> Maybe Threads
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Threads) -> Maybe Threads
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Threads
configThreads
  ReportProgress
setReportProgress <-
    case Maybe Bool
flagReportProgress Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envReportProgress Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configReportProgress of
      Maybe Bool
Nothing ->
        ReportProgress -> IO ReportProgress
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReportProgress -> IO ReportProgress)
-> ReportProgress -> IO 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
debugMode
                then ReportProgress
ReportProgress
                else (Settings -> ReportProgress) -> ReportProgress
forall t. (Settings -> t) -> t
d Settings -> ReportProgress
settingReportProgress
            else (Settings -> ReportProgress) -> ReportProgress
forall t. (Settings -> t) -> t
d Settings -> ReportProgress
settingReportProgress
      Just Bool
progress ->
        if Bool
progress
          then
            if Threads
threads Threads -> Threads -> Bool
forall a. Eq a => a -> a -> Bool
/= Threads
Synchronous
              then String -> IO ReportProgress
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 ReportProgress -> IO ReportProgress
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReportProgress
ReportProgress
          else ReportProgress -> IO ReportProgress
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReportProgress
ReportNoProgress

  Settings -> IO Settings
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Settings :: SeedSetting
-> Bool
-> Threads
-> Int
-> Int
-> Int
-> Int
-> Bool
-> Bool
-> Maybe Bool
-> Maybe Text
-> Bool
-> Iterations
-> Bool
-> ReportProgress
-> Bool
-> Settings
Settings
      { settingSeed :: SeedSetting
settingSeed = SeedSetting -> Maybe SeedSetting -> SeedSetting
forall a. a -> Maybe a -> a
fromMaybe ((Settings -> SeedSetting) -> SeedSetting
forall t. (Settings -> t) -> t
d Settings -> SeedSetting
settingSeed) (Maybe SeedSetting -> SeedSetting)
-> Maybe SeedSetting -> SeedSetting
forall a b. (a -> b) -> a -> b
$ Maybe SeedSetting
flagSeed Maybe SeedSetting -> Maybe SeedSetting -> Maybe SeedSetting
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe SeedSetting
envSeed Maybe SeedSetting -> Maybe SeedSetting -> Maybe SeedSetting
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe SeedSetting) -> Maybe SeedSetting
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe SeedSetting
configSeed,
        settingRandomiseExecutionOrder :: Bool
settingRandomiseExecutionOrder =
          Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (if Bool
debugMode then Bool
False else (Settings -> Bool) -> Bool
forall t. (Settings -> t) -> t
d Settings -> Bool
settingRandomiseExecutionOrder) (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$
            Maybe Bool
flagRandomiseExecutionOrder Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envRandomiseExecutionOrder Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configRandomiseExecutionOrder,
        settingThreads :: Threads
settingThreads = Threads
threads,
        settingMaxSuccess :: Int
settingMaxSuccess = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ((Settings -> Int) -> Int
forall t. (Settings -> t) -> t
d Settings -> Int
settingMaxSuccess) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Maybe Int
flagMaxSuccess Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
envMaxSuccess Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Int) -> Maybe Int
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Int
configMaxSuccess,
        settingMaxSize :: Int
settingMaxSize = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ((Settings -> Int) -> Int
forall t. (Settings -> t) -> t
d Settings -> Int
settingMaxSize) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Maybe Int
flagMaxSize Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
envMaxSize Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Int) -> Maybe Int
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Int
configMaxSize,
        settingMaxDiscard :: Int
settingMaxDiscard = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ((Settings -> Int) -> Int
forall t. (Settings -> t) -> t
d Settings -> Int
settingMaxDiscard) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Maybe Int
flagMaxDiscard Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
envMaxDiscard Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Int) -> Maybe Int
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Int
configMaxDiscard,
        settingMaxShrinks :: Int
settingMaxShrinks = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ((Settings -> Int) -> Int
forall t. (Settings -> t) -> t
d Settings -> Int
settingMaxShrinks) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Maybe Int
flagMaxShrinks Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int
envMaxShrinks Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Int) -> Maybe Int
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Int
configMaxShrinks,
        settingGoldenStart :: Bool
settingGoldenStart = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe ((Settings -> Bool) -> Bool
forall t. (Settings -> t) -> t
d Settings -> Bool
settingGoldenStart) (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagGoldenStart Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envGoldenStart Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configGoldenStart,
        settingGoldenReset :: Bool
settingGoldenReset = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe ((Settings -> Bool) -> Bool
forall t. (Settings -> t) -> t
d Settings -> Bool
settingGoldenReset) (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagGoldenReset Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envGoldenReset Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configGoldenReset,
        settingColour :: Maybe Bool
settingColour = Maybe Bool
flagColour Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envColour Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configColour,
        settingFilter :: Maybe Text
settingFilter = Maybe Text
flagFilter Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
envFilter Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configFilter,
        settingFailFast :: Bool
settingFailFast =
          Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe
            (if Bool
debugMode then Bool
True else (Settings -> Bool) -> Bool
forall t. (Settings -> t) -> t
d Settings -> Bool
settingFailFast)
            (Maybe Bool
flagFailFast Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envFailFast Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configFailFast),
        settingIterations :: Iterations
settingIterations = Iterations -> Maybe Iterations -> Iterations
forall a. a -> Maybe a -> a
fromMaybe ((Settings -> Iterations) -> Iterations
forall t. (Settings -> t) -> t
d Settings -> Iterations
settingIterations) (Maybe Iterations -> Iterations) -> Maybe Iterations -> Iterations
forall a b. (a -> b) -> a -> b
$ Maybe Iterations
flagIterations Maybe Iterations -> Maybe Iterations -> Maybe Iterations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Iterations
envIterations Maybe Iterations -> Maybe Iterations -> Maybe Iterations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Iterations) -> Maybe Iterations
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Iterations
configIterations,
        settingFailOnFlaky :: Bool
settingFailOnFlaky = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe ((Settings -> Bool) -> Bool
forall t. (Settings -> t) -> t
d Settings -> Bool
settingFailOnFlaky) (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagFailOnFlaky Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
envFailOnFlaky Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configFailOnFlaky,
        settingReportProgress :: ReportProgress
settingReportProgress = ReportProgress
setReportProgress,
        settingDebug :: Bool
settingDebug = Bool
debugMode
      }
  where
    mc :: (Configuration -> Maybe a) -> Maybe a
    mc :: (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe a
f = Maybe Configuration
mConf Maybe Configuration -> (Configuration -> Maybe a) -> Maybe a
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 Bool
configFailOnFlaky :: !(Maybe Bool),
    Configuration -> Maybe Bool
configReportProgress :: !(Maybe Bool),
    Configuration -> Maybe Bool
configDebug :: !(Maybe Bool)
  }
  deriving (Int -> Configuration -> ShowS
[Configuration] -> ShowS
Configuration -> String
(Int -> Configuration -> ShowS)
-> (Configuration -> String)
-> ([Configuration] -> ShowS)
-> Show Configuration
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
(Configuration -> Configuration -> Bool)
-> (Configuration -> Configuration -> Bool) -> Eq Configuration
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. Configuration -> Rep Configuration x)
-> (forall x. Rep Configuration x -> Configuration)
-> Generic Configuration
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 =
    Text
-> ObjectCodec Configuration Configuration
-> JSONCodec Configuration
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"Configuration" (ObjectCodec Configuration Configuration
 -> JSONCodec Configuration)
-> ObjectCodec Configuration Configuration
-> JSONCodec 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 Bool
-> Maybe Bool
-> Maybe Bool
-> Configuration
Configuration
        (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 Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Configuration)
-> Codec Object Configuration (Maybe SeedSetting)
-> Codec
     Object
     Configuration
     (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 Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Configuration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ObjectCodec (Maybe SeedSetting) (Maybe SeedSetting)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"seed" Text
"Seed for random generation of test cases" ObjectCodec (Maybe SeedSetting) (Maybe SeedSetting)
-> (Configuration -> Maybe SeedSetting)
-> Codec Object Configuration (Maybe SeedSetting)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe SeedSetting
configSeed
        Codec
  Object
  Configuration
  (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 Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Configuration)
-> Codec Object Configuration (Maybe Bool)
-> Codec
     Object
     Configuration
     (Maybe Threads
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Configuration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec Object (Maybe Bool) (Maybe Bool)
-> Codec Object (Maybe Bool) (Maybe Bool)
-> Codec Object (Maybe Bool) (Maybe Bool)
forall context input output.
Codec context input output
-> Codec context input output -> Codec context input output
parseAlternative
          (Text -> Text -> Codec Object (Maybe Bool) (Maybe Bool)
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")
          (Text -> Text -> Codec Object (Maybe Bool) (Maybe Bool)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"randomize-execution-order" Text
"American spelling")
          Codec Object (Maybe Bool) (Maybe Bool)
-> (Configuration -> Maybe Bool)
-> Codec Object Configuration (Maybe Bool)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configRandomiseExecutionOrder
        Codec
  Object
  Configuration
  (Maybe Threads
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Configuration)
-> Codec Object Configuration (Maybe Threads)
-> Codec
     Object
     Configuration
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Configuration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe Threads) (Maybe Threads)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"parallelism" Text
"How parallel to execute the tests" ObjectCodec (Maybe Threads) (Maybe Threads)
-> (Configuration -> Maybe Threads)
-> Codec Object Configuration (Maybe Threads)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Threads
configThreads
        Codec
  Object
  Configuration
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Configuration)
-> Codec Object Configuration (Maybe Int)
-> Codec
     Object
     Configuration
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Configuration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe Int) (Maybe Int)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"max-size" Text
"Maximum size parameter to pass to generators" ObjectCodec (Maybe Int) (Maybe Int)
-> (Configuration -> Maybe Int)
-> Codec Object Configuration (Maybe Int)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Int
configMaxSize
        Codec
  Object
  Configuration
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Configuration)
-> Codec Object Configuration (Maybe Int)
-> Codec
     Object
     Configuration
     (Maybe Int
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Configuration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe Int) (Maybe Int)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"max-success" Text
"Number of quickcheck examples to run" ObjectCodec (Maybe Int) (Maybe Int)
-> (Configuration -> Maybe Int)
-> Codec Object Configuration (Maybe Int)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Int
configMaxSuccess
        Codec
  Object
  Configuration
  (Maybe Int
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Configuration)
-> Codec Object Configuration (Maybe Int)
-> Codec
     Object
     Configuration
     (Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Configuration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe Int) (Maybe Int)
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" ObjectCodec (Maybe Int) (Maybe Int)
-> (Configuration -> Maybe Int)
-> Codec Object Configuration (Maybe Int)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Int
configMaxDiscard
        Codec
  Object
  Configuration
  (Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Configuration)
-> Codec Object Configuration (Maybe Int)
-> Codec
     Object
     Configuration
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Configuration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe Int) (Maybe Int)
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" ObjectCodec (Maybe Int) (Maybe Int)
-> (Configuration -> Maybe Int)
-> Codec Object Configuration (Maybe Int)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Int
configMaxShrinks
        Codec
  Object
  Configuration
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Configuration)
-> Codec Object Configuration (Maybe Bool)
-> Codec
     Object
     Configuration
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Configuration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> Codec Object (Maybe Bool) (Maybe Bool)
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" Codec Object (Maybe Bool) (Maybe Bool)
-> (Configuration -> Maybe Bool)
-> Codec Object Configuration (Maybe Bool)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configGoldenStart
        Codec
  Object
  Configuration
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Configuration)
-> Codec Object Configuration (Maybe Bool)
-> Codec
     Object
     Configuration
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Configuration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> Codec Object (Maybe Bool) (Maybe Bool)
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" Codec Object (Maybe Bool) (Maybe Bool)
-> (Configuration -> Maybe Bool)
-> Codec Object Configuration (Maybe Bool)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configGoldenReset
        Codec
  Object
  Configuration
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Configuration)
-> Codec Object Configuration (Maybe Bool)
-> Codec
     Object
     Configuration
     (Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Configuration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec Object (Maybe Bool) (Maybe Bool)
-> Codec Object (Maybe Bool) (Maybe Bool)
-> Codec Object (Maybe Bool) (Maybe Bool)
forall context input output.
Codec context input output
-> Codec context input output -> Codec context input output
parseAlternative
          (Text -> Text -> Codec Object (Maybe Bool) (Maybe Bool)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"colour" Text
"Whether to use coloured output")
          (Text -> Text -> Codec Object (Maybe Bool) (Maybe Bool)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"color" Text
"American spelling")
          Codec Object (Maybe Bool) (Maybe Bool)
-> (Configuration -> Maybe Bool)
-> Codec Object Configuration (Maybe Bool)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configColour
        Codec
  Object
  Configuration
  (Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Configuration)
-> Codec Object Configuration (Maybe Text)
-> Codec
     Object
     Configuration
     (Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Configuration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe Text) (Maybe Text)
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" ObjectCodec (Maybe Text) (Maybe Text)
-> (Configuration -> Maybe Text)
-> Codec Object Configuration (Maybe Text)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Text
configFilter
        Codec
  Object
  Configuration
  (Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Configuration)
-> Codec Object Configuration (Maybe Bool)
-> Codec
     Object
     Configuration
     (Maybe Iterations
      -> Maybe Bool -> Maybe Bool -> Maybe Bool -> Configuration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> Codec Object (Maybe Bool) (Maybe Bool)
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" Codec Object (Maybe Bool) (Maybe Bool)
-> (Configuration -> Maybe Bool)
-> Codec Object Configuration (Maybe Bool)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configFailFast
        Codec
  Object
  Configuration
  (Maybe Iterations
   -> Maybe Bool -> Maybe Bool -> Maybe Bool -> Configuration)
-> Codec Object Configuration (Maybe Iterations)
-> Codec
     Object
     Configuration
     (Maybe Bool -> Maybe Bool -> Maybe Bool -> Configuration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe Iterations) (Maybe Iterations)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"iterations" Text
"How many iterations to use to look diagnose flakiness" ObjectCodec (Maybe Iterations) (Maybe Iterations)
-> (Configuration -> Maybe Iterations)
-> Codec Object Configuration (Maybe Iterations)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Iterations
configIterations
        Codec
  Object
  Configuration
  (Maybe Bool -> Maybe Bool -> Maybe Bool -> Configuration)
-> Codec Object Configuration (Maybe Bool)
-> Codec
     Object Configuration (Maybe Bool -> Maybe Bool -> Configuration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> Codec Object (Maybe Bool) (Maybe Bool)
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" Codec Object (Maybe Bool) (Maybe Bool)
-> (Configuration -> Maybe Bool)
-> Codec Object Configuration (Maybe Bool)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configFailOnFlaky
        Codec
  Object Configuration (Maybe Bool -> Maybe Bool -> Configuration)
-> Codec Object Configuration (Maybe Bool)
-> Codec Object Configuration (Maybe Bool -> Configuration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> Codec Object (Maybe Bool) (Maybe Bool)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"progress" Text
"How to report progres" Codec Object (Maybe Bool) (Maybe Bool)
-> (Configuration -> Maybe Bool)
-> Codec Object Configuration (Maybe Bool)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configReportProgress
        Codec Object Configuration (Maybe Bool -> Configuration)
-> Codec Object Configuration (Maybe Bool)
-> ObjectCodec Configuration Configuration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> Codec Object (Maybe Bool) (Maybe Bool)
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" Codec Object (Maybe Bool) (Maybe Bool)
-> (Configuration -> Maybe Bool)
-> Codec Object Configuration (Maybe Bool)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe Bool
configDebug

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 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

-- | 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 {Maybe Bool
Maybe Int
Maybe String
Maybe Text
Maybe SeedSetting
Maybe Iterations
Maybe Threads
flagDebug :: Maybe Bool
flagReportProgress :: Maybe Bool
flagFailOnFlaky :: Maybe Bool
flagIterations :: Maybe Iterations
flagFailFast :: Maybe Bool
flagFilter :: Maybe 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
flagDebug :: Flags -> Maybe Bool
flagReportProgress :: Flags -> Maybe Bool
flagFailOnFlaky :: Flags -> Maybe Bool
flagIterations :: Flags -> Maybe Iterations
flagFailFast :: Flags -> Maybe Bool
flagFilter :: Flags -> Maybe 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 Text
Maybe SeedSetting
Maybe Iterations
Maybe Threads
envDebug :: Maybe Bool
envReportProgress :: Maybe Bool
envFailOnFlaky :: Maybe Bool
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
envDebug :: Environment -> Maybe Bool
envReportProgress :: Environment -> Maybe Bool
envFailOnFlaky :: Environment -> Maybe Bool
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 Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
envConfigFile of
    Maybe String
Nothing -> IO (Path Abs File)
defaultConfigFile IO (Path Abs File)
-> (Path Abs File -> IO (Maybe Configuration))
-> IO (Maybe Configuration)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path Abs File -> IO (Maybe Configuration)
forall a r. HasCodec a => Path r File -> IO (Maybe a)
readYamlConfigFile
    Just String
cf -> do
      Path Abs File
afp <- String -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => String -> m (Path Abs File)
resolveFile' String
cf
      Path Abs File -> IO (Maybe Configuration)
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 = String -> IO (Path Abs File)
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 Bool
envFailOnFlaky :: !(Maybe Bool),
    Environment -> Maybe Bool
envReportProgress :: !(Maybe Bool),
    Environment -> Maybe Bool
envDebug :: !(Maybe Bool)
  }
  deriving (Int -> Environment -> ShowS
[Environment] -> ShowS
Environment -> String
(Int -> Environment -> ShowS)
-> (Environment -> String)
-> ([Environment] -> ShowS)
-> Show Environment
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
(Environment -> Environment -> Bool)
-> (Environment -> Environment -> Bool) -> Eq Environment
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. Environment -> Rep Environment x)
-> (forall x. Rep Environment x -> Environment)
-> Generic Environment
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 :: 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 Bool
-> Maybe Bool
-> Maybe Bool
-> Environment
Environment
    { envConfigFile :: Maybe String
envConfigFile = Maybe String
forall a. Maybe a
Nothing,
      envSeed :: Maybe SeedSetting
envSeed = Maybe SeedSetting
forall a. Maybe a
Nothing,
      envRandomiseExecutionOrder :: Maybe Bool
envRandomiseExecutionOrder = Maybe Bool
forall a. Maybe a
Nothing,
      envThreads :: Maybe Threads
envThreads = Maybe Threads
forall a. Maybe a
Nothing,
      envMaxSize :: Maybe Int
envMaxSize = Maybe Int
forall a. Maybe a
Nothing,
      envMaxSuccess :: Maybe Int
envMaxSuccess = Maybe Int
forall a. Maybe a
Nothing,
      envMaxDiscard :: Maybe Int
envMaxDiscard = Maybe Int
forall a. Maybe a
Nothing,
      envMaxShrinks :: Maybe Int
envMaxShrinks = Maybe Int
forall a. Maybe a
Nothing,
      envGoldenStart :: Maybe Bool
envGoldenStart = Maybe Bool
forall a. Maybe a
Nothing,
      envGoldenReset :: Maybe Bool
envGoldenReset = Maybe Bool
forall a. Maybe a
Nothing,
      envColour :: Maybe Bool
envColour = Maybe Bool
forall a. Maybe a
Nothing,
      envFilter :: Maybe Text
envFilter = Maybe Text
forall a. Maybe a
Nothing,
      envFailFast :: Maybe Bool
envFailFast = Maybe Bool
forall a. Maybe a
Nothing,
      envIterations :: Maybe Iterations
envIterations = Maybe Iterations
forall a. Maybe a
Nothing,
      envFailOnFlaky :: Maybe Bool
envFailOnFlaky = Maybe Bool
forall a. Maybe a
Nothing,
      envReportProgress :: Maybe Bool
envReportProgress = Maybe Bool
forall a. Maybe a
Nothing,
      envDebug :: Maybe Bool
envDebug = Maybe Bool
forall a. Maybe a
Nothing
    }

getEnvironment :: IO Environment
getEnvironment :: IO Environment
getEnvironment = (Info Error -> Info Error)
-> Parser Error Environment -> IO Environment
forall e a. (Info Error -> Info e) -> Parser e a -> IO a
Env.parse (String -> Info Error -> Info Error
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 =
  String -> Parser Error Environment -> Parser Error Environment
forall e a. String -> Parser e a -> Parser e a
Env.prefixed String
"SYDTEST_" (Parser Error Environment -> Parser Error Environment)
-> Parser Error Environment -> Parser Error Environment
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 Bool
-> Maybe Bool
-> Maybe Bool
-> Environment
Environment
      (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 Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Environment)
-> Parser Error (Maybe String)
-> Parser
     Error
     (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 Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Environment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reader Error (Maybe String)
-> String -> Mod Var (Maybe String) -> Parser Error (Maybe String)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((String -> Maybe String)
-> Either Error String -> Either Error (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe String
forall a. a -> Maybe a
Just (Either Error String -> Either Error (Maybe String))
-> (String -> Either Error String) -> Reader Error (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error String
forall s e. IsString s => Reader e s
Env.str) String
"CONFIG_FILE" (Maybe String -> Mod Var (Maybe String)
forall a. a -> Mod Var a
Env.def Maybe String
forall a. Maybe a
Nothing Mod Var (Maybe String)
-> Mod Var (Maybe String) -> Mod Var (Maybe String)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe String)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Config file")
        Parser
  Error
  (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 Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Environment)
-> Parser Error (Maybe SeedSetting)
-> Parser
     Error
     (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 Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Environment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Error (Maybe SeedSetting)
seedSettingEnvironmentParser
        Parser
  Error
  (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 Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Environment)
-> Parser Error (Maybe Bool)
-> Parser
     Error
     (Maybe Threads
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Environment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Reader Error (Maybe Bool)
-> String -> Mod Var (Maybe Bool) -> Parser Error (Maybe Bool)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Bool -> Maybe Bool)
-> Either Error Bool -> Either Error (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Either Error Bool -> Either Error (Maybe Bool))
-> (String -> Either Error Bool) -> Reader Error (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Bool
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"RANDOMISE_EXECUTION_ORDER" (Maybe Bool -> Mod Var (Maybe Bool)
forall a. a -> Mod Var a
Env.def Maybe Bool
forall a. Maybe a
Nothing Mod Var (Maybe Bool)
-> Mod Var (Maybe Bool) -> Mod Var (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Bool)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Randomise the execution order of the tests in the test suite")
                Parser Error (Maybe Bool)
-> Parser Error (Maybe Bool) -> Parser Error (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Reader Error (Maybe Bool)
-> String -> Mod Var (Maybe Bool) -> Parser Error (Maybe Bool)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Bool -> Maybe Bool)
-> Either Error Bool -> Either Error (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Either Error Bool -> Either Error (Maybe Bool))
-> (String -> Either Error Bool) -> Reader Error (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Bool
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"RANDOMIZE_EXECUTION_ORDER" (Maybe Bool -> Mod Var (Maybe Bool)
forall a. a -> Mod Var a
Env.def Maybe Bool
forall a. Maybe a
Nothing Mod Var (Maybe Bool)
-> Mod Var (Maybe Bool) -> Mod Var (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Bool)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Randomize the execution order of the tests in the test suite")
            )
        Parser
  Error
  (Maybe Threads
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Environment)
-> Parser Error (Maybe Threads)
-> Parser
     Error
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Environment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error (Maybe Threads)
-> String
-> Mod Var (Maybe Threads)
-> Parser Error (Maybe Threads)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Threads -> Maybe Threads)
-> Either Error Threads -> Either Error (Maybe Threads)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Threads -> Maybe Threads
forall a. a -> Maybe a
Just (Either Error Threads -> Either Error (Maybe Threads))
-> (String -> Either Error Threads) -> Reader Error (Maybe Threads)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reader Error Word
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto Reader Error Word
-> (Word -> Either Error Threads) -> String -> Either Error Threads
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Word -> Either Error Threads
forall e. Word -> Either e Threads
parseThreads)) String
"PARALLELISM" (Maybe Threads -> Mod Var (Maybe Threads)
forall a. a -> Mod Var a
Env.def Maybe Threads
forall a. Maybe a
Nothing Mod Var (Maybe Threads)
-> Mod Var (Maybe Threads) -> Mod Var (Maybe Threads)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Threads)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"How parallel to execute the tests")
        Parser
  Error
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Environment)
-> Parser Error (Maybe Int)
-> Parser
     Error
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Environment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error (Maybe Int)
-> String -> Mod Var (Maybe Int) -> Parser Error (Maybe Int)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Int -> Maybe Int) -> Either Error Int -> Either Error (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Maybe Int
forall a. a -> Maybe a
Just (Either Error Int -> Either Error (Maybe Int))
-> (String -> Either Error Int) -> Reader Error (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Int
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"MAX_SIZE" (Maybe Int -> Mod Var (Maybe Int)
forall a. a -> Mod Var a
Env.def Maybe Int
forall a. Maybe a
Nothing Mod Var (Maybe Int) -> Mod Var (Maybe Int) -> Mod Var (Maybe Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Int)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Maximum size parameter to pass to generators")
        Parser
  Error
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Environment)
-> Parser Error (Maybe Int)
-> Parser
     Error
     (Maybe Int
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Environment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error (Maybe Int)
-> String -> Mod Var (Maybe Int) -> Parser Error (Maybe Int)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Int -> Maybe Int) -> Either Error Int -> Either Error (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Maybe Int
forall a. a -> Maybe a
Just (Either Error Int -> Either Error (Maybe Int))
-> (String -> Either Error Int) -> Reader Error (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Int
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"MAX_SUCCESS" (Maybe Int -> Mod Var (Maybe Int)
forall a. a -> Mod Var a
Env.def Maybe Int
forall a. Maybe a
Nothing Mod Var (Maybe Int) -> Mod Var (Maybe Int) -> Mod Var (Maybe Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Int)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Number of quickcheck examples to run")
        Parser
  Error
  (Maybe Int
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Environment)
-> Parser Error (Maybe Int)
-> Parser
     Error
     (Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Environment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error (Maybe Int)
-> String -> Mod Var (Maybe Int) -> Parser Error (Maybe Int)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Int -> Maybe Int) -> Either Error Int -> Either Error (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Maybe Int
forall a. a -> Maybe a
Just (Either Error Int -> Either Error (Maybe Int))
-> (String -> Either Error Int) -> Reader Error (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Int
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"MAX_DISCARD" (Maybe Int -> Mod Var (Maybe Int)
forall a. a -> Mod Var a
Env.def Maybe Int
forall a. Maybe a
Nothing Mod Var (Maybe Int) -> Mod Var (Maybe Int) -> Mod Var (Maybe Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Int)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Maximum number of discarded tests per successful test before giving up")
        Parser
  Error
  (Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Environment)
-> Parser Error (Maybe Int)
-> Parser
     Error
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Environment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error (Maybe Int)
-> String -> Mod Var (Maybe Int) -> Parser Error (Maybe Int)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Int -> Maybe Int) -> Either Error Int -> Either Error (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Maybe Int
forall a. a -> Maybe a
Just (Either Error Int -> Either Error (Maybe Int))
-> (String -> Either Error Int) -> Reader Error (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Int
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"MAX_SHRINKS" (Maybe Int -> Mod Var (Maybe Int)
forall a. a -> Mod Var a
Env.def Maybe Int
forall a. Maybe a
Nothing Mod Var (Maybe Int) -> Mod Var (Maybe Int) -> Mod Var (Maybe Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Int)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Maximum number of shrinks of a failing test input")
        Parser
  Error
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Environment)
-> Parser Error (Maybe Bool)
-> Parser
     Error
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Environment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error (Maybe Bool)
-> String -> Mod Var (Maybe Bool) -> Parser Error (Maybe Bool)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Bool -> Maybe Bool)
-> Either Error Bool -> Either Error (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Either Error Bool -> Either Error (Maybe Bool))
-> (String -> Either Error Bool) -> Reader Error (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Bool
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"GOLDEN_START" (Maybe Bool -> Mod Var (Maybe Bool)
forall a. a -> Mod Var a
Env.def Maybe Bool
forall a. Maybe a
Nothing Mod Var (Maybe Bool)
-> Mod Var (Maybe Bool) -> Mod Var (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Bool)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Whether to write golden tests if they do not exist yet")
        Parser
  Error
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Environment)
-> Parser Error (Maybe Bool)
-> Parser
     Error
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Environment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error (Maybe Bool)
-> String -> Mod Var (Maybe Bool) -> Parser Error (Maybe Bool)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Bool -> Maybe Bool)
-> Either Error Bool -> Either Error (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Either Error Bool -> Either Error (Maybe Bool))
-> (String -> Either Error Bool) -> Reader Error (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Bool
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"GOLDEN_RESET" (Maybe Bool -> Mod Var (Maybe Bool)
forall a. a -> Mod Var a
Env.def Maybe Bool
forall a. Maybe a
Nothing Mod Var (Maybe Bool)
-> Mod Var (Maybe Bool) -> Mod Var (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Bool)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Whether to overwrite golden tests instead of having them fail")
        Parser
  Error
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Environment)
-> Parser Error (Maybe Bool)
-> Parser
     Error
     (Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Environment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Reader Error (Maybe Bool)
-> String -> Mod Var (Maybe Bool) -> Parser Error (Maybe Bool)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Bool -> Maybe Bool)
-> Either Error Bool -> Either Error (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Either Error Bool -> Either Error (Maybe Bool))
-> (String -> Either Error Bool) -> Reader Error (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Bool
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"COLOUR" (Maybe Bool -> Mod Var (Maybe Bool)
forall a. a -> Mod Var a
Env.def Maybe Bool
forall a. Maybe a
Nothing Mod Var (Maybe Bool)
-> Mod Var (Maybe Bool) -> Mod Var (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Bool)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Whether to use coloured output")
                Parser Error (Maybe Bool)
-> Parser Error (Maybe Bool) -> Parser Error (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Reader Error (Maybe Bool)
-> String -> Mod Var (Maybe Bool) -> Parser Error (Maybe Bool)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Bool -> Maybe Bool)
-> Either Error Bool -> Either Error (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Either Error Bool -> Either Error (Maybe Bool))
-> (String -> Either Error Bool) -> Reader Error (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Bool
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"COLOR" (Maybe Bool -> Mod Var (Maybe Bool)
forall a. a -> Mod Var a
Env.def Maybe Bool
forall a. Maybe a
Nothing Mod Var (Maybe Bool)
-> Mod Var (Maybe Bool) -> Mod Var (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Bool)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Whether to use colored output")
            )
        Parser
  Error
  (Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Environment)
-> Parser Error (Maybe Text)
-> Parser
     Error
     (Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Environment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error (Maybe Text)
-> String -> Mod Var (Maybe Text) -> Parser Error (Maybe Text)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Text -> Maybe Text)
-> Either Error Text -> Either Error (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just (Either Error Text -> Either Error (Maybe Text))
-> (String -> Either Error Text) -> Reader Error (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Text
forall s e. IsString s => Reader e s
Env.str) String
"FILTER" (Maybe Text -> Mod Var (Maybe Text)
forall a. a -> Mod Var a
Env.def Maybe Text
forall a. Maybe a
Nothing Mod Var (Maybe Text)
-> Mod Var (Maybe Text) -> Mod Var (Maybe Text)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Text)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Filter to select which parts of the test tree to run")
        Parser
  Error
  (Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Environment)
-> Parser Error (Maybe Bool)
-> Parser
     Error
     (Maybe Iterations
      -> Maybe Bool -> Maybe Bool -> Maybe Bool -> Environment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error (Maybe Bool)
-> String -> Mod Var (Maybe Bool) -> Parser Error (Maybe Bool)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Bool -> Maybe Bool)
-> Either Error Bool -> Either Error (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Either Error Bool -> Either Error (Maybe Bool))
-> (String -> Either Error Bool) -> Reader Error (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Bool
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"FAIL_FAST" (Maybe Bool -> Mod Var (Maybe Bool)
forall a. a -> Mod Var a
Env.def Maybe Bool
forall a. Maybe a
Nothing Mod Var (Maybe Bool)
-> Mod Var (Maybe Bool) -> Mod Var (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Bool)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Whether to stop executing upon the first test failure")
        Parser
  Error
  (Maybe Iterations
   -> Maybe Bool -> Maybe Bool -> Maybe Bool -> Environment)
-> Parser Error (Maybe Iterations)
-> Parser
     Error (Maybe Bool -> Maybe Bool -> Maybe Bool -> Environment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error (Maybe Iterations)
-> String
-> Mod Var (Maybe Iterations)
-> Parser Error (Maybe Iterations)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Iterations -> Maybe Iterations)
-> Either Error Iterations -> Either Error (Maybe Iterations)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Iterations -> Maybe Iterations
forall a. a -> Maybe a
Just (Either Error Iterations -> Either Error (Maybe Iterations))
-> (String -> Either Error Iterations)
-> Reader Error (Maybe Iterations)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reader Error Word
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto Reader Error Word
-> (Word -> Either Error Iterations)
-> String
-> Either Error Iterations
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Word -> Either Error Iterations
forall e. Word -> Either e Iterations
parseIterations)) String
"ITERATIONS" (Maybe Iterations -> Mod Var (Maybe Iterations)
forall a. a -> Mod Var a
Env.def Maybe Iterations
forall a. Maybe a
Nothing Mod Var (Maybe Iterations)
-> Mod Var (Maybe Iterations) -> Mod Var (Maybe Iterations)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Iterations)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"How many iterations to use to look diagnose flakiness")
        Parser
  Error (Maybe Bool -> Maybe Bool -> Maybe Bool -> Environment)
-> Parser Error (Maybe Bool)
-> Parser Error (Maybe Bool -> Maybe Bool -> Environment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error (Maybe Bool)
-> String -> Mod Var (Maybe Bool) -> Parser Error (Maybe Bool)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Bool -> Maybe Bool)
-> Either Error Bool -> Either Error (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Either Error Bool -> Either Error (Maybe Bool))
-> (String -> Either Error Bool) -> Reader Error (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Bool
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"FAIL_ON_FLAKY" (Maybe Bool -> Mod Var (Maybe Bool)
forall a. a -> Mod Var a
Env.def Maybe Bool
forall a. Maybe a
Nothing Mod Var (Maybe Bool)
-> Mod Var (Maybe Bool) -> Mod Var (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Bool)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Whether to fail when flakiness is detected")
        Parser Error (Maybe Bool -> Maybe Bool -> Environment)
-> Parser Error (Maybe Bool)
-> Parser Error (Maybe Bool -> Environment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error (Maybe Bool)
-> String -> Mod Var (Maybe Bool) -> Parser Error (Maybe Bool)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Bool -> Maybe Bool)
-> Either Error Bool -> Either Error (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Either Error Bool -> Either Error (Maybe Bool))
-> (String -> Either Error Bool) -> Reader Error (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Bool
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"PROGRESS" (Maybe Bool -> Mod Var (Maybe Bool)
forall a. a -> Mod Var a
Env.def Maybe Bool
forall a. Maybe a
Nothing Mod Var (Maybe Bool)
-> Mod Var (Maybe Bool) -> Mod Var (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Bool)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Report progress as tests run")
        Parser Error (Maybe Bool -> Environment)
-> Parser Error (Maybe Bool) -> Parser Error Environment
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error (Maybe Bool)
-> String -> Mod Var (Maybe Bool) -> Parser Error (Maybe Bool)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Bool -> Maybe Bool)
-> Either Error Bool -> Either Error (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Either Error Bool -> Either Error (Maybe Bool))
-> (String -> Either Error Bool) -> Reader Error (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Bool
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"DEBUG" (Maybe Bool -> Mod Var (Maybe Bool)
forall a. a -> Mod Var a
Env.def Maybe Bool
forall a. Maybe a
Nothing Mod Var (Maybe Bool)
-> Mod Var (Maybe Bool) -> Mod Var (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Bool)
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.")
  where
    parseThreads :: Word -> Either e Threads
    parseThreads :: Word -> Either e Threads
parseThreads Word
1 = Threads -> Either e Threads
forall a b. b -> Either a b
Right Threads
Synchronous
    parseThreads Word
i = Threads -> Either e Threads
forall a b. b -> Either a b
Right (Word -> Threads
Asynchronous Word
i)
    parseIterations :: Word -> Either e Iterations
    parseIterations :: Word -> Either e Iterations
parseIterations Word
0 = Iterations -> Either e Iterations
forall a b. b -> Either a b
Right Iterations
Continuous
    parseIterations Word
1 = Iterations -> Either e Iterations
forall a b. b -> Either a b
Right Iterations
OneIteration
    parseIterations Word
i = Iterations -> Either e Iterations
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
    (Maybe Int -> Bool -> Maybe SeedSetting)
-> Parser Error (Maybe Int)
-> Parser Error (Bool -> Maybe SeedSetting)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reader Error (Maybe Int)
-> String -> Mod Var (Maybe Int) -> Parser Error (Maybe Int)
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var ((Int -> Maybe Int) -> Either Error Int -> Either Error (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Maybe Int
forall a. a -> Maybe a
Just (Either Error Int -> Either Error (Maybe Int))
-> (String -> Either Error Int) -> Reader Error (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Error Int
forall e a. (AsUnread e, Read a) => Reader e a
Env.auto) String
"SEED" (Maybe Int -> Mod Var (Maybe Int)
forall a. a -> Mod Var a
Env.def Maybe Int
forall a. Maybe a
Nothing Mod Var (Maybe Int) -> Mod Var (Maybe Int) -> Mod Var (Maybe Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var (Maybe Int)
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Seed for random generation of test cases")
    Parser Error (Bool -> Maybe SeedSetting)
-> Parser Error Bool -> Parser Error (Maybe SeedSetting)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Mod Flag Bool -> Parser Error Bool
forall e. String -> Mod Flag Bool -> Parser e Bool
Env.switch String
"RANDOM_SEED" (String -> Mod Flag Bool
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 SeedSetting -> Maybe SeedSetting
forall a. a -> Maybe a
Just SeedSetting
RandomSeed else Int -> SeedSetting
FixedSeed (Int -> SeedSetting) -> Maybe Int -> Maybe SeedSetting
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 = ParserPrefs -> ParserInfo Flags -> IO Flags
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 =
  Parser Flags -> InfoMod Flags -> ParserInfo Flags
forall a. Parser a -> InfoMod a -> ParserInfo a
OptParse.info
    (Parser (Flags -> Flags)
forall a. Parser (a -> a)
OptParse.helper Parser (Flags -> Flags) -> Parser Flags -> Parser Flags
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Flags
parseFlags)
    (InfoMod Flags
forall a. InfoMod a
OptParse.fullDesc InfoMod Flags -> InfoMod Flags -> InfoMod Flags
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod Flags
forall a. Maybe Doc -> InfoMod a
OptParse.footerDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
OptParse.string String
footerStr))
  where
    -- Show the variables from the environment that we parse and the config file format
    footerStr :: String
footerStr =
      [String] -> String
unlines
        [ Parser Error Environment -> String
forall e a. Parser e a -> String
Env.helpDoc Parser Error Environment
environmentParser,
          String
"",
          String
"Configuration file format:",
          Text -> String
T.unpack (ByteString -> Text
TE.decodeUtf8 (HasCodec Configuration => ByteString
forall a. HasCodec a => ByteString
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 -> Maybe Text
flagFilter :: !(Maybe Text),
    Flags -> Maybe Bool
flagFailFast :: !(Maybe Bool),
    Flags -> Maybe Iterations
flagIterations :: !(Maybe Iterations),
    Flags -> Maybe Bool
flagFailOnFlaky :: !(Maybe Bool),
    Flags -> Maybe Bool
flagReportProgress :: !(Maybe Bool),
    Flags -> Maybe Bool
flagDebug :: !(Maybe Bool)
  }
  deriving (Int -> Flags -> ShowS
[Flags] -> ShowS
Flags -> String
(Int -> Flags -> ShowS)
-> (Flags -> String) -> ([Flags] -> ShowS) -> Show Flags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flags] -> ShowS
$cshowList :: [Flags] -> ShowS
show :: Flags -> String
$cshow :: Flags -> String
showsPrec :: Int -> Flags -> ShowS
$cshowsPrec :: Int -> Flags -> ShowS
Show, Flags -> Flags -> Bool
(Flags -> Flags -> Bool) -> (Flags -> Flags -> Bool) -> Eq Flags
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. 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
$cto :: forall x. Rep Flags x -> Flags
$cfrom :: forall x. Flags -> Rep Flags x
Generic)

defaultFlags :: Flags
defaultFlags :: Flags
defaultFlags =
  Flags :: 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 Bool
-> Maybe Bool
-> Maybe Bool
-> Flags
Flags
    { flagConfigFile :: Maybe String
flagConfigFile = Maybe String
forall a. Maybe a
Nothing,
      flagSeed :: Maybe SeedSetting
flagSeed = Maybe SeedSetting
forall a. Maybe a
Nothing,
      flagRandomiseExecutionOrder :: Maybe Bool
flagRandomiseExecutionOrder = Maybe Bool
forall a. Maybe a
Nothing,
      flagThreads :: Maybe Threads
flagThreads = Maybe Threads
forall a. Maybe a
Nothing,
      flagMaxSize :: Maybe Int
flagMaxSize = Maybe Int
forall a. Maybe a
Nothing,
      flagMaxSuccess :: Maybe Int
flagMaxSuccess = Maybe Int
forall a. Maybe a
Nothing,
      flagMaxDiscard :: Maybe Int
flagMaxDiscard = Maybe Int
forall a. Maybe a
Nothing,
      flagMaxShrinks :: Maybe Int
flagMaxShrinks = Maybe Int
forall a. Maybe a
Nothing,
      flagGoldenStart :: Maybe Bool
flagGoldenStart = Maybe Bool
forall a. Maybe a
Nothing,
      flagGoldenReset :: Maybe Bool
flagGoldenReset = Maybe Bool
forall a. Maybe a
Nothing,
      flagColour :: Maybe Bool
flagColour = Maybe Bool
forall a. Maybe a
Nothing,
      flagFilter :: Maybe Text
flagFilter = Maybe Text
forall a. Maybe a
Nothing,
      flagFailFast :: Maybe Bool
flagFailFast = Maybe Bool
forall a. Maybe a
Nothing,
      flagIterations :: Maybe Iterations
flagIterations = Maybe Iterations
forall a. Maybe a
Nothing,
      flagFailOnFlaky :: Maybe Bool
flagFailOnFlaky = Maybe Bool
forall a. Maybe a
Nothing,
      flagReportProgress :: Maybe Bool
flagReportProgress = Maybe Bool
forall a. Maybe a
Nothing,
      flagDebug :: Maybe Bool
flagDebug = Maybe Bool
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
-> Maybe Text
-> Maybe Bool
-> Maybe Iterations
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Flags
Flags
    (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 Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Flags)
-> Parser (Maybe String)
-> Parser
     (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 Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Flags)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          ( [Mod OptionFields String] -> Mod OptionFields String
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"config-file",
                String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Path to an altenative config file",
                String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH"
              ]
          )
      )
    Parser
  (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 Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Flags)
-> Parser (Maybe SeedSetting)
-> Parser
     (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 Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Flags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe SeedSetting)
seedSettingFlags
    Parser
  (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 Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Flags)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Threads
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Flags)
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"] (String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. String -> Mod f a
help String
"Randomise the execution order of the tests in the test suite")
    Parser
  (Maybe Threads
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Flags)
-> Parser (Maybe Threads)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Flags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Threads -> Parser (Maybe Threads)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( ( ( \case
              Word
1 -> Threads
Synchronous
              Word
i -> Word -> Threads
Asynchronous Word
i
          )
            (Word -> Threads) -> Parser Word -> Parser Threads
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
              ReadM Word
forall a. Read a => ReadM a
auto
              ( [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
                  [ Char -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'j',
                    String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"jobs",
                    String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
help String
"How parallel to execute the tests",
                    String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"JOBS"
                  ]
              )
        )
          Parser Threads -> Parser Threads -> Parser Threads
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Threads -> Mod FlagFields Threads -> Parser Threads
forall a. a -> Mod FlagFields a -> Parser a
flag'
            Threads
Synchronous
            ( [Mod FlagFields Threads] -> Mod FlagFields Threads
forall a. Monoid a => [a] -> a
mconcat
                [ String -> Mod FlagFields Threads
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"synchronous",
                  String -> Mod FlagFields Threads
forall (f :: * -> *) a. String -> Mod f a
help String
"Execute tests synchronously"
                ]
            )
      )
    Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Flags)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Flags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          ReadM Int
forall a. Read a => ReadM a
auto
          ( [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"max-size",
                String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"qc-max-size",
                String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum size parameter to pass to generators",
                String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"MAXIMUM_SIZE_PARAMETER"
              ]
          )
      )
    Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Flags)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Flags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          ReadM Int
forall a. Read a => ReadM a
auto
          ( [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"max-success",
                String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"qc-max-success",
                String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Number of quickcheck examples to run",
                String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NUMBER_OF_SUCCESSES"
              ]
          )
      )
    Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Flags)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Flags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          ReadM Int
forall a. Read a => ReadM a
auto
          ( [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"max-discard",
                String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"qc-max-discard",
                String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum number of discarded tests per successful test before giving up",
                String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"MAXIMUM_DISCARD_RATIO"
              ]
          )
      )
    Parser
  (Maybe Int
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Flags)
-> Parser (Maybe Int)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Flags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          ReadM Int
forall a. Read a => ReadM a
auto
          ( [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"max-shrinks",
                String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"qc-max-shrinks",
                String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum number of shrinks of a failing test input",
                String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"MAXIMUM_SHRINKS"
              ]
          )
      )
    Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Flags)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Flags)
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"] (String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. String -> Mod f a
help String
"Whether to write golden tests if they do not exist yet")
    Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Flags)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Flags)
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"] (String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. String -> Mod f a
help String
"Whether to overwrite golden tests instead of having them fail")
    Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Flags)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Flags)
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"] (String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. String -> Mod f a
help String
"Use colour in output")
    Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Flags)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Iterations
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Flags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
            ( Mod ArgumentFields Text -> Parser Text
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
                ( [Mod ArgumentFields Text] -> Mod ArgumentFields Text
forall a. Monoid a => [a] -> a
mconcat
                    [ String -> Mod ArgumentFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"Filter to select which parts of the test tree to run",
                      String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILTER"
                    ]
                )
            )
            Parser (Maybe Text) -> Parser (Maybe Text) -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
              ( Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
                  ( [Mod OptionFields Text] -> Mod OptionFields Text
forall a. Monoid a => [a] -> a
mconcat
                      [ String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"filter",
                        String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"match",
                        String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"Filter to select which parts of the test tree to run",
                        String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILTER"
                      ]
                  )
              )
        )
    Parser
  (Maybe Bool
   -> Maybe Iterations
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Flags)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Iterations
      -> Maybe Bool -> Maybe Bool -> Maybe Bool -> Flags)
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"] (String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. String -> Mod f a
help String
"Stop upon the first test failure")
    Parser
  (Maybe Iterations
   -> Maybe Bool -> Maybe Bool -> Maybe Bool -> Flags)
-> Parser (Maybe Iterations)
-> Parser (Maybe Bool -> Maybe Bool -> Maybe Bool -> Flags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Iterations -> Parser (Maybe Iterations)
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
          )
            (Word -> Iterations) -> Parser Word -> Parser Iterations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word -> Mod OptionFields Word -> Parser Word
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
              ReadM Word
forall a. Read a => ReadM a
auto
              ( [Mod OptionFields Word] -> Mod OptionFields Word
forall a. Monoid a => [a] -> a
mconcat
                  [ String -> Mod OptionFields Word
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"iterations",
                    String -> Mod OptionFields Word
forall (f :: * -> *) a. String -> Mod f a
help String
"How many iterations to use to look diagnose flakiness",
                    String -> Mod OptionFields Word
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"ITERATIONS"
                  ]
              )
        )
          Parser Iterations -> Parser Iterations -> Parser Iterations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Iterations -> Mod FlagFields Iterations -> Parser Iterations
forall a. a -> Mod FlagFields a -> Parser a
flag'
            Iterations
Continuous
            ( [Mod FlagFields Iterations] -> Mod FlagFields Iterations
forall a. Monoid a => [a] -> a
mconcat
                [ String -> Mod FlagFields Iterations
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"continuous",
                  String -> Mod FlagFields Iterations
forall (f :: * -> *) a. String -> Mod f a
help String
"Run the test suite over and over again until it fails, to diagnose flakiness"
                ]
            )
      )
    Parser (Maybe Bool -> Maybe Bool -> Maybe Bool -> Flags)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> Maybe Bool -> Flags)
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"] (String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. String -> Mod f a
help String
"Fail when any flakiness is detected")
    Parser (Maybe Bool -> Maybe Bool -> Flags)
-> Parser (Maybe Bool) -> Parser (Maybe Bool -> Flags)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
doubleSwitch [String
"progress"] (String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. String -> Mod f a
help String
"Report progress")
    Parser (Maybe Bool -> Flags) -> Parser (Maybe Bool) -> Parser Flags
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
doubleSwitch [String
"debug"] (String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. String -> Mod f a
help String
"Turn on debug mode. This implies --no-randomise-execution-order, --synchronous, --progress and --fail-fast.")

seedSettingFlags :: OptParse.Parser (Maybe SeedSetting)
seedSettingFlags :: Parser (Maybe SeedSetting)
seedSettingFlags =
  Parser SeedSetting -> Parser (Maybe SeedSetting)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser SeedSetting -> Parser (Maybe SeedSetting))
-> Parser SeedSetting -> Parser (Maybe SeedSetting)
forall a b. (a -> b) -> a -> b
$
    ( Int -> SeedSetting
FixedSeed
        (Int -> SeedSetting) -> Parser Int -> Parser SeedSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          ReadM Int
forall a. Read a => ReadM a
auto
          ( [Mod OptionFields Int] -> Mod OptionFields Int
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"seed",
                String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Seed for random generation of test cases",
                String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SEED"
              ]
          )
    )
      Parser SeedSetting -> Parser SeedSetting -> Parser SeedSetting
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SeedSetting -> Mod FlagFields SeedSetting -> Parser SeedSetting
forall a. a -> Mod FlagFields a -> Parser a
flag'
        SeedSetting
RandomSeed
        ( [Mod FlagFields SeedSetting] -> Mod FlagFields SeedSetting
forall a. Monoid a => [a] -> a
mconcat
            [ String -> Mod FlagFields SeedSetting
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"random-seed",
              String -> Mod FlagFields SeedSetting
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 =
  Maybe Bool -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
forall a. a -> Mod FlagFields a -> Parser a
flag' (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. Mod f a
hidden Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. Mod f a
internal Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> (String -> Mod FlagFields (Maybe Bool))
-> [String] -> Mod FlagFields (Maybe Bool)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long [String]
suffixes Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields (Maybe Bool)
mods)
    Parser (Maybe Bool) -> Parser (Maybe Bool) -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
forall a. a -> Mod FlagFields a -> Parser a
flag' (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False) (Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. Mod f a
hidden Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. Mod f a
internal Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> (String -> Mod FlagFields (Maybe Bool))
-> [String] -> Mod FlagFields (Maybe Bool)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long [String]
suffixes Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields (Maybe Bool)
mods)
    Parser (Maybe Bool) -> Parser (Maybe Bool) -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
forall a. a -> Mod FlagFields a -> Parser a
flag' Maybe Bool
forall a. Maybe a
Nothing ((String -> Mod FlagFields (Maybe Bool))
-> [String] -> Mod FlagFields (Maybe Bool)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\String
suffix -> String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
"[no-]" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
suffix)) [String]
suffixes Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields (Maybe Bool)
mods)
    Parser (Maybe Bool) -> Parser (Maybe Bool) -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
forall a. Maybe a
Nothing