{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.Sandwich.ArgParsing where

import Control.Monad.Logger
import Data.Function
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 System.IO
import Test.Sandwich.Formatters.FailureReport
import Test.Sandwich.Formatters.Print.Types
import Test.Sandwich.Formatters.Silent
import Test.Sandwich.Formatters.TerminalUI
import Test.Sandwich.Formatters.TerminalUI.Types
import Test.Sandwich.Options
import Test.Sandwich.Types.ArgParsing

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


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

slackOptionsWithInfo :: ParserInfo CommandLineSlackOptions
slackOptionsWithInfo :: ParserInfo CommandLineSlackOptions
slackOptionsWithInfo = Parser CommandLineSlackOptions
-> InfoMod CommandLineSlackOptions
-> ParserInfo CommandLineSlackOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info ((forall (f :: * -> *) a. Mod f a) -> Parser CommandLineSlackOptions
commandLineSlackOptions forall a. Monoid a => a
forall (f :: * -> *) a. Mod f a
mempty Parser CommandLineSlackOptions
-> Parser (CommandLineSlackOptions -> CommandLineSlackOptions)
-> Parser CommandLineSlackOptions
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (CommandLineSlackOptions -> CommandLineSlackOptions)
forall a. Parser (a -> a)
helper)
  (
    InfoMod CommandLineSlackOptions
forall a. InfoMod a
briefDesc
    InfoMod CommandLineSlackOptions
-> InfoMod CommandLineSlackOptions
-> InfoMod CommandLineSlackOptions
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod CommandLineSlackOptions
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 = Parser CommandLineWebdriverOptions
-> InfoMod CommandLineWebdriverOptions
-> ParserInfo CommandLineWebdriverOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info ((forall (f :: * -> *) a. Mod f a)
-> Parser CommandLineWebdriverOptions
commandLineWebdriverOptions forall a. Monoid a => a
forall (f :: * -> *) a. Mod f a
mempty Parser CommandLineWebdriverOptions
-> Parser
     (CommandLineWebdriverOptions -> CommandLineWebdriverOptions)
-> Parser CommandLineWebdriverOptions
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (CommandLineWebdriverOptions -> CommandLineWebdriverOptions)
forall a. Parser (a -> a)
helper)
  (
    InfoMod CommandLineWebdriverOptions
forall a. InfoMod a
fullDesc
    InfoMod CommandLineWebdriverOptions
-> InfoMod CommandLineWebdriverOptions
-> InfoMod CommandLineWebdriverOptions
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod CommandLineWebdriverOptions
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."
    InfoMod CommandLineWebdriverOptions
-> InfoMod CommandLineWebdriverOptions
-> InfoMod CommandLineWebdriverOptions
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod CommandLineWebdriverOptions
forall a. String -> InfoMod a
header String
"WebDriver flags"
  )

mainCommandLineOptions :: Parser a -> Parser (Maybe IndividualTestModule) -> Parser (CommandLineOptions a)
mainCommandLineOptions :: Parser a
-> Parser (Maybe IndividualTestModule)
-> Parser (CommandLineOptions a)
mainCommandLineOptions Parser a
userOptionsParser Parser (Maybe IndividualTestModule)
individualTestParser = FormatterType
-> Maybe LogLevel
-> Maybe String
-> Int
-> Maybe String
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe IndividualTestModule
-> CommandLineWebdriverOptions
-> CommandLineSlackOptions
-> a
-> CommandLineOptions a
forall a.
FormatterType
-> Maybe LogLevel
-> Maybe String
-> Int
-> Maybe String
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe IndividualTestModule
-> CommandLineWebdriverOptions
-> CommandLineSlackOptions
-> a
-> CommandLineOptions a
CommandLineOptions
  (FormatterType
 -> Maybe LogLevel
 -> Maybe String
 -> Int
 -> Maybe String
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe IndividualTestModule
 -> CommandLineWebdriverOptions
 -> CommandLineSlackOptions
 -> a
 -> CommandLineOptions a)
-> Parser FormatterType
-> Parser
     (Maybe LogLevel
      -> Maybe String
      -> Int
      -> Maybe String
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe IndividualTestModule
      -> CommandLineWebdriverOptions
      -> CommandLineSlackOptions
      -> a
      -> CommandLineOptions a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FormatterType
formatter
  Parser
  (Maybe LogLevel
   -> Maybe String
   -> Int
   -> Maybe String
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe IndividualTestModule
   -> CommandLineWebdriverOptions
   -> CommandLineSlackOptions
   -> a
   -> CommandLineOptions a)
-> Parser (Maybe LogLevel)
-> Parser
     (Maybe String
      -> Int
      -> Maybe String
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe IndividualTestModule
      -> CommandLineWebdriverOptions
      -> CommandLineSlackOptions
      -> a
      -> CommandLineOptions a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe LogLevel)
logLevel
  Parser
  (Maybe String
   -> Int
   -> Maybe String
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe IndividualTestModule
   -> CommandLineWebdriverOptions
   -> CommandLineSlackOptions
   -> a
   -> CommandLineOptions a)
-> Parser (Maybe String)
-> Parser
     (Int
      -> Maybe String
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe IndividualTestModule
      -> CommandLineWebdriverOptions
      -> CommandLineSlackOptions
      -> a
      -> CommandLineOptions a)
forall (f :: * -> *) a b. Applicative f => 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 (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"filter" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Filter test tree by string matching text example labels" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING"))
  Parser
  (Int
   -> Maybe String
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe IndividualTestModule
   -> CommandLineWebdriverOptions
   -> CommandLineSlackOptions
   -> a
   -> CommandLineOptions a)
-> Parser Int
-> Parser
     (Maybe String
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe IndividualTestModule
      -> CommandLineWebdriverOptions
      -> CommandLineSlackOptions
      -> a
      -> CommandLineOptions a)
forall (f :: * -> *) a b. Applicative f => 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 (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"repeat" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Repeat the test N times and report how many failures occur" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
1 Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT")
  Parser
  (Maybe String
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe IndividualTestModule
   -> CommandLineWebdriverOptions
   -> CommandLineSlackOptions
   -> a
   -> CommandLineOptions a)
-> Parser (Maybe String)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe IndividualTestModule
      -> CommandLineWebdriverOptions
      -> CommandLineSlackOptions
      -> a
      -> CommandLineOptions a)
forall (f :: * -> *) a b. Applicative f => 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 (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"fixed-root" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Store test artifacts at a fixed path" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING"))

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

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

  Parser
  (CommandLineWebdriverOptions
   -> CommandLineSlackOptions -> a -> CommandLineOptions a)
-> Parser CommandLineWebdriverOptions
-> Parser (CommandLineSlackOptions -> a -> CommandLineOptions a)
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
  Parser (CommandLineSlackOptions -> a -> CommandLineOptions a)
-> Parser CommandLineSlackOptions
-> Parser (a -> CommandLineOptions a)
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

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

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

logLevel :: Parser (Maybe LogLevel)
logLevel :: Parser (Maybe LogLevel)
logLevel =
  Maybe LogLevel
-> Mod FlagFields (Maybe LogLevel) -> Parser (Maybe LogLevel)
forall a. a -> Mod FlagFields a -> Parser a
flag' (LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LevelDebug) (String -> Mod FlagFields (Maybe LogLevel)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"debug" Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields (Maybe LogLevel)
forall (f :: * -> *) a. String -> Mod f a
help String
"Log level DEBUG")
  Parser (Maybe LogLevel)
-> Parser (Maybe LogLevel) -> Parser (Maybe LogLevel)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe LogLevel
-> Mod FlagFields (Maybe LogLevel) -> Parser (Maybe LogLevel)
forall a. a -> Mod FlagFields a -> Parser a
flag' (LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LevelInfo) (String -> Mod FlagFields (Maybe LogLevel)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"info" Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields (Maybe LogLevel)
forall (f :: * -> *) a. String -> Mod f a
help String
"Log level INFO")
  Parser (Maybe LogLevel)
-> Parser (Maybe LogLevel) -> Parser (Maybe LogLevel)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe LogLevel
-> Mod FlagFields (Maybe LogLevel) -> Parser (Maybe LogLevel)
forall a. a -> Mod FlagFields a -> Parser a
flag' (LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LevelWarn) (String -> Mod FlagFields (Maybe LogLevel)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"warn" Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields (Maybe LogLevel)
forall (f :: * -> *) a. String -> Mod f a
help String
"Log level WARN")
  Parser (Maybe LogLevel)
-> Parser (Maybe LogLevel) -> Parser (Maybe LogLevel)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe LogLevel
-> Maybe LogLevel
-> Mod FlagFields (Maybe LogLevel)
-> Parser (Maybe LogLevel)
forall a. a -> a -> Mod FlagFields a -> Parser a
flag (LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LevelWarn) (LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LevelError) (String -> Mod FlagFields (Maybe LogLevel)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"error" Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
-> Mod FlagFields (Maybe LogLevel)
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields (Maybe LogLevel)
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
-> CommandLineWebdriverOptions
CommandLineWebdriverOptions
  (Maybe BrowserToUse
 -> Maybe DisplayType
 -> Bool
 -> Bool
 -> Bool
 -> CommandLineWebdriverOptions)
-> Parser (Maybe BrowserToUse)
-> Parser
     (Maybe DisplayType
      -> Bool -> Bool -> Bool -> CommandLineWebdriverOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser BrowserToUse -> Parser (Maybe BrowserToUse)
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)
  Parser
  (Maybe DisplayType
   -> Bool -> Bool -> Bool -> CommandLineWebdriverOptions)
-> Parser (Maybe DisplayType)
-> Parser (Bool -> Bool -> Bool -> CommandLineWebdriverOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DisplayType -> Parser (Maybe DisplayType)
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)
  Parser (Bool -> Bool -> Bool -> CommandLineWebdriverOptions)
-> Parser Bool
-> Parser (Bool -> Bool -> CommandLineWebdriverOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"fluxbox" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Launch fluxbox as window manager when using Xvfb" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall (f :: * -> *) a. Mod f a
maybeInternal)
  Parser (Bool -> Bool -> CommandLineWebdriverOptions)
-> Parser Bool -> Parser (Bool -> CommandLineWebdriverOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"individual-videos" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Record individual videos of each test (requires ffmpeg and Xvfb)" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall (f :: * -> *) a. Mod f a
maybeInternal)
  Parser (Bool -> CommandLineWebdriverOptions)
-> Parser Bool -> Parser CommandLineWebdriverOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"error-videos" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Record videos of each test but delete them unless there was an exception" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
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 =
  BrowserToUse -> Mod FlagFields BrowserToUse -> Parser BrowserToUse
forall a. a -> Mod FlagFields a -> Parser a
flag' BrowserToUse
UseFirefox (String -> Mod FlagFields BrowserToUse
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"firefox" Mod FlagFields BrowserToUse
-> Mod FlagFields BrowserToUse -> Mod FlagFields BrowserToUse
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields BrowserToUse
forall (f :: * -> *) a. String -> Mod f a
help String
"Use Firefox" Mod FlagFields BrowserToUse
-> Mod FlagFields BrowserToUse -> Mod FlagFields BrowserToUse
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields BrowserToUse
forall (f :: * -> *) a. Mod f a
maybeInternal)
  Parser BrowserToUse -> Parser BrowserToUse -> Parser BrowserToUse
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BrowserToUse
-> BrowserToUse
-> Mod FlagFields BrowserToUse
-> Parser BrowserToUse
forall a. a -> a -> Mod FlagFields a -> Parser a
flag BrowserToUse
UseChrome BrowserToUse
UseChrome (String -> Mod FlagFields BrowserToUse
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"chrome" Mod FlagFields BrowserToUse
-> Mod FlagFields BrowserToUse -> Mod FlagFields BrowserToUse
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields BrowserToUse
forall (f :: * -> *) a. String -> Mod f a
help String
"Use Chrome (default)" Mod FlagFields BrowserToUse
-> Mod FlagFields BrowserToUse -> Mod FlagFields BrowserToUse
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields BrowserToUse
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 =
  DisplayType -> Mod FlagFields DisplayType -> Parser DisplayType
forall a. a -> Mod FlagFields a -> Parser a
flag' DisplayType
Current (String -> Mod FlagFields DisplayType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"current" Mod FlagFields DisplayType
-> Mod FlagFields DisplayType -> Mod FlagFields DisplayType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields DisplayType
forall (f :: * -> *) a. String -> Mod f a
help String
"Open browser in current display (default)" Mod FlagFields DisplayType
-> Mod FlagFields DisplayType -> Mod FlagFields DisplayType
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields DisplayType
forall (f :: * -> *) a. Mod f a
maybeInternal)
  Parser DisplayType -> Parser DisplayType -> Parser DisplayType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DisplayType -> Mod FlagFields DisplayType -> Parser DisplayType
forall a. a -> Mod FlagFields a -> Parser a
flag' DisplayType
Headless (String -> Mod FlagFields DisplayType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"headless" Mod FlagFields DisplayType
-> Mod FlagFields DisplayType -> Mod FlagFields DisplayType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields DisplayType
forall (f :: * -> *) a. String -> Mod f a
help String
"Open browser in headless mode" Mod FlagFields DisplayType
-> Mod FlagFields DisplayType -> Mod FlagFields DisplayType
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields DisplayType
forall (f :: * -> *) a. Mod f a
maybeInternal)
  Parser DisplayType -> Parser DisplayType -> Parser DisplayType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DisplayType
-> DisplayType -> Mod FlagFields DisplayType -> Parser DisplayType
forall a. a -> a -> Mod FlagFields a -> Parser a
flag DisplayType
Current DisplayType
Xvfb (String -> Mod FlagFields DisplayType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"xvfb" Mod FlagFields DisplayType
-> Mod FlagFields DisplayType -> Mod FlagFields DisplayType
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields DisplayType
forall (f :: * -> *) a. String -> Mod f a
help String
"Open browser in Xvfb session" Mod FlagFields DisplayType
-> Mod FlagFields DisplayType -> Mod FlagFields DisplayType
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields DisplayType
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
  (Maybe String
 -> Maybe String
 -> Maybe String
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int64
 -> CommandLineSlackOptions)
-> Parser (Maybe String)
-> Parser
     (Maybe String
      -> Maybe String
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int64
      -> CommandLineSlackOptions)
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 (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"slack-token" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Slack token to use with the Slack formatter" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
maybeInternal))
  Parser
  (Maybe String
   -> Maybe String
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int64
   -> CommandLineSlackOptions)
-> Parser (Maybe String)
-> Parser
     (Maybe String
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int64
      -> CommandLineSlackOptions)
forall (f :: * -> *) a b. Applicative f => 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 (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"slack-channel" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Slack channel to use with the Slack formatter" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
maybeInternal))

  Parser
  (Maybe String
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int64
   -> CommandLineSlackOptions)
-> Parser (Maybe String)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int64
      -> CommandLineSlackOptions)
forall (f :: * -> *) a b. Applicative f => 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 (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"slack-top-message" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Top message to display on Slack progress bars" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
maybeInternal))

  Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int64
   -> CommandLineSlackOptions)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int64
      -> CommandLineSlackOptions)
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 (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"slack-max-failures" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum number of failures to include in a message" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall (f :: * -> *) a. Mod f a
maybeInternal))
  Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int64
   -> CommandLineSlackOptions)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int -> Maybe Int -> Maybe Int64 -> CommandLineSlackOptions)
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 (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"slack-max-failure-reason-lines" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum number of lines for the failure reason underneath a failure" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall (f :: * -> *) a. Mod f a
maybeInternal))
  Parser
  (Maybe Int -> Maybe Int -> Maybe Int64 -> CommandLineSlackOptions)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> Maybe Int64 -> CommandLineSlackOptions)
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 (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"slack-max-callstack-lines" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum number of lines for the callstack reason underneath a failure" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall (f :: * -> *) a. Mod f a
maybeInternal))

  Parser (Maybe Int -> Maybe Int64 -> CommandLineSlackOptions)
-> Parser (Maybe Int)
-> Parser (Maybe Int64 -> CommandLineSlackOptions)
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 (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"slack-visibility-threshold" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Filter the headings on failures by visibility threshold" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall (f :: * -> *) a. Mod f a
maybeInternal))

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

-- * Main parsing function

addOptionsFromArgs :: Options -> CommandLineOptions a -> IO (Options, Int)
addOptionsFromArgs :: Options -> CommandLineOptions a -> IO (Options, Int)
addOptionsFromArgs Options
baseOptions (CommandLineOptions {a
Int
Maybe Bool
Maybe String
Maybe LogLevel
Maybe IndividualTestModule
CommandLineWebdriverOptions
CommandLineSlackOptions
FormatterType
optUserOptions :: forall a. CommandLineOptions a -> a
optSlackOptions :: forall a. CommandLineOptions a -> CommandLineSlackOptions
optWebdriverOptions :: forall a. CommandLineOptions a -> CommandLineWebdriverOptions
optIndividualTestModule :: forall a. CommandLineOptions a -> Maybe IndividualTestModule
optPrintWebDriverFlags :: forall a. CommandLineOptions a -> Maybe Bool
optPrintSlackFlags :: forall a. CommandLineOptions a -> Maybe Bool
optListAvailableTests :: forall a. CommandLineOptions a -> Maybe Bool
optFixedRoot :: forall a. CommandLineOptions a -> Maybe String
optRepeatCount :: forall a. CommandLineOptions a -> Int
optTreeFilter :: forall a. CommandLineOptions a -> Maybe String
optLogLevel :: forall a. CommandLineOptions a -> Maybe LogLevel
optFormatter :: forall a. CommandLineOptions a -> FormatterType
optUserOptions :: a
optSlackOptions :: CommandLineSlackOptions
optWebdriverOptions :: CommandLineWebdriverOptions
optIndividualTestModule :: Maybe IndividualTestModule
optPrintWebDriverFlags :: Maybe Bool
optPrintSlackFlags :: Maybe Bool
optListAvailableTests :: Maybe Bool
optFixedRoot :: Maybe String
optRepeatCount :: Int
optTreeFilter :: Maybe String
optLogLevel :: Maybe LogLevel
optFormatter :: FormatterType
..}) = do
  let printFormatter :: SomeFormatter
printFormatter = PrintFormatter -> SomeFormatter
forall f. (Formatter f, Show f, Typeable f) => f -> SomeFormatter
SomeFormatter (PrintFormatter -> SomeFormatter)
-> PrintFormatter -> SomeFormatter
forall a b. (a -> b) -> a -> b
$ PrintFormatter
defaultPrintFormatter { printFormatterLogLevel :: Maybe LogLevel
printFormatterLogLevel = Maybe LogLevel
optLogLevel }
  let failureReportFormatter :: SomeFormatter
failureReportFormatter = FailureReportFormatter -> SomeFormatter
forall f. (Formatter f, Show f, Typeable f) => f -> SomeFormatter
SomeFormatter (FailureReportFormatter -> SomeFormatter)
-> FailureReportFormatter -> SomeFormatter
forall a b. (a -> b) -> a -> b
$ FailureReportFormatter
defaultFailureReportFormatter { failureReportLogLevel :: Maybe LogLevel
failureReportLogLevel = Maybe LogLevel
optLogLevel }
  let tuiFormatter :: SomeFormatter
tuiFormatter = TerminalUIFormatter -> SomeFormatter
forall f. (Formatter f, Show f, Typeable f) => f -> SomeFormatter
SomeFormatter (TerminalUIFormatter -> SomeFormatter)
-> TerminalUIFormatter -> SomeFormatter
forall a b. (a -> b) -> a -> b
$ TerminalUIFormatter
defaultTerminalUIFormatter { terminalUILogLevel :: Maybe LogLevel
terminalUILogLevel = Maybe LogLevel
optLogLevel }
  let silentFormatter :: SomeFormatter
silentFormatter = SilentFormatter -> SomeFormatter
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 -> Maybe SomeFormatter -> IO (Maybe SomeFormatter)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SomeFormatter -> IO (Maybe SomeFormatter))
-> Maybe SomeFormatter -> IO (Maybe SomeFormatter)
forall a b. (a -> b) -> a -> b
$ SomeFormatter -> Maybe SomeFormatter
forall a. a -> Maybe a
Just SomeFormatter
printFormatter
    (Int
_, FormatterType
Auto) -> Handle -> IO Bool
hIsTerminalDevice Handle
stdout IO Bool
-> (Bool -> IO (Maybe SomeFormatter)) -> IO (Maybe SomeFormatter)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
True -> Maybe SomeFormatter -> IO (Maybe SomeFormatter)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SomeFormatter -> IO (Maybe SomeFormatter))
-> Maybe SomeFormatter -> IO (Maybe SomeFormatter)
forall a b. (a -> b) -> a -> b
$ SomeFormatter -> Maybe SomeFormatter
forall a. a -> Maybe a
Just SomeFormatter
printFormatter
      Bool
False -> Maybe SomeFormatter -> IO (Maybe SomeFormatter)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SomeFormatter -> IO (Maybe SomeFormatter))
-> Maybe SomeFormatter -> IO (Maybe SomeFormatter)
forall a b. (a -> b) -> a -> b
$ SomeFormatter -> Maybe SomeFormatter
forall a. a -> Maybe a
Just SomeFormatter
tuiFormatter
    (Int
_, FormatterType
TUI) -> Maybe SomeFormatter -> IO (Maybe SomeFormatter)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SomeFormatter -> IO (Maybe SomeFormatter))
-> Maybe SomeFormatter -> IO (Maybe SomeFormatter)
forall a b. (a -> b) -> a -> b
$ SomeFormatter -> Maybe SomeFormatter
forall a. a -> Maybe a
Just SomeFormatter
tuiFormatter
    (Int
_, FormatterType
Print) -> Maybe SomeFormatter -> IO (Maybe SomeFormatter)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SomeFormatter -> IO (Maybe SomeFormatter))
-> Maybe SomeFormatter -> IO (Maybe SomeFormatter)
forall a b. (a -> b) -> a -> b
$ SomeFormatter -> Maybe SomeFormatter
forall a. a -> Maybe a
Just SomeFormatter
printFormatter
    (Int
_, FormatterType
PrintFailures) -> Maybe SomeFormatter -> IO (Maybe SomeFormatter)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SomeFormatter -> IO (Maybe SomeFormatter))
-> Maybe SomeFormatter -> IO (Maybe SomeFormatter)
forall a b. (a -> b) -> a -> b
$ SomeFormatter -> Maybe SomeFormatter
forall a. a -> Maybe a
Just SomeFormatter
failureReportFormatter
    (Int
_, FormatterType
Silent) -> Maybe SomeFormatter -> IO (Maybe SomeFormatter)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SomeFormatter -> IO (Maybe SomeFormatter))
-> Maybe SomeFormatter -> IO (Maybe SomeFormatter)
forall a b. (a -> b) -> a -> b
$ SomeFormatter -> Maybe SomeFormatter
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
                     [SomeFormatter]
-> ([SomeFormatter] -> [SomeFormatter]) -> [SomeFormatter]
forall a b. a -> (a -> b) -> b
& (SomeFormatter -> Bool) -> [SomeFormatter] -> [SomeFormatter]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (SomeFormatter -> Bool) -> SomeFormatter -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeFormatter -> Bool
isMainFormatter)

  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 (UTCTime -> String) -> IO UTCTime -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime)
      Just String
path -> String -> TestArtifactsDirectory
TestArtifactsFixedDirectory String
path
    , optionsFilterTree :: Maybe TreeFilter
optionsFilterTree = String -> TreeFilter
TreeFilter (String -> TreeFilter) -> Maybe String -> Maybe TreeFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
optTreeFilter
    , optionsFormatters :: [SomeFormatter]
optionsFormatters = [SomeFormatter]
baseFormatters [SomeFormatter] -> [SomeFormatter] -> [SomeFormatter]
forall a. Semigroup a => a -> a -> a
<> [Maybe SomeFormatter] -> [SomeFormatter]
forall a. [Maybe a] -> [a]
catMaybes [Maybe SomeFormatter
maybeMainFormatter]
    }

  (Options, Int) -> IO (Options, Int)
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 f -> Maybe PrintFormatter
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast f
x of
      Just (PrintFormatter
_ :: PrintFormatter) -> Bool
True
      Maybe PrintFormatter
Nothing -> case f -> Maybe TerminalUIFormatter
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast f
x of
        Just (TerminalUIFormatter
_ :: TerminalUIFormatter) -> Bool
True
        Maybe TerminalUIFormatter
Nothing -> Bool
False