{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}

module Test.Sandwich.Types.ArgParsing where

import Control.Monad.Logger
import GHC.Int


-- * FormatterType

data FormatterType =
  Print
  | TUI
  | PrintFailures
  | Auto
  | Silent

instance Show FormatterType where
  show :: FormatterType -> String
show FormatterType
Print = String
"print"
  show FormatterType
PrintFailures = String
"print-failures"
  show FormatterType
TUI = String
"tui"
  show FormatterType
Auto = String
"auto"
  show FormatterType
Silent = String
"silent"

instance Read FormatterType where
  readsPrec :: Int -> ReadS FormatterType
readsPrec Int
_ String
"print" = [(FormatterType
Print, String
"")]
  readsPrec Int
_ String
"tui" = [(FormatterType
TUI, String
"")]
  readsPrec Int
_ String
"auto" = [(FormatterType
Auto, String
"")]
  readsPrec Int
_ String
"silent" = [(FormatterType
Silent, String
"")]
  readsPrec Int
_ String
_ = []

-- * DisplayType

data DisplayType = Current | Headless | Xvfb

instance Show DisplayType where
  show :: DisplayType -> String
show DisplayType
Current = String
"current"
  show DisplayType
Headless = String
"headless"
  show DisplayType
Xvfb = String
"xvfb"

instance Read DisplayType where
  readsPrec :: Int -> ReadS DisplayType
readsPrec Int
_ String
"current" = [(DisplayType
Current, String
"")]
  readsPrec Int
_ String
"headless" = [(DisplayType
Headless, String
"")]
  readsPrec Int
_ String
"xvfb" = [(DisplayType
Xvfb, String
"")]
  readsPrec Int
_ String
_ = []

-- * CommandLineOptions

data CommandLineOptions a = CommandLineOptions {
  forall a. CommandLineOptions a -> FormatterType
optFormatter :: FormatterType
  , forall a. CommandLineOptions a -> Maybe LogLevel
optLogLevel :: Maybe LogLevel
  , forall a. CommandLineOptions a -> Maybe Int
optVisibilityThreshold :: Maybe Int
  , forall a. CommandLineOptions a -> [String]
optTreePrune :: [String]
  , forall a. CommandLineOptions a -> [String]
optTreeFilter :: [String]
  , forall a. CommandLineOptions a -> Int
optRepeatCount :: Int
  , forall a. CommandLineOptions a -> Maybe String
optFixedRoot :: Maybe String
  , forall a. CommandLineOptions a -> Maybe Bool
optDryRun :: Maybe Bool
  , forall a. CommandLineOptions a -> Maybe String
optMarkdownSummaryPath :: Maybe FilePath

  , forall a. CommandLineOptions a -> Maybe Bool
optListAvailableTests :: Maybe Bool
  , forall a. CommandLineOptions a -> Maybe Bool
optPrintGoldenFlags :: Maybe Bool
  , forall a. CommandLineOptions a -> Maybe Bool
optPrintQuickCheckFlags :: Maybe Bool
  , forall a. CommandLineOptions a -> Maybe Bool
optPrintHedgehogFlags :: Maybe Bool
  , forall a. CommandLineOptions a -> Maybe Bool
optPrintSlackFlags :: Maybe Bool
  , forall a. CommandLineOptions a -> Maybe Bool
optPrintWebDriverFlags :: Maybe Bool

  , forall a. CommandLineOptions a -> Maybe IndividualTestModule
optIndividualTestModule :: Maybe IndividualTestModule

  , forall a. CommandLineOptions a -> CommandLineGoldenOptions
optGoldenOptions :: CommandLineGoldenOptions
  , forall a. CommandLineOptions a -> CommandLineQuickCheckOptions
optQuickCheckOptions :: CommandLineQuickCheckOptions
  , forall a. CommandLineOptions a -> CommandLineHedgehogOptions
optHedgehogOptions :: CommandLineHedgehogOptions
  , forall a. CommandLineOptions a -> CommandLineSlackOptions
optSlackOptions :: CommandLineSlackOptions
  , forall a. CommandLineOptions a -> CommandLineWebdriverOptions
optWebdriverOptions :: CommandLineWebdriverOptions

  , forall a. CommandLineOptions a -> a
optUserOptions :: a
  } deriving Int -> CommandLineOptions a -> ShowS
[CommandLineOptions a] -> ShowS
CommandLineOptions a -> String
(Int -> CommandLineOptions a -> ShowS)
-> (CommandLineOptions a -> String)
-> ([CommandLineOptions a] -> ShowS)
-> Show (CommandLineOptions a)
forall a. Show a => Int -> CommandLineOptions a -> ShowS
forall a. Show a => [CommandLineOptions a] -> ShowS
forall a. Show a => CommandLineOptions a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> CommandLineOptions a -> ShowS
showsPrec :: Int -> CommandLineOptions a -> ShowS
$cshow :: forall a. Show a => CommandLineOptions a -> String
show :: CommandLineOptions a -> String
$cshowList :: forall a. Show a => [CommandLineOptions a] -> ShowS
showList :: [CommandLineOptions a] -> ShowS
Show

data IndividualTestModule = IndividualTestModuleName String
                          | IndividualTestMainFn (IO ())

instance Show IndividualTestModule where
  show :: IndividualTestModule -> String
show (IndividualTestModuleName String
moduleName) = String
moduleName
  show (IndividualTestMainFn IO ()
_) = String
"<main function>"

-- * golden options

data CommandLineGoldenOptions = CommandLineGoldenOptions {
  CommandLineGoldenOptions -> Maybe Bool
optUpdateGolden :: Maybe Bool
  , CommandLineGoldenOptions -> Maybe String
optGoldenDir :: Maybe FilePath
  } deriving Int -> CommandLineGoldenOptions -> ShowS
[CommandLineGoldenOptions] -> ShowS
CommandLineGoldenOptions -> String
(Int -> CommandLineGoldenOptions -> ShowS)
-> (CommandLineGoldenOptions -> String)
-> ([CommandLineGoldenOptions] -> ShowS)
-> Show CommandLineGoldenOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandLineGoldenOptions -> ShowS
showsPrec :: Int -> CommandLineGoldenOptions -> ShowS
$cshow :: CommandLineGoldenOptions -> String
show :: CommandLineGoldenOptions -> String
$cshowList :: [CommandLineGoldenOptions] -> ShowS
showList :: [CommandLineGoldenOptions] -> ShowS
Show

-- * sandwich-quickcheck options

data CommandLineQuickCheckOptions = CommandLineQuickCheckOptions {
  CommandLineQuickCheckOptions -> Maybe Integer
optQuickCheckSeed :: Maybe Integer
  , CommandLineQuickCheckOptions -> Maybe Int
optQuickCheckMaxDiscardRatio :: Maybe Int
  , CommandLineQuickCheckOptions -> Maybe Int
optQuickCheckMaxSize :: Maybe Int
  , CommandLineQuickCheckOptions -> Maybe Int
optQuickCheckMaxSuccess :: Maybe Int
  , CommandLineQuickCheckOptions -> Maybe Int
optQuickCheckMaxShrinks :: Maybe Int
  } deriving Int -> CommandLineQuickCheckOptions -> ShowS
[CommandLineQuickCheckOptions] -> ShowS
CommandLineQuickCheckOptions -> String
(Int -> CommandLineQuickCheckOptions -> ShowS)
-> (CommandLineQuickCheckOptions -> String)
-> ([CommandLineQuickCheckOptions] -> ShowS)
-> Show CommandLineQuickCheckOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandLineQuickCheckOptions -> ShowS
showsPrec :: Int -> CommandLineQuickCheckOptions -> ShowS
$cshow :: CommandLineQuickCheckOptions -> String
show :: CommandLineQuickCheckOptions -> String
$cshowList :: [CommandLineQuickCheckOptions] -> ShowS
showList :: [CommandLineQuickCheckOptions] -> ShowS
Show

-- * sandwich-hedgehog options

data CommandLineHedgehogOptions = CommandLineHedgehogOptions {
  CommandLineHedgehogOptions -> Maybe String
optHedgehogSeed :: Maybe String
  , CommandLineHedgehogOptions -> Maybe Int
optHedgehogSize :: Maybe Int
  , CommandLineHedgehogOptions -> Maybe Integer
optHedgehogDiscardLimit :: Maybe Integer
  , CommandLineHedgehogOptions -> Maybe Integer
optHedgehogShrinkLimit :: Maybe Integer
  , CommandLineHedgehogOptions -> Maybe Integer
optHedgehogShrinkRetries :: Maybe Integer
  } deriving Int -> CommandLineHedgehogOptions -> ShowS
[CommandLineHedgehogOptions] -> ShowS
CommandLineHedgehogOptions -> String
(Int -> CommandLineHedgehogOptions -> ShowS)
-> (CommandLineHedgehogOptions -> String)
-> ([CommandLineHedgehogOptions] -> ShowS)
-> Show CommandLineHedgehogOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandLineHedgehogOptions -> ShowS
showsPrec :: Int -> CommandLineHedgehogOptions -> ShowS
$cshow :: CommandLineHedgehogOptions -> String
show :: CommandLineHedgehogOptions -> String
$cshowList :: [CommandLineHedgehogOptions] -> ShowS
showList :: [CommandLineHedgehogOptions] -> ShowS
Show

-- * sandwich-slack options

data CommandLineSlackOptions = CommandLineSlackOptions {
  CommandLineSlackOptions -> Maybe String
optSlackToken :: Maybe String
  , CommandLineSlackOptions -> Maybe String
optSlackChannel :: Maybe String

  , CommandLineSlackOptions -> Maybe String
optSlackTopMessage :: Maybe String

  , CommandLineSlackOptions -> Maybe Int
optSlackMaxFailures :: Maybe Int
  , CommandLineSlackOptions -> Maybe Int
optSlackMaxFailureReasonLines :: Maybe Int
  , CommandLineSlackOptions -> Maybe Int
optSlackMaxCallStackLines :: Maybe Int

  , CommandLineSlackOptions -> Maybe Int
optSlackVisibilityThreshold :: Maybe Int

  , CommandLineSlackOptions -> Maybe Int64
optSlackMaxMessageSize :: Maybe Int64
  } deriving Int -> CommandLineSlackOptions -> ShowS
[CommandLineSlackOptions] -> ShowS
CommandLineSlackOptions -> String
(Int -> CommandLineSlackOptions -> ShowS)
-> (CommandLineSlackOptions -> String)
-> ([CommandLineSlackOptions] -> ShowS)
-> Show CommandLineSlackOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandLineSlackOptions -> ShowS
showsPrec :: Int -> CommandLineSlackOptions -> ShowS
$cshow :: CommandLineSlackOptions -> String
show :: CommandLineSlackOptions -> String
$cshowList :: [CommandLineSlackOptions] -> ShowS
showList :: [CommandLineSlackOptions] -> ShowS
Show

-- * sandwich-webdriver options

data BrowserToUse = UseChrome | UseFirefox
  deriving Int -> BrowserToUse -> ShowS
[BrowserToUse] -> ShowS
BrowserToUse -> String
(Int -> BrowserToUse -> ShowS)
-> (BrowserToUse -> String)
-> ([BrowserToUse] -> ShowS)
-> Show BrowserToUse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BrowserToUse -> ShowS
showsPrec :: Int -> BrowserToUse -> ShowS
$cshow :: BrowserToUse -> String
show :: BrowserToUse -> String
$cshowList :: [BrowserToUse] -> ShowS
showList :: [BrowserToUse] -> ShowS
Show

data CommandLineWebdriverOptions = CommandLineWebdriverOptions {
  CommandLineWebdriverOptions -> Maybe BrowserToUse
optFirefox :: Maybe BrowserToUse
  , CommandLineWebdriverOptions -> Maybe DisplayType
optDisplay :: Maybe DisplayType
  , CommandLineWebdriverOptions -> Bool
optFluxbox :: Bool
  , CommandLineWebdriverOptions -> Bool
optIndividualVideos :: Bool
  , CommandLineWebdriverOptions -> Bool
optErrorVideos :: Bool

  , CommandLineWebdriverOptions -> Maybe String
optSeleniumJar :: Maybe FilePath

  , CommandLineWebdriverOptions -> Maybe String
optChromeBinary :: Maybe FilePath
  , CommandLineWebdriverOptions -> Maybe String
optChromeDriver :: Maybe FilePath

  , CommandLineWebdriverOptions -> Maybe String
optFirefoxBinary :: Maybe FilePath
  , CommandLineWebdriverOptions -> Maybe String
optGeckoDriver :: Maybe FilePath
  } deriving Int -> CommandLineWebdriverOptions -> ShowS
[CommandLineWebdriverOptions] -> ShowS
CommandLineWebdriverOptions -> String
(Int -> CommandLineWebdriverOptions -> ShowS)
-> (CommandLineWebdriverOptions -> String)
-> ([CommandLineWebdriverOptions] -> ShowS)
-> Show CommandLineWebdriverOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandLineWebdriverOptions -> ShowS
showsPrec :: Int -> CommandLineWebdriverOptions -> ShowS
$cshow :: CommandLineWebdriverOptions -> String
show :: CommandLineWebdriverOptions -> String
$cshowList :: [CommandLineWebdriverOptions] -> ShowS
showList :: [CommandLineWebdriverOptions] -> ShowS
Show