{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

module Test.Sandwich.ArgParsing where

import Control.Monad.Logger
import Data.Function
import qualified Data.List as L
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Clock.POSIX
import Data.Typeable
import Options.Applicative
import qualified Options.Applicative as OA
import Safe
import Test.Sandwich.Formatters.FailureReport
import Test.Sandwich.Formatters.MarkdownSummary
import Test.Sandwich.Formatters.Print.Types
import Test.Sandwich.Formatters.Silent
import Test.Sandwich.Internal.Running
import Test.Sandwich.Options
import Test.Sandwich.Types.ArgParsing
import Test.Sandwich.Types.RunTree
import Test.Sandwich.Types.Spec

#ifndef mingw32_HOST_OS
import Test.Sandwich.Formatters.TerminalUI
import Test.Sandwich.Formatters.TerminalUI.Types
#endif

#if MIN_VERSION_time(1,9,0)
import Data.Time.Format.ISO8601
formatTime :: UTCTime -> String
formatTime = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
":" Text
"_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ISO8601 t => t -> String
iso8601Show
#else
formatTime = show
#endif


commandLineOptionsWithInfo :: Parser a -> Parser (Maybe IndividualTestModule) -> ParserInfo (CommandLineOptions a)
commandLineOptionsWithInfo :: forall a.
Parser a
-> Parser (Maybe IndividualTestModule)
-> ParserInfo (CommandLineOptions a)
commandLineOptionsWithInfo Parser a
userOptionsParser Parser (Maybe IndividualTestModule)
individualTestParser = forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info (forall a.
Parser a
-> Parser (Maybe IndividualTestModule)
-> Parser (CommandLineOptions a)
mainCommandLineOptions Parser a
userOptionsParser Parser (Maybe IndividualTestModule)
individualTestParser forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper)
  (
    forall a. InfoMod a
fullDesc
    forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
progDesc String
"Run tests with Sandwich"
    forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
header String
"Sandwich test runner"
  )

goldenOptionsWithInfo :: ParserInfo CommandLineGoldenOptions
goldenOptionsWithInfo :: ParserInfo CommandLineGoldenOptions
goldenOptionsWithInfo = forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info ((forall (f :: * -> *) a. Mod f a)
-> Parser CommandLineGoldenOptions
commandLineGoldenOptions forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper)
  (
    forall a. InfoMod a
briefDesc
    forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
header String
"Special options used for golden testing."
  )

hedgehogOptionsWithInfo :: ParserInfo CommandLineHedgehogOptions
hedgehogOptionsWithInfo :: ParserInfo CommandLineHedgehogOptions
hedgehogOptionsWithInfo = forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info ((forall (f :: * -> *) a. Mod f a)
-> Parser CommandLineHedgehogOptions
commandLineHedgehogOptions forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper)
  (
    forall a. InfoMod a
briefDesc
    forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
header String
"Special options used by sandwich-hedgehog.\n\nIf a flag is passed, it will override the value in the Hedgehog option configured in the code."
  )

quickCheckOptionsWithInfo :: ParserInfo CommandLineQuickCheckOptions
quickCheckOptionsWithInfo :: ParserInfo CommandLineQuickCheckOptions
quickCheckOptionsWithInfo = forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info ((forall (f :: * -> *) a. Mod f a)
-> Parser CommandLineQuickCheckOptions
commandLineQuickCheckOptions forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper)
  (
    forall a. InfoMod a
briefDesc
    forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
header String
"Special options used by sandwich-quickcheck.\n\nIf a flag is passed, it will override the value in the QuickCheck option configured in the code."
  )

slackOptionsWithInfo :: ParserInfo CommandLineSlackOptions
slackOptionsWithInfo :: ParserInfo CommandLineSlackOptions
slackOptionsWithInfo = forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info ((forall (f :: * -> *) a. Mod f a) -> Parser CommandLineSlackOptions
commandLineSlackOptions forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper)
  (
    forall a. InfoMod a
briefDesc
    forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
header String
"Special options passed to the Slack formatter.\n\nIf a flag is passed, it will override the value in the SlackFormatter configured in the code."
  )

webDriverOptionsWithInfo :: ParserInfo CommandLineWebdriverOptions
webDriverOptionsWithInfo :: ParserInfo CommandLineWebdriverOptions
webDriverOptionsWithInfo = forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info ((forall (f :: * -> *) a. Mod f a)
-> Parser CommandLineWebdriverOptions
commandLineWebdriverOptions forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper)
  (
    forall a. InfoMod a
fullDesc
    forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
progDesc String
"Special options passed to the WebDriver formatter, if present.\n\nIf a flag is passed, it will override the value in the WdOptions configured in the code."
    forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
header String
"WebDriver flags"
  )

mainCommandLineOptions :: Parser a -> Parser (Maybe IndividualTestModule) -> Parser (CommandLineOptions a)
mainCommandLineOptions :: forall a.
Parser a
-> Parser (Maybe IndividualTestModule)
-> Parser (CommandLineOptions a)
mainCommandLineOptions Parser a
userOptionsParser Parser (Maybe IndividualTestModule)
individualTestParser = forall a.
FormatterType
-> Maybe LogLevel
-> Maybe Int
-> [String]
-> [String]
-> Int
-> Maybe String
-> Maybe Bool
-> Maybe String
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe IndividualTestModule
-> CommandLineGoldenOptions
-> CommandLineQuickCheckOptions
-> CommandLineHedgehogOptions
-> CommandLineSlackOptions
-> CommandLineWebdriverOptions
-> a
-> CommandLineOptions a
CommandLineOptions
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FormatterType
formatter
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe LogLevel)
logLevel
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"visibility-threshold" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Set the visibility threshold for formatters" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"prune" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Prune test subtrees by string matching text example labels. The matched test and all its children are removed. Pruning happens before filtering, if any" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING"))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"filter" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Filter test tree by string matching text example labels. Filtering happens after pruning, if any" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING"))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"repeat" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r' forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Repeat the test N times and report how many failures occur" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
1 forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"fixed-root" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Store test artifacts at a fixed path" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING"))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"dry-run" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Skip actually launching the tests. This is useful if you want to see the set of the tests that would be run, or start them manually in the terminal UI."))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"markdown-summary" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"File path to write a Markdown summary of the results." forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING"))

  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"list-tests" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"List individual test modules"))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"print-golden-flags" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Print the additional golden testing flags"))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"print-quickcheck-flags" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Print the additional QuickCheck flags"))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"print-hedgehog-flags" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Print the additional Hedgehog flags"))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"print-slack-flags" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Print the additional Slack flags"))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"print-webdriver-flags" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Print the additional Webdriver flags"))

  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe IndividualTestModule)
individualTestParser

  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Mod f a)
-> Parser CommandLineGoldenOptions
commandLineGoldenOptions forall (f :: * -> *) a. Mod f a
internal
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Mod f a)
-> Parser CommandLineQuickCheckOptions
commandLineQuickCheckOptions forall (f :: * -> *) a. Mod f a
internal
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Mod f a)
-> Parser CommandLineHedgehogOptions
commandLineHedgehogOptions forall (f :: * -> *) a. Mod f a
internal
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Mod f a) -> Parser CommandLineSlackOptions
commandLineSlackOptions forall (f :: * -> *) a. Mod f a
internal
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Mod f a)
-> Parser CommandLineWebdriverOptions
commandLineWebdriverOptions forall (f :: * -> *) a. Mod f a
internal

  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
userOptionsParser

formatter :: Parser FormatterType
formatter :: Parser FormatterType
formatter =
  forall a. a -> Mod FlagFields a -> Parser a
flag' FormatterType
Print (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"print" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Print to stdout")
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' FormatterType
PrintFailures (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"print-failures" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Print failures only to stdout")
#ifndef mingw32_HOST_OS
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' FormatterType
TUI (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"tui" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Open terminal UI app")
#endif
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' FormatterType
Silent (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"silent" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Run silently (print the run root only)")
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> a -> Mod FlagFields a -> Parser a
flag FormatterType
Auto FormatterType
Auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"auto" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Automatically decide which formatter to use")

logLevel :: Parser (Maybe LogLevel)
logLevel :: Parser (Maybe LogLevel)
logLevel =
  forall a. a -> Mod FlagFields a -> Parser a
flag' (forall a. a -> Maybe a
Just LogLevel
LevelDebug) (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"debug" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Log level DEBUG")
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' (forall a. a -> Maybe a
Just LogLevel
LevelInfo) (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"info" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Log level INFO")
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' (forall a. a -> Maybe a
Just LogLevel
LevelWarn) (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"warn" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Log level WARN")
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> a -> Mod FlagFields a -> Parser a
flag (forall a. a -> Maybe a
Just LogLevel
LevelWarn) (forall a. a -> Maybe a
Just LogLevel
LevelError) (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"error" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Log level ERROR")

commandLineWebdriverOptions :: (forall f a. Mod f a) -> Parser CommandLineWebdriverOptions
commandLineWebdriverOptions :: (forall (f :: * -> *) a. Mod f a)
-> Parser CommandLineWebdriverOptions
commandLineWebdriverOptions forall (f :: * -> *) a. Mod f a
maybeInternal = Maybe BrowserToUse
-> Maybe DisplayType
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> CommandLineWebdriverOptions
CommandLineWebdriverOptions
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((forall (f :: * -> *) a. Mod f a) -> Parser BrowserToUse
browserToUse forall (f :: * -> *) a. Mod f a
maybeInternal)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((forall (f :: * -> *) a. Mod f a) -> Parser DisplayType
display forall (f :: * -> *) a. Mod f a
maybeInternal)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"fluxbox" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Launch fluxbox as window manager when using Xvfb" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"individual-videos" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Record individual videos of each test (requires ffmpeg and Xvfb)" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"error-videos" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Record videos of each test but delete them unless there was an exception" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal)

  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"selenium-jar" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))

  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"chrome-binary" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"chromedriver-binary" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))

  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"firefox-binary" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"geckodriver-binary" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))

browserToUse :: (forall f a. Mod f a) -> Parser BrowserToUse
browserToUse :: (forall (f :: * -> *) a. Mod f a) -> Parser BrowserToUse
browserToUse forall (f :: * -> *) a. Mod f a
maybeInternal =
  forall a. a -> Mod FlagFields a -> Parser a
flag' BrowserToUse
UseFirefox (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"firefox" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Use Firefox" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> a -> Mod FlagFields a -> Parser a
flag BrowserToUse
UseChrome BrowserToUse
UseChrome (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"chrome" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Use Chrome (default)" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal)

display :: (forall f a. Mod f a) -> Parser DisplayType
display :: (forall (f :: * -> *) a. Mod f a) -> Parser DisplayType
display forall (f :: * -> *) a. Mod f a
maybeInternal =
  forall a. a -> Mod FlagFields a -> Parser a
flag' DisplayType
Current (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"current" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Open browser in current display (default)" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' DisplayType
Headless (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"headless" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Open browser in headless mode" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> a -> Mod FlagFields a -> Parser a
flag DisplayType
Current DisplayType
Xvfb (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"xvfb" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Open browser in Xvfb session" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal)

commandLineGoldenOptions :: (forall f a. Mod f a) -> Parser CommandLineGoldenOptions
commandLineGoldenOptions :: (forall (f :: * -> *) a. Mod f a)
-> Parser CommandLineGoldenOptions
commandLineGoldenOptions forall (f :: * -> *) a. Mod f a
maybeInternal = Maybe Bool -> Maybe String -> CommandLineGoldenOptions
CommandLineGoldenOptions
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"golden-update" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Update your golden files" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"golden-dir" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"The directory where golden results are stored (defaults to \".golden\")" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))

commandLineQuickCheckOptions :: (forall f a. Mod f a) -> Parser CommandLineQuickCheckOptions
commandLineQuickCheckOptions :: (forall (f :: * -> *) a. Mod f a)
-> Parser CommandLineQuickCheckOptions
commandLineQuickCheckOptions forall (f :: * -> *) a. Mod f a
maybeInternal = Maybe Integer
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> CommandLineQuickCheckOptions
CommandLineQuickCheckOptions
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"quickcheck-seed" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"QuickCheck seed" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"quickcheck-max-discard-ratio" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum number of discarded tests per successful test before giving up" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"quickcheck-max-size" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Size to use for the biggest test cases" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"quickcheck-max-success" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum number of successful tests before succeeding" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"quickcheck-max-shrinks" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum number of shrinks before giving up" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))

commandLineHedgehogOptions :: (forall f a. Mod f a) -> Parser CommandLineHedgehogOptions
commandLineHedgehogOptions :: (forall (f :: * -> *) a. Mod f a)
-> Parser CommandLineHedgehogOptions
commandLineHedgehogOptions forall (f :: * -> *) a. Mod f a
maybeInternal = Maybe String
-> Maybe Int
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> CommandLineHedgehogOptions
CommandLineHedgehogOptions
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hedgehog-seed" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Seed as a tuple (a, b)" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hedgehog-size" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Size of the randomly-generated data" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hedgehog-discard-limit" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"The number of times a property is allowed to discard before the test runner gives up" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hedgehog-shrink-limit" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"The number of times a property is allowed to shrink before the test runner gives up and prints the counterexample" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hedgehog-shrink-retries" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"The number of times to re-run a test during shrinking" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))

commandLineSlackOptions :: (forall f a. Mod f a) -> Parser CommandLineSlackOptions
commandLineSlackOptions :: (forall (f :: * -> *) a. Mod f a) -> Parser CommandLineSlackOptions
commandLineSlackOptions forall (f :: * -> *) a. Mod f a
maybeInternal = Maybe String
-> Maybe String
-> Maybe String
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int64
-> CommandLineSlackOptions
CommandLineSlackOptions
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"slack-token" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Slack token to use with the Slack formatter" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"slack-channel" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Slack channel to use with the Slack formatter" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))

  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"slack-top-message" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Top message to display on Slack progress bars" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))

  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"slack-max-failures" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum number of failures to include in a message" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"slack-max-failure-reason-lines" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum number of lines for the failure reason underneath a failure" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"slack-max-callstack-lines" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum number of lines for the callstack reason underneath a failure" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))

  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"slack-visibility-threshold" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Filter the headings on failures by visibility threshold" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))

  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"slack-max-message-size" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum message size in bytes (default: 8192)" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
maybeInternal))

-- * Parse command line args

parseCommandLineArgs :: forall a. (Typeable a) => Parser a -> TopSpecWithOptions' a -> IO (CommandLineOptions a)
parseCommandLineArgs :: forall a.
Typeable a =>
Parser a -> TopSpecWithOptions' a -> IO (CommandLineOptions a)
parseCommandLineArgs Parser a
parser TopSpecWithOptions' a
spec = do
  (CommandLineOptions a
clo, Mod FlagFields (Maybe IndividualTestModule)
-> Parser (Maybe IndividualTestModule)
_, [(NodeModuleInfo, Text)]
_) <- forall a.
Typeable a =>
Parser a
-> TopSpecWithOptions' a
-> IO
     (CommandLineOptions a,
      Mod FlagFields (Maybe IndividualTestModule)
      -> Parser (Maybe IndividualTestModule),
      [(NodeModuleInfo, Text)])
parseCommandLineArgs' Parser a
parser TopSpecWithOptions' a
spec
  forall (m :: * -> *) a. Monad m => a -> m a
return CommandLineOptions a
clo

parseCommandLineArgs' :: forall a. (Typeable a) => Parser a -> TopSpecWithOptions' a -> IO (
  CommandLineOptions a
  , Mod FlagFields (Maybe IndividualTestModule) -> Parser (Maybe IndividualTestModule)
  , [(NodeModuleInfo, T.Text)]
  )
parseCommandLineArgs' :: forall a.
Typeable a =>
Parser a
-> TopSpecWithOptions' a
-> IO
     (CommandLineOptions a,
      Mod FlagFields (Maybe IndividualTestModule)
      -> Parser (Maybe IndividualTestModule),
      [(NodeModuleInfo, Text)])
parseCommandLineArgs' Parser a
userOptionsParser TopSpecWithOptions' a
spec = do
  let modulesAndShorthands :: [(NodeModuleInfo, Text)]
modulesAndShorthands = forall context (m :: * -> *) r.
Free (SpecCommand context m) r -> [NodeModuleInfo]
gatherMainFunctions (TopSpecWithOptions' a
spec :: SpecFree (LabelValue "commandLineOptions" (CommandLineOptions a) :> BaseContext) IO ())
                           forall a b. a -> (a -> b) -> b
& forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn NodeModuleInfo -> String
nodeModuleInfoModuleName
                           forall a b. a -> (a -> b) -> b
& [NodeModuleInfo] -> [(NodeModuleInfo, Text)]
gatherShorthands
  let individualTestFlags :: Mod FlagFields (Maybe IndividualTestModule)
-> [[Maybe (Parser (Maybe IndividualTestModule))]]
individualTestFlags Mod FlagFields (Maybe IndividualTestModule)
maybeInternal =
        [[ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Mod FlagFields a -> Parser a
flag' (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> IndividualTestModule
IndividualTestModuleName String
nodeModuleInfoModuleName)
                        (forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
T.unpack Text
shorthand)
                          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help (String
nodeModuleInfoModuleName
                          forall a. Semigroup a => a -> a -> a
<> (if forall a. Maybe a -> Bool
isJust Maybe (IO ())
nodeModuleInfoFn then String
"*" else String
""))
                          forall a. Semigroup a => a -> a -> a
<> Mod FlagFields (Maybe IndividualTestModule)
maybeInternal)
         , case Maybe (IO ())
nodeModuleInfoFn of
             Maybe (IO ())
Nothing -> forall a. Maybe a
Nothing
             Just IO ()
fn -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Mod FlagFields a -> Parser a
flag' (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ IO () -> IndividualTestModule
IndividualTestMainFn IO ()
fn)
                                     (forall (f :: * -> *) a. HasName f => String -> Mod f a
long (Text -> String
T.unpack (Text
shorthand forall a. Semigroup a => a -> a -> a
<> Text
"-main"))
                                       forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
nodeModuleInfoModuleName
                                       forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
internal
                                     )
         ]
        | (NodeModuleInfo {String
Maybe (IO ())
nodeModuleInfoFn :: NodeModuleInfo -> Maybe (IO ())
nodeModuleInfoFn :: Maybe (IO ())
nodeModuleInfoModuleName :: String
nodeModuleInfoModuleName :: NodeModuleInfo -> String
..}, Text
shorthand) <- [(NodeModuleInfo, Text)]
modulesAndShorthands]
  let individualTestParser :: Mod FlagFields (Maybe IndividualTestModule)
-> Parser (Maybe IndividualTestModule)
individualTestParser Mod FlagFields (Maybe IndividualTestModule)
maybeInternal = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ Mod FlagFields (Maybe IndividualTestModule)
-> [[Maybe (Parser (Maybe IndividualTestModule))]]
individualTestFlags Mod FlagFields (Maybe IndividualTestModule)
maybeInternal)

  CommandLineOptions a
clo <- forall a. ParserInfo a -> IO a
OA.execParser (forall a.
Parser a
-> Parser (Maybe IndividualTestModule)
-> ParserInfo (CommandLineOptions a)
commandLineOptionsWithInfo Parser a
userOptionsParser (Mod FlagFields (Maybe IndividualTestModule)
-> Parser (Maybe IndividualTestModule)
individualTestParser forall (f :: * -> *) a. Mod f a
internal))
  forall (m :: * -> *) a. Monad m => a -> m a
return (CommandLineOptions a
clo, Mod FlagFields (Maybe IndividualTestModule)
-> Parser (Maybe IndividualTestModule)
individualTestParser, [(NodeModuleInfo, Text)]
modulesAndShorthands)

-- * Merge command line args with base options

addOptionsFromArgs :: Options -> CommandLineOptions a -> IO (Options, Int)
addOptionsFromArgs :: forall a. Options -> CommandLineOptions a -> IO (Options, Int)
addOptionsFromArgs Options
baseOptions (CommandLineOptions {a
Int
[String]
Maybe Bool
Maybe Int
Maybe String
Maybe LogLevel
Maybe IndividualTestModule
CommandLineWebdriverOptions
CommandLineSlackOptions
CommandLineHedgehogOptions
CommandLineQuickCheckOptions
CommandLineGoldenOptions
FormatterType
optUserOptions :: forall a. CommandLineOptions a -> a
optWebdriverOptions :: forall a. CommandLineOptions a -> CommandLineWebdriverOptions
optSlackOptions :: forall a. CommandLineOptions a -> CommandLineSlackOptions
optHedgehogOptions :: forall a. CommandLineOptions a -> CommandLineHedgehogOptions
optQuickCheckOptions :: forall a. CommandLineOptions a -> CommandLineQuickCheckOptions
optGoldenOptions :: forall a. CommandLineOptions a -> CommandLineGoldenOptions
optIndividualTestModule :: forall a. CommandLineOptions a -> Maybe IndividualTestModule
optPrintWebDriverFlags :: forall a. CommandLineOptions a -> Maybe Bool
optPrintSlackFlags :: forall a. CommandLineOptions a -> Maybe Bool
optPrintHedgehogFlags :: forall a. CommandLineOptions a -> Maybe Bool
optPrintQuickCheckFlags :: forall a. CommandLineOptions a -> Maybe Bool
optPrintGoldenFlags :: forall a. CommandLineOptions a -> Maybe Bool
optListAvailableTests :: forall a. CommandLineOptions a -> Maybe Bool
optMarkdownSummaryPath :: forall a. CommandLineOptions a -> Maybe String
optDryRun :: forall a. CommandLineOptions a -> Maybe Bool
optFixedRoot :: forall a. CommandLineOptions a -> Maybe String
optRepeatCount :: forall a. CommandLineOptions a -> Int
optTreeFilter :: forall a. CommandLineOptions a -> [String]
optTreePrune :: forall a. CommandLineOptions a -> [String]
optVisibilityThreshold :: forall a. CommandLineOptions a -> Maybe Int
optLogLevel :: forall a. CommandLineOptions a -> Maybe LogLevel
optFormatter :: forall a. CommandLineOptions a -> FormatterType
optUserOptions :: a
optWebdriverOptions :: CommandLineWebdriverOptions
optSlackOptions :: CommandLineSlackOptions
optHedgehogOptions :: CommandLineHedgehogOptions
optQuickCheckOptions :: CommandLineQuickCheckOptions
optGoldenOptions :: CommandLineGoldenOptions
optIndividualTestModule :: Maybe IndividualTestModule
optPrintWebDriverFlags :: Maybe Bool
optPrintSlackFlags :: Maybe Bool
optPrintHedgehogFlags :: Maybe Bool
optPrintQuickCheckFlags :: Maybe Bool
optPrintGoldenFlags :: Maybe Bool
optListAvailableTests :: Maybe Bool
optMarkdownSummaryPath :: Maybe String
optDryRun :: Maybe Bool
optFixedRoot :: Maybe String
optRepeatCount :: Int
optTreeFilter :: [String]
optTreePrune :: [String]
optVisibilityThreshold :: Maybe Int
optLogLevel :: Maybe LogLevel
optFormatter :: FormatterType
..}) = do
  let printFormatter :: SomeFormatter
printFormatter = forall f. (Formatter f, Show f, Typeable f) => f -> SomeFormatter
SomeFormatter forall a b. (a -> b) -> a -> b
$ PrintFormatter
defaultPrintFormatter { printFormatterLogLevel :: Maybe LogLevel
printFormatterLogLevel = Maybe LogLevel
optLogLevel }
  let failureReportFormatter :: SomeFormatter
failureReportFormatter = forall f. (Formatter f, Show f, Typeable f) => f -> SomeFormatter
SomeFormatter forall a b. (a -> b) -> a -> b
$ FailureReportFormatter
defaultFailureReportFormatter { failureReportLogLevel :: Maybe LogLevel
failureReportLogLevel = Maybe LogLevel
optLogLevel }
  let silentFormatter :: SomeFormatter
silentFormatter = forall f. (Formatter f, Show f, Typeable f) => f -> SomeFormatter
SomeFormatter SilentFormatter
defaultSilentFormatter

  Maybe SomeFormatter
maybeMainFormatter <- case (Int
optRepeatCount, FormatterType
optFormatter) of
    (Int
x, FormatterType
_) | Int
x forall a. Eq a => a -> a -> Bool
/= Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SomeFormatter
printFormatter
    (Int
_, FormatterType
Auto) ->
      -- Formerly this tried to use the TUI formatter by default after checking isTuiFormatterSupported.
      -- Unfortunately, this function returns true under "cabal test", which also redirects stdout. So
      -- you end up with no output and a hanging process (until you hit 'q'; stdin is still attached).
      -- Seems like the best default is just the print formatter.
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SomeFormatter
printFormatter
#ifndef mingw32_HOST_OS
    (Int
_, FormatterType
TUI) -> do
      let mainTerminalUiFormatter :: Maybe TerminalUIFormatter
mainTerminalUiFormatter = forall a. [a] -> Maybe a
headMay [TerminalUIFormatter
x | SomeFormatter (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast -> Just x :: TerminalUIFormatter
x@(TerminalUIFormatter {})) <- Options -> [SomeFormatter]
optionsFormatters Options
baseOptions]
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall f. (Formatter f, Show f, Typeable f) => f -> SomeFormatter
SomeFormatter forall a b. (a -> b) -> a -> b
$ (forall a. a -> Maybe a -> a
fromMaybe TerminalUIFormatter
defaultTerminalUIFormatter Maybe TerminalUIFormatter
mainTerminalUiFormatter) { terminalUILogLevel :: Maybe LogLevel
terminalUILogLevel = Maybe LogLevel
optLogLevel }
#endif
    (Int
_, FormatterType
Print) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SomeFormatter
printFormatter
    (Int
_, FormatterType
PrintFailures) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SomeFormatter
failureReportFormatter
    (Int
_, FormatterType
Silent) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SomeFormatter
silentFormatter

  -- Strip out any "main" formatters since the options control that
  let baseFormatters :: [SomeFormatter]
baseFormatters = Options -> [SomeFormatter]
optionsFormatters Options
baseOptions
                     forall a b. a -> (a -> b) -> b
& Maybe String -> [SomeFormatter] -> [SomeFormatter]
tryAddMarkdownSummaryFormatter Maybe String
optMarkdownSummaryPath
                     forall a b. a -> (a -> b) -> b
& forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeFormatter -> Bool
isMainFormatter)

  let finalFormatters :: [SomeFormatter]
finalFormatters = [SomeFormatter]
baseFormatters forall a. Semigroup a => a -> a -> a
<> forall a. [Maybe a] -> [a]
catMaybes [Maybe SomeFormatter
maybeMainFormatter]
                      forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Int -> SomeFormatter -> SomeFormatter
setVisibilityThreshold Maybe Int
optVisibilityThreshold)

  let options :: Options
options = Options
baseOptions {
    optionsTestArtifactsDirectory :: TestArtifactsDirectory
optionsTestArtifactsDirectory = case Maybe String
optFixedRoot of
      Maybe String
Nothing -> String -> IO String -> TestArtifactsDirectory
TestArtifactsGeneratedDirectory String
"test_runs" (UTCTime -> String
formatTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime)
      Just String
path -> String -> TestArtifactsDirectory
TestArtifactsFixedDirectory String
path
    , optionsPruneTree :: Maybe TreeFilter
optionsPruneTree = case [String]
optTreePrune of
        [] -> forall a. Maybe a
Nothing
        [String]
xs -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [String] -> TreeFilter
TreeFilter [String]
xs
    , optionsFilterTree :: Maybe TreeFilter
optionsFilterTree = case [String]
optTreeFilter of
        [] -> forall a. Maybe a
Nothing
        [String]
xs -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [String] -> TreeFilter
TreeFilter [String]
xs
    , optionsFormatters :: [SomeFormatter]
optionsFormatters = [SomeFormatter]
finalFormatters
    , optionsDryRun :: Bool
optionsDryRun = forall a. a -> Maybe a -> a
fromMaybe (Options -> Bool
optionsDryRun Options
baseOptions) Maybe Bool
optDryRun
    }

  forall (m :: * -> *) a. Monad m => a -> m a
return (Options
options, Int
optRepeatCount)

  where
    isMainFormatter :: SomeFormatter -> Bool
    isMainFormatter :: SomeFormatter -> Bool
isMainFormatter (SomeFormatter f
x) = case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast f
x of
      Just (PrintFormatter
_ :: PrintFormatter) -> Bool
True
#ifdef mingw32_HOST_OS
      Nothing -> False
#else
      Maybe PrintFormatter
Nothing -> case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast f
x of
        Just (TerminalUIFormatter
_ :: TerminalUIFormatter) -> Bool
True
        Maybe TerminalUIFormatter
Nothing -> Bool
False
#endif

    setVisibilityThreshold :: Maybe Int -> SomeFormatter -> SomeFormatter
setVisibilityThreshold Maybe Int
Nothing SomeFormatter
x = SomeFormatter
x
    setVisibilityThreshold (Just Int
v) x :: SomeFormatter
x@(SomeFormatter f
f) = case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast f
f of
      Just pf :: PrintFormatter
pf@(PrintFormatter {}) -> forall f. (Formatter f, Show f, Typeable f) => f -> SomeFormatter
SomeFormatter (PrintFormatter
pf { printFormatterVisibilityThreshold :: Int
printFormatterVisibilityThreshold = Int
v })
      Maybe PrintFormatter
Nothing -> case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast f
f of
#ifdef mingw32_HOST_OS
        Just (frf :: FailureReportFormatter) -> SomeFormatter (frf { failureReportVisibilityThreshold = v })
        Nothing -> x
#else
        Just tuif :: TerminalUIFormatter
tuif@(TerminalUIFormatter {}) -> forall f. (Formatter f, Show f, Typeable f) => f -> SomeFormatter
SomeFormatter (TerminalUIFormatter
tuif { terminalUIVisibilityThreshold :: Int
terminalUIVisibilityThreshold = Int
v })
        Maybe TerminalUIFormatter
Nothing -> case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast f
f of
          Just (FailureReportFormatter
frf :: FailureReportFormatter) -> forall f. (Formatter f, Show f, Typeable f) => f -> SomeFormatter
SomeFormatter (FailureReportFormatter
frf { failureReportVisibilityThreshold :: Int
failureReportVisibilityThreshold = Int
v })
          Maybe FailureReportFormatter
Nothing -> SomeFormatter
x
#endif

    isMarkdownSummaryFormatter :: SomeFormatter -> Bool
    isMarkdownSummaryFormatter :: SomeFormatter -> Bool
isMarkdownSummaryFormatter (SomeFormatter f
x) = case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast f
x of
      Just (MarkdownSummaryFormatter
_ :: MarkdownSummaryFormatter) -> Bool
True
      Maybe MarkdownSummaryFormatter
Nothing -> Bool
False

    setMarkdownSummaryFormatterPath :: FilePath -> SomeFormatter -> SomeFormatter
    setMarkdownSummaryFormatterPath :: String -> SomeFormatter -> SomeFormatter
setMarkdownSummaryFormatterPath String
path (SomeFormatter f
x) = case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast f
x of
      Just (MarkdownSummaryFormatter
y :: MarkdownSummaryFormatter) -> forall f. (Formatter f, Show f, Typeable f) => f -> SomeFormatter
SomeFormatter (MarkdownSummaryFormatter
y { markdownSummaryPath :: String
markdownSummaryPath = String
path })
      Maybe MarkdownSummaryFormatter
Nothing -> forall f. (Formatter f, Show f, Typeable f) => f -> SomeFormatter
SomeFormatter f
x

    tryAddMarkdownSummaryFormatter :: Maybe FilePath -> [SomeFormatter] -> [SomeFormatter]
    tryAddMarkdownSummaryFormatter :: Maybe String -> [SomeFormatter] -> [SomeFormatter]
tryAddMarkdownSummaryFormatter Maybe String
Nothing [SomeFormatter]
xs = [SomeFormatter]
xs
    tryAddMarkdownSummaryFormatter (Just String
path) [SomeFormatter]
xs
      | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.any SomeFormatter -> Bool
isMarkdownSummaryFormatter [SomeFormatter]
xs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> SomeFormatter -> SomeFormatter
setMarkdownSummaryFormatterPath String
path) [SomeFormatter]
xs
      | Bool
otherwise = (forall f. (Formatter f, Show f, Typeable f) => f -> SomeFormatter
SomeFormatter (String -> MarkdownSummaryFormatter
defaultMarkdownSummaryFormatter String
path)) forall a. a -> [a] -> [a]
: [SomeFormatter]
xs