sydtest-0.1.0.0: A modern testing framework for Haskell with good defaults and advanced testing features.
Safe HaskellNone
LanguageHaskell2010

Test.Syd.OptParse

Synopsis

Documentation

data Settings Source #

Test suite definition and run settings

Constructors

Settings 

Fields

Instances

Instances details
Eq Settings Source # 
Instance details

Defined in Test.Syd.OptParse

Show Settings Source # 
Instance details

Defined in Test.Syd.OptParse

Generic Settings Source # 
Instance details

Defined in Test.Syd.OptParse

Associated Types

type Rep Settings :: Type -> Type #

Methods

from :: Settings -> Rep Settings x #

to :: Rep Settings x -> Settings #

type Rep Settings Source # 
Instance details

Defined in Test.Syd.OptParse

type Rep Settings = D1 ('MetaData "Settings" "Test.Syd.OptParse" "sydtest-0.1.0.0-JD50o4fziYEPTOY150AFK" 'False) (C1 ('MetaCons "Settings" 'PrefixI 'True) (((S1 ('MetaSel ('Just "settingSeed") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Int) :*: (S1 ('MetaSel ('Just "settingRandomiseExecutionOrder") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Just "settingThreads") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Threads))) :*: (S1 ('MetaSel ('Just "settingMaxSuccess") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Int) :*: (S1 ('MetaSel ('Just "settingMaxSize") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Just "settingMaxDiscard") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Int)))) :*: ((S1 ('MetaSel ('Just "settingMaxShrinks") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Int) :*: (S1 ('MetaSel ('Just "settingGoldenStart") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Just "settingGoldenReset") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool))) :*: ((S1 ('MetaSel ('Just "settingColour") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)) :*: S1 ('MetaSel ('Just "settingFilter") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Text))) :*: (S1 ('MetaSel ('Just "settingFailFast") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Just "settingIterations") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Iterations))))))

data Threads Source #

Constructors

Synchronous

One thread

ByCapabilities

As many threads as getNumCapabilities tells you you have

Asynchronous Int

A given number of threads

Instances

Instances details
Eq Threads Source # 
Instance details

Defined in Test.Syd.OptParse

Methods

(==) :: Threads -> Threads -> Bool #

(/=) :: Threads -> Threads -> Bool #

Show Threads Source # 
Instance details

Defined in Test.Syd.OptParse

Generic Threads Source # 
Instance details

Defined in Test.Syd.OptParse

Associated Types

type Rep Threads :: Type -> Type #

Methods

from :: Threads -> Rep Threads x #

to :: Rep Threads x -> Threads #

YamlSchema Threads Source # 
Instance details

Defined in Test.Syd.OptParse

type Rep Threads Source # 
Instance details

Defined in Test.Syd.OptParse

type Rep Threads = D1 ('MetaData "Threads" "Test.Syd.OptParse" "sydtest-0.1.0.0-JD50o4fziYEPTOY150AFK" 'False) (C1 ('MetaCons "Synchronous" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "ByCapabilities" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Asynchronous" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int))))

data Iterations Source #

Constructors

OneIteration

Run the test suite once, the default

Iterations Int

Run the test suite for the given number of iterations, or until we can find flakiness

Continuous

Run the test suite over and over, until we can find some flakiness

Instances

Instances details
Eq Iterations Source # 
Instance details

Defined in Test.Syd.OptParse

Show Iterations Source # 
Instance details

Defined in Test.Syd.OptParse

Generic Iterations Source # 
Instance details

Defined in Test.Syd.OptParse

Associated Types

type Rep Iterations :: Type -> Type #

YamlSchema Iterations Source # 
Instance details

Defined in Test.Syd.OptParse

type Rep Iterations Source # 
Instance details

Defined in Test.Syd.OptParse

type Rep Iterations = D1 ('MetaData "Iterations" "Test.Syd.OptParse" "sydtest-0.1.0.0-JD50o4fziYEPTOY150AFK" 'False) (C1 ('MetaCons "OneIteration" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Iterations" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)) :+: C1 ('MetaCons "Continuous" 'PrefixI 'False) (U1 :: Type -> Type)))

data Configuration Source #

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 readConfigFile or readFirstConfigFile to read a configuration.

Instances

Instances details
Eq Configuration Source # 
Instance details

Defined in Test.Syd.OptParse

Show Configuration Source # 
Instance details

Defined in Test.Syd.OptParse

Generic Configuration Source # 
Instance details

Defined in Test.Syd.OptParse

Associated Types

type Rep Configuration :: Type -> Type #

FromJSON Configuration Source # 
Instance details

Defined in Test.Syd.OptParse

YamlSchema Configuration Source #

We use 'yamlparse-applicative' for parsing a YAML config.

Instance details

Defined in Test.Syd.OptParse

type Rep Configuration Source # 
Instance details

Defined in Test.Syd.OptParse

type Rep Configuration = D1 ('MetaData "Configuration" "Test.Syd.OptParse" "sydtest-0.1.0.0-JD50o4fziYEPTOY150AFK" 'False) (C1 ('MetaCons "Configuration" 'PrefixI 'True) (((S1 ('MetaSel ('Just "configSeed") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int)) :*: (S1 ('MetaSel ('Just "configRandomiseExecutionOrder") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)) :*: S1 ('MetaSel ('Just "configThreads") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Threads)))) :*: (S1 ('MetaSel ('Just "configMaxSize") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int)) :*: (S1 ('MetaSel ('Just "configMaxSuccess") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int)) :*: S1 ('MetaSel ('Just "configMaxDiscard") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int))))) :*: ((S1 ('MetaSel ('Just "configMaxShrinks") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int)) :*: (S1 ('MetaSel ('Just "configGoldenStart") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)) :*: S1 ('MetaSel ('Just "configGoldenReset") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)))) :*: ((S1 ('MetaSel ('Just "configColour") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)) :*: S1 ('MetaSel ('Just "configFilter") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Text))) :*: (S1 ('MetaSel ('Just "configFailFast") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)) :*: S1 ('MetaSel ('Just "configIterations") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Iterations)))))))

getConfiguration :: Flags -> Environment -> IO (Maybe Configuration) Source #

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.

defaultConfigFile :: IO (Path Abs File) Source #

Where to get the configuration file by default.

data Environment Source #

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.

Instances

Instances details
Eq Environment Source # 
Instance details

Defined in Test.Syd.OptParse

Show Environment Source # 
Instance details

Defined in Test.Syd.OptParse

Generic Environment Source # 
Instance details

Defined in Test.Syd.OptParse

Associated Types

type Rep Environment :: Type -> Type #

type Rep Environment Source # 
Instance details

Defined in Test.Syd.OptParse

type Rep Environment = D1 ('MetaData "Environment" "Test.Syd.OptParse" "sydtest-0.1.0.0-JD50o4fziYEPTOY150AFK" 'False) (C1 ('MetaCons "Environment" 'PrefixI 'True) (((S1 ('MetaSel ('Just "envConfigFile") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe FilePath)) :*: (S1 ('MetaSel ('Just "envSeed") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int)) :*: S1 ('MetaSel ('Just "envRandomiseExecutionOrder") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)))) :*: ((S1 ('MetaSel ('Just "envThreads") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Threads)) :*: S1 ('MetaSel ('Just "envMaxSize") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int))) :*: (S1 ('MetaSel ('Just "envMaxSuccess") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int)) :*: S1 ('MetaSel ('Just "envMaxDiscard") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int))))) :*: ((S1 ('MetaSel ('Just "envMaxShrinks") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int)) :*: (S1 ('MetaSel ('Just "envGoldenStart") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)) :*: S1 ('MetaSel ('Just "envGoldenReset") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)))) :*: ((S1 ('MetaSel ('Just "envColour") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)) :*: S1 ('MetaSel ('Just "envFilter") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Text))) :*: (S1 ('MetaSel ('Just "envFailFast") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)) :*: S1 ('MetaSel ('Just "envIterations") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Iterations)))))))

getFlags :: IO Flags Source #

Get the command-line flags

prefs_ :: ParserPrefs Source #

The 'optparse-applicative' parsing preferences

flagsParser :: ParserInfo Flags Source #

The optparse-applicative parser for Flags

data Flags Source #

The flags that are common across commands.

Instances

Instances details
Eq Flags Source # 
Instance details

Defined in Test.Syd.OptParse

Methods

(==) :: Flags -> Flags -> Bool #

(/=) :: Flags -> Flags -> Bool #

Show Flags Source # 
Instance details

Defined in Test.Syd.OptParse

Methods

showsPrec :: Int -> Flags -> ShowS #

show :: Flags -> String #

showList :: [Flags] -> ShowS #

Generic Flags Source # 
Instance details

Defined in Test.Syd.OptParse

Associated Types

type Rep Flags :: Type -> Type #

Methods

from :: Flags -> Rep Flags x #

to :: Rep Flags x -> Flags #

type Rep Flags Source # 
Instance details

Defined in Test.Syd.OptParse

type Rep Flags = D1 ('MetaData "Flags" "Test.Syd.OptParse" "sydtest-0.1.0.0-JD50o4fziYEPTOY150AFK" 'False) (C1 ('MetaCons "Flags" 'PrefixI 'True) (((S1 ('MetaSel ('Just "flagConfigFile") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe FilePath)) :*: (S1 ('MetaSel ('Just "flagSeed") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int)) :*: S1 ('MetaSel ('Just "flagRandomiseExecutionOrder") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)))) :*: ((S1 ('MetaSel ('Just "flagThreads") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Threads)) :*: S1 ('MetaSel ('Just "flagMaxSuccess") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int))) :*: (S1 ('MetaSel ('Just "flagMaxSize") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int)) :*: S1 ('MetaSel ('Just "flagMaxDiscard") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int))))) :*: ((S1 ('MetaSel ('Just "flagMaxShrinks") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Int)) :*: (S1 ('MetaSel ('Just "flagGoldenStart") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)) :*: S1 ('MetaSel ('Just "flagGoldenReset") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)))) :*: ((S1 ('MetaSel ('Just "flagColour") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)) :*: S1 ('MetaSel ('Just "flagFilter") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Text))) :*: (S1 ('MetaSel ('Just "flagFailFast") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Bool)) :*: S1 ('MetaSel ('Just "flagIterations") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Iterations)))))))

parseFlags :: Parser Flags Source #

The 'optparse-applicative' parser for the Flags.