{-# LANGUAGE CPP #-}
module Test.Hspec.Core.Config.Definition (
  Config(..)
, ColorMode(..)
, UnicodeMode(..)
, filterOr
, defaultConfig

, commandLineOnlyOptions
, formatterOptions
, smallCheckOptions
, quickCheckOptions
, runnerOptions

#ifdef TEST
, formatOrList
#endif
) where

import           Prelude ()
import           Test.Hspec.Core.Compat

import           Test.Hspec.Core.Example (Params(..), defaultParams)
import           Test.Hspec.Core.Format (Format, FormatConfig)
import qualified Test.Hspec.Core.Formatters.V1 as V1
import qualified Test.Hspec.Core.Formatters.V2 as V2
import           Test.Hspec.Core.Util

import           GetOpt.Declarative


data ColorMode = ColorAuto | ColorNever | ColorAlways
  deriving (ColorMode -> ColorMode -> Bool
(ColorMode -> ColorMode -> Bool)
-> (ColorMode -> ColorMode -> Bool) -> Eq ColorMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorMode -> ColorMode -> Bool
$c/= :: ColorMode -> ColorMode -> Bool
== :: ColorMode -> ColorMode -> Bool
$c== :: ColorMode -> ColorMode -> Bool
Eq, Int -> ColorMode -> ShowS
[ColorMode] -> ShowS
ColorMode -> String
(Int -> ColorMode -> ShowS)
-> (ColorMode -> String)
-> ([ColorMode] -> ShowS)
-> Show ColorMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorMode] -> ShowS
$cshowList :: [ColorMode] -> ShowS
show :: ColorMode -> String
$cshow :: ColorMode -> String
showsPrec :: Int -> ColorMode -> ShowS
$cshowsPrec :: Int -> ColorMode -> ShowS
Show)

data UnicodeMode = UnicodeAuto | UnicodeNever | UnicodeAlways
  deriving (UnicodeMode -> UnicodeMode -> Bool
(UnicodeMode -> UnicodeMode -> Bool)
-> (UnicodeMode -> UnicodeMode -> Bool) -> Eq UnicodeMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnicodeMode -> UnicodeMode -> Bool
$c/= :: UnicodeMode -> UnicodeMode -> Bool
== :: UnicodeMode -> UnicodeMode -> Bool
$c== :: UnicodeMode -> UnicodeMode -> Bool
Eq, Int -> UnicodeMode -> ShowS
[UnicodeMode] -> ShowS
UnicodeMode -> String
(Int -> UnicodeMode -> ShowS)
-> (UnicodeMode -> String)
-> ([UnicodeMode] -> ShowS)
-> Show UnicodeMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnicodeMode] -> ShowS
$cshowList :: [UnicodeMode] -> ShowS
show :: UnicodeMode -> String
$cshow :: UnicodeMode -> String
showsPrec :: Int -> UnicodeMode -> ShowS
$cshowsPrec :: Int -> UnicodeMode -> ShowS
Show)

data Config = Config {
  Config -> Bool
configIgnoreConfigFile :: Bool
, Config -> Bool
configDryRun :: Bool
, Config -> Bool
configFocusedOnly :: Bool
, Config -> Bool
configFailOnFocused :: Bool
, Config -> Maybe Int
configPrintSlowItems :: Maybe Int
, Config -> Bool
configPrintCpuTime :: Bool
, Config -> Bool
configFailFast :: Bool
, Config -> Bool
configRandomize :: Bool
, Config -> Maybe String
configFailureReport :: Maybe FilePath
, Config -> Bool
configRerun :: Bool
, Config -> Bool
configRerunAllOnSuccess :: Bool

-- |
-- A predicate that is used to filter the spec before it is run.  Only examples
-- that satisfy the predicate are run.
, Config -> Maybe (Path -> Bool)
configFilterPredicate :: Maybe (Path -> Bool)
, Config -> Maybe (Path -> Bool)
configSkipPredicate :: Maybe (Path -> Bool)
, Config -> Maybe Integer
configQuickCheckSeed :: Maybe Integer
, Config -> Maybe Int
configQuickCheckMaxSuccess :: Maybe Int
, Config -> Maybe Int
configQuickCheckMaxDiscardRatio :: Maybe Int
, Config -> Maybe Int
configQuickCheckMaxSize :: Maybe Int
, Config -> Maybe Int
configQuickCheckMaxShrinks :: Maybe Int
, Config -> Int
configSmallCheckDepth :: Int
, Config -> ColorMode
configColorMode :: ColorMode
, Config -> UnicodeMode
configUnicodeMode :: UnicodeMode
, Config -> Bool
configDiff :: Bool
, Config -> Bool
configPrettyPrint :: Bool
, Config -> Bool
configTimes :: Bool
, Config -> [(String, FormatConfig -> IO Format)]
configAvailableFormatters :: [(String, FormatConfig -> IO Format)]
, Config -> Maybe (FormatConfig -> IO Format)
configFormat :: Maybe (FormatConfig -> IO Format)
, Config -> Maybe Formatter
configFormatter :: Maybe V1.Formatter -- ^ deprecated, use `configFormat` instead
, Config -> Bool
configHtmlOutput :: Bool
, Config -> Maybe Int
configConcurrentJobs :: Maybe Int
}

defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Bool
-> Bool
-> Bool
-> Bool
-> Maybe Int
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Bool
-> Bool
-> Maybe (Path -> Bool)
-> Maybe (Path -> Bool)
-> Maybe Integer
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Int
-> ColorMode
-> UnicodeMode
-> Bool
-> Bool
-> Bool
-> [(String, FormatConfig -> IO Format)]
-> Maybe (FormatConfig -> IO Format)
-> Maybe Formatter
-> Bool
-> Maybe Int
-> Config
Config {
  configIgnoreConfigFile :: Bool
configIgnoreConfigFile = Bool
False
, configDryRun :: Bool
configDryRun = Bool
False
, configFocusedOnly :: Bool
configFocusedOnly = Bool
False
, configFailOnFocused :: Bool
configFailOnFocused = Bool
False
, configPrintSlowItems :: Maybe Int
configPrintSlowItems = Maybe Int
forall a. Maybe a
Nothing
, configPrintCpuTime :: Bool
configPrintCpuTime = Bool
False
, configFailFast :: Bool
configFailFast = Bool
False
, configRandomize :: Bool
configRandomize = Bool
False
, configFailureReport :: Maybe String
configFailureReport = Maybe String
forall a. Maybe a
Nothing
, configRerun :: Bool
configRerun = Bool
False
, configRerunAllOnSuccess :: Bool
configRerunAllOnSuccess = Bool
False
, configFilterPredicate :: Maybe (Path -> Bool)
configFilterPredicate = Maybe (Path -> Bool)
forall a. Maybe a
Nothing
, configSkipPredicate :: Maybe (Path -> Bool)
configSkipPredicate = Maybe (Path -> Bool)
forall a. Maybe a
Nothing
, configQuickCheckSeed :: Maybe Integer
configQuickCheckSeed = Maybe Integer
forall a. Maybe a
Nothing
, configQuickCheckMaxSuccess :: Maybe Int
configQuickCheckMaxSuccess = Maybe Int
forall a. Maybe a
Nothing
, configQuickCheckMaxDiscardRatio :: Maybe Int
configQuickCheckMaxDiscardRatio = Maybe Int
forall a. Maybe a
Nothing
, configQuickCheckMaxSize :: Maybe Int
configQuickCheckMaxSize = Maybe Int
forall a. Maybe a
Nothing
, configQuickCheckMaxShrinks :: Maybe Int
configQuickCheckMaxShrinks = Maybe Int
forall a. Maybe a
Nothing
, configSmallCheckDepth :: Int
configSmallCheckDepth = Params -> Int
paramsSmallCheckDepth Params
defaultParams
, configColorMode :: ColorMode
configColorMode = ColorMode
ColorAuto
, configUnicodeMode :: UnicodeMode
configUnicodeMode = UnicodeMode
UnicodeAuto
, configDiff :: Bool
configDiff = Bool
True
, configPrettyPrint :: Bool
configPrettyPrint = Bool
True
, configTimes :: Bool
configTimes = Bool
False
, configAvailableFormatters :: [(String, FormatConfig -> IO Format)]
configAvailableFormatters = ((String, Formatter) -> (String, FormatConfig -> IO Format))
-> [(String, Formatter)] -> [(String, FormatConfig -> IO Format)]
forall a b. (a -> b) -> [a] -> [b]
map ((Formatter -> FormatConfig -> IO Format)
-> (String, Formatter) -> (String, FormatConfig -> IO Format)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Formatter -> FormatConfig -> IO Format
V2.formatterToFormat) [
    (String
"checks", Formatter
V2.checks)
  , (String
"specdoc", Formatter
V2.specdoc)
  , (String
"progress", Formatter
V2.progress)
  , (String
"failed-examples", Formatter
V2.failed_examples)
  , (String
"silent", Formatter
V2.silent)
  ]
, configFormat :: Maybe (FormatConfig -> IO Format)
configFormat = Maybe (FormatConfig -> IO Format)
forall a. Maybe a
Nothing
, configFormatter :: Maybe Formatter
configFormatter = Maybe Formatter
forall a. Maybe a
Nothing
, configHtmlOutput :: Bool
configHtmlOutput = Bool
False
, configConcurrentJobs :: Maybe Int
configConcurrentJobs = Maybe Int
forall a. Maybe a
Nothing
}

option :: String -> OptionSetter config -> String -> Option config
option :: String -> OptionSetter config -> String -> Option config
option String
name OptionSetter config
arg String
help = String
-> Maybe Char
-> OptionSetter config
-> String
-> Bool
-> Option config
forall config.
String
-> Maybe Char
-> OptionSetter config
-> String
-> Bool
-> Option config
Option String
name Maybe Char
forall a. Maybe a
Nothing OptionSetter config
arg String
help Bool
True

mkFlag :: String -> (Bool -> Config -> Config) -> String -> Option Config
mkFlag :: String -> (Bool -> Config -> Config) -> String -> Option Config
mkFlag String
name Bool -> Config -> Config
setter = String -> OptionSetter Config -> String -> Option Config
forall config.
String -> OptionSetter config -> String -> Option config
option String
name ((Bool -> Config -> Config) -> OptionSetter Config
forall config. (Bool -> config -> config) -> OptionSetter config
Flag Bool -> Config -> Config
setter)

mkOptionNoArg :: String -> Maybe Char -> (Config -> Config) -> String -> Option Config
mkOptionNoArg :: String
-> Maybe Char -> (Config -> Config) -> String -> Option Config
mkOptionNoArg String
name Maybe Char
shortcut Config -> Config
setter String
help = String
-> Maybe Char
-> OptionSetter Config
-> String
-> Bool
-> Option Config
forall config.
String
-> Maybe Char
-> OptionSetter config
-> String
-> Bool
-> Option config
Option String
name Maybe Char
shortcut ((Config -> Config) -> OptionSetter Config
forall config. (config -> config) -> OptionSetter config
NoArg Config -> Config
setter) String
help Bool
True

mkOption :: String -> Maybe Char -> OptionSetter Config -> String -> Option Config
mkOption :: String
-> Maybe Char -> OptionSetter Config -> String -> Option Config
mkOption String
name Maybe Char
shortcut OptionSetter Config
arg String
help = String
-> Maybe Char
-> OptionSetter Config
-> String
-> Bool
-> Option Config
forall config.
String
-> Maybe Char
-> OptionSetter config
-> String
-> Bool
-> Option config
Option String
name Maybe Char
shortcut OptionSetter Config
arg String
help Bool
True

undocumented :: Option config -> Option config
undocumented :: Option config -> Option config
undocumented Option config
opt = Option config
opt {optionDocumented :: Bool
optionDocumented = Bool
False}

argument :: String -> (String -> Maybe a) -> (a -> Config -> Config) -> OptionSetter Config
argument :: String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
name String -> Maybe a
parser a -> Config -> Config
setter = String -> (String -> Config -> Maybe Config) -> OptionSetter Config
forall config.
String -> (String -> config -> Maybe config) -> OptionSetter config
Arg String
name ((String -> Config -> Maybe Config) -> OptionSetter Config)
-> (String -> Config -> Maybe Config) -> OptionSetter Config
forall a b. (a -> b) -> a -> b
$ \ String
input Config
c -> (a -> Config -> Config) -> Config -> a -> Config
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Config -> Config
setter Config
c (a -> Config) -> Maybe a -> Maybe Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe a
parser String
input

formatterOptions :: [(String, FormatConfig -> IO Format)] -> [Option Config]
formatterOptions :: [(String, FormatConfig -> IO Format)] -> [Option Config]
formatterOptions [(String, FormatConfig -> IO Format)]
formatters = [
    String
-> Maybe Char -> OptionSetter Config -> String -> Option Config
mkOption String
"format" (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'f') (String
-> (String -> Maybe (FormatConfig -> IO Format))
-> ((FormatConfig -> IO Format) -> Config -> Config)
-> OptionSetter Config
forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"FORMATTER" String -> Maybe (FormatConfig -> IO Format)
readFormatter (FormatConfig -> IO Format) -> Config -> Config
setFormatter) String
helpForFormat
  , String -> (Bool -> Config -> Config) -> String -> Option Config
mkFlag String
"color" Bool -> Config -> Config
setColor String
"colorize the output"
  , String -> (Bool -> Config -> Config) -> String -> Option Config
mkFlag String
"unicode" Bool -> Config -> Config
setUnicode String
"output unicode"
  , String -> (Bool -> Config -> Config) -> String -> Option Config
mkFlag String
"diff" Bool -> Config -> Config
setDiff String
"show colorized diffs"
  , String -> (Bool -> Config -> Config) -> String -> Option Config
mkFlag String
"pretty" Bool -> Config -> Config
setPretty String
"try to pretty-print diff values"
  , String -> (Bool -> Config -> Config) -> String -> Option Config
mkFlag String
"times" Bool -> Config -> Config
setTimes String
"report times for individual spec items"
  , String
-> Maybe Char -> (Config -> Config) -> String -> Option Config
mkOptionNoArg String
"print-cpu-time" Maybe Char
forall a. Maybe a
Nothing Config -> Config
setPrintCpuTime String
"include used CPU time in summary"
  , Option Config
printSlowItemsOption

    -- undocumented for now, as we probably want to change this to produce a
    -- standalone HTML report in the future
  , Option Config -> Option Config
forall config. Option config -> Option config
undocumented (Option Config -> Option Config) -> Option Config -> Option Config
forall a b. (a -> b) -> a -> b
$ String
-> Maybe Char -> (Config -> Config) -> String -> Option Config
mkOptionNoArg String
"html" Maybe Char
forall a. Maybe a
Nothing Config -> Config
setHtml String
"produce HTML output"
  ]
  where
    setHtml :: Config -> Config
setHtml Config
config = Config
config {configHtmlOutput :: Bool
configHtmlOutput = Bool
True}

    helpForFormat :: String
    helpForFormat :: String
helpForFormat = String
"use a custom formatter; this can be one of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> String
formatOrList ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, FormatConfig -> IO Format) -> String)
-> [(String, FormatConfig -> IO Format)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, FormatConfig -> IO Format) -> String
forall a b. (a, b) -> a
fst [(String, FormatConfig -> IO Format)]
formatters)

    readFormatter :: String -> Maybe (FormatConfig -> IO Format)
    readFormatter :: String -> Maybe (FormatConfig -> IO Format)
readFormatter = (String
-> [(String, FormatConfig -> IO Format)]
-> Maybe (FormatConfig -> IO Format)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String, FormatConfig -> IO Format)]
formatters)

    setFormatter :: (FormatConfig -> IO Format) -> Config -> Config
    setFormatter :: (FormatConfig -> IO Format) -> Config -> Config
setFormatter FormatConfig -> IO Format
f Config
c = Config
c {configFormat :: Maybe (FormatConfig -> IO Format)
configFormat = (FormatConfig -> IO Format) -> Maybe (FormatConfig -> IO Format)
forall a. a -> Maybe a
Just FormatConfig -> IO Format
f}

    setColor :: Bool -> Config -> Config
    setColor :: Bool -> Config -> Config
setColor Bool
v Config
config = Config
config {configColorMode :: ColorMode
configColorMode = if Bool
v then ColorMode
ColorAlways else ColorMode
ColorNever}

    setUnicode :: Bool -> Config -> Config
    setUnicode :: Bool -> Config -> Config
setUnicode Bool
v Config
config = Config
config {configUnicodeMode :: UnicodeMode
configUnicodeMode = if Bool
v then UnicodeMode
UnicodeAlways else UnicodeMode
UnicodeNever}

    setDiff :: Bool -> Config -> Config
    setDiff :: Bool -> Config -> Config
setDiff Bool
v Config
config = Config
config {configDiff :: Bool
configDiff = Bool
v}

    setPretty :: Bool -> Config -> Config
    setPretty :: Bool -> Config -> Config
setPretty Bool
v Config
config = Config
config {configPrettyPrint :: Bool
configPrettyPrint = Bool
v}

    setTimes :: Bool -> Config -> Config
    setTimes :: Bool -> Config -> Config
setTimes Bool
v Config
config = Config
config {configTimes :: Bool
configTimes = Bool
v}

    setPrintCpuTime :: Config -> Config
setPrintCpuTime Config
config = Config
config {configPrintCpuTime :: Bool
configPrintCpuTime = Bool
True}

printSlowItemsOption :: Option Config
printSlowItemsOption :: Option Config
printSlowItemsOption = String
-> Maybe Char
-> OptionSetter Config
-> String
-> Bool
-> Option Config
forall config.
String
-> Maybe Char
-> OptionSetter config
-> String
-> Bool
-> Option config
Option String
name (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'p') (String
-> (Maybe String -> Config -> Maybe Config) -> OptionSetter Config
forall config.
String
-> (Maybe String -> config -> Maybe config) -> OptionSetter config
OptArg String
"N" Maybe String -> Config -> Maybe Config
arg) String
"print the N slowest spec items (default: 10)" Bool
True
  where
    name :: String
name = String
"print-slow-items"

    setter :: Maybe Int -> Config -> Config
    setter :: Maybe Int -> Config -> Config
setter Maybe Int
v Config
c = Config
c {configPrintSlowItems :: Maybe Int
configPrintSlowItems = Maybe Int
v}

    arg :: Maybe String -> Config -> Maybe Config
    arg :: Maybe String -> Config -> Maybe Config
arg = (Config -> Maybe Config)
-> (String -> Config -> Maybe Config)
-> Maybe String
-> Config
-> Maybe Config
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Config -> Maybe Config
forall a. a -> Maybe a
Just (Config -> Maybe Config)
-> (Config -> Config) -> Config -> Maybe Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> Config -> Config
setter (Maybe Int -> Config -> Config) -> Maybe Int -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10)) String -> Config -> Maybe Config
parseArg

    parseArg :: String -> Config -> Maybe Config
    parseArg :: String -> Config -> Maybe Config
parseArg String
input Config
c = case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
input of
      Just Int
0 -> Config -> Maybe Config
forall a. a -> Maybe a
Just (Maybe Int -> Config -> Config
setter Maybe Int
forall a. Maybe a
Nothing Config
c)
      Just Int
n -> Config -> Maybe Config
forall a. a -> Maybe a
Just (Maybe Int -> Config -> Config
setter (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) Config
c)
      Maybe Int
Nothing -> Maybe Config
forall a. Maybe a
Nothing

smallCheckOptions :: [Option Config]
smallCheckOptions :: [Option Config]
smallCheckOptions = [
    String -> OptionSetter Config -> String -> Option Config
forall config.
String -> OptionSetter config -> String -> Option config
option String
"depth" (String
-> (String -> Maybe Int)
-> (Int -> Config -> Config)
-> OptionSetter Config
forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"N" String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Int -> Config -> Config
setDepth) String
"maximum depth of generated test values for SmallCheck properties"
  ]

setDepth :: Int -> Config -> Config
setDepth :: Int -> Config -> Config
setDepth Int
n Config
c = Config
c {configSmallCheckDepth :: Int
configSmallCheckDepth = Int
n}

quickCheckOptions :: [Option Config]
quickCheckOptions :: [Option Config]
quickCheckOptions = [
    String
-> Maybe Char
-> OptionSetter Config
-> String
-> Bool
-> Option Config
forall config.
String
-> Maybe Char
-> OptionSetter config
-> String
-> Bool
-> Option config
Option String
"qc-max-success" (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'a') (String
-> (String -> Maybe Int)
-> (Int -> Config -> Config)
-> OptionSetter Config
forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"N" String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Int -> Config -> Config
setMaxSuccess) String
"maximum number of successful tests before a QuickCheck property succeeds" Bool
True
  , String -> OptionSetter Config -> String -> Option Config
forall config.
String -> OptionSetter config -> String -> Option config
option String
"qc-max-discard" (String
-> (String -> Maybe Int)
-> (Int -> Config -> Config)
-> OptionSetter Config
forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"N" String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Int -> Config -> Config
setMaxDiscardRatio) String
"maximum number of discarded tests per successful test before giving up"
  , String -> OptionSetter Config -> String -> Option Config
forall config.
String -> OptionSetter config -> String -> Option config
option String
"qc-max-size" (String
-> (String -> Maybe Int)
-> (Int -> Config -> Config)
-> OptionSetter Config
forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"N" String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Int -> Config -> Config
setMaxSize) String
"size to use for the biggest test cases"
  , String -> OptionSetter Config -> String -> Option Config
forall config.
String -> OptionSetter config -> String -> Option config
option String
"qc-max-shrinks" (String
-> (String -> Maybe Int)
-> (Int -> Config -> Config)
-> OptionSetter Config
forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"N" String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Int -> Config -> Config
setMaxShrinks) String
"maximum number of shrinks to perform before giving up (a value of 0 turns shrinking off)"
  , String -> OptionSetter Config -> String -> Option Config
forall config.
String -> OptionSetter config -> String -> Option config
option String
"seed" (String
-> (String -> Maybe Integer)
-> (Integer -> Config -> Config)
-> OptionSetter Config
forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"N" String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe Integer -> Config -> Config
setSeed) String
"used seed for QuickCheck properties"

    -- for compatibility with test-framework
  , Option Config -> Option Config
forall config. Option config -> Option config
undocumented (Option Config -> Option Config) -> Option Config -> Option Config
forall a b. (a -> b) -> a -> b
$ String -> OptionSetter Config -> String -> Option Config
forall config.
String -> OptionSetter config -> String -> Option config
option String
"maximum-generated-tests" (String
-> (String -> Maybe Int)
-> (Int -> Config -> Config)
-> OptionSetter Config
forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"NUMBER" String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe Int -> Config -> Config
setMaxSuccess) String
"how many automated tests something like QuickCheck should try, by default"
  ]

setMaxSuccess :: Int -> Config -> Config
setMaxSuccess :: Int -> Config -> Config
setMaxSuccess Int
n Config
c = Config
c {configQuickCheckMaxSuccess :: Maybe Int
configQuickCheckMaxSuccess = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n}

setMaxDiscardRatio :: Int -> Config -> Config
setMaxDiscardRatio :: Int -> Config -> Config
setMaxDiscardRatio Int
n Config
c = Config
c {configQuickCheckMaxDiscardRatio :: Maybe Int
configQuickCheckMaxDiscardRatio = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n}

setMaxSize :: Int -> Config -> Config
setMaxSize :: Int -> Config -> Config
setMaxSize Int
n Config
c = Config
c {configQuickCheckMaxSize :: Maybe Int
configQuickCheckMaxSize = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n}

setMaxShrinks :: Int -> Config -> Config
setMaxShrinks :: Int -> Config -> Config
setMaxShrinks Int
n Config
c = Config
c {configQuickCheckMaxShrinks :: Maybe Int
configQuickCheckMaxShrinks = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n}

setSeed :: Integer -> Config -> Config
setSeed :: Integer -> Config -> Config
setSeed Integer
n Config
c = Config
c {configQuickCheckSeed :: Maybe Integer
configQuickCheckSeed = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
n}

runnerOptions :: [Option Config]
runnerOptions :: [Option Config]
runnerOptions = [
    String -> (Bool -> Config -> Config) -> String -> Option Config
mkFlag String
"dry-run" Bool -> Config -> Config
setDryRun String
"pretend that everything passed; don't verify anything"
  , String -> (Bool -> Config -> Config) -> String -> Option Config
mkFlag String
"focused-only" Bool -> Config -> Config
setFocusedOnly String
"do not run anything, unless there are focused spec items"
  , String -> (Bool -> Config -> Config) -> String -> Option Config
mkFlag String
"fail-on-focused" Bool -> Config -> Config
setFailOnFocused String
"fail on focused spec items"
  , String -> (Bool -> Config -> Config) -> String -> Option Config
mkFlag String
"fail-fast" Bool -> Config -> Config
setFailFast String
"abort on first failure"
  , String -> (Bool -> Config -> Config) -> String -> Option Config
mkFlag String
"randomize" Bool -> Config -> Config
setRandomize String
"randomize execution order"
  , String
-> Maybe Char -> (Config -> Config) -> String -> Option Config
mkOptionNoArg String
"rerun" (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'r') Config -> Config
setRerun String
"rerun all examples that failed in the previous test run (only works in combination with --failure-report or in GHCi)"
  , String -> OptionSetter Config -> String -> Option Config
forall config.
String -> OptionSetter config -> String -> Option config
option String
"failure-report" (String
-> (String -> Maybe String)
-> (String -> Config -> Config)
-> OptionSetter Config
forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"FILE" String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String -> Config -> Config
setFailureReport) String
"read/write a failure report for use with --rerun"
  , String
-> Maybe Char -> (Config -> Config) -> String -> Option Config
mkOptionNoArg String
"rerun-all-on-success" Maybe Char
forall a. Maybe a
Nothing Config -> Config
setRerunAllOnSuccess String
"run the whole test suite after a previously failing rerun succeeds for the first time (only works in combination with --rerun)"
  , String
-> Maybe Char -> OptionSetter Config -> String -> Option Config
mkOption String
"jobs" (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'j') (String
-> (String -> Maybe Int)
-> (Int -> Config -> Config)
-> OptionSetter Config
forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"N" String -> Maybe Int
readMaxJobs Int -> Config -> Config
setMaxJobs) String
"run at most N parallelizable tests simultaneously (default: number of available processors)"
  ]
  where
    readMaxJobs :: String -> Maybe Int
    readMaxJobs :: String -> Maybe Int
readMaxJobs String
s = do
      Int
n <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
s
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n

    setFailureReport :: String -> Config -> Config
    setFailureReport :: String -> Config -> Config
setFailureReport String
file Config
c = Config
c {configFailureReport :: Maybe String
configFailureReport = String -> Maybe String
forall a. a -> Maybe a
Just String
file}

    setMaxJobs :: Int -> Config -> Config
    setMaxJobs :: Int -> Config -> Config
setMaxJobs Int
n Config
c = Config
c {configConcurrentJobs :: Maybe Int
configConcurrentJobs = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n}

    setDryRun :: Bool -> Config -> Config
    setDryRun :: Bool -> Config -> Config
setDryRun Bool
value Config
config = Config
config {configDryRun :: Bool
configDryRun = Bool
value}

    setFocusedOnly :: Bool -> Config -> Config
    setFocusedOnly :: Bool -> Config -> Config
setFocusedOnly Bool
value Config
config = Config
config {configFocusedOnly :: Bool
configFocusedOnly = Bool
value}

    setFailOnFocused :: Bool -> Config -> Config
    setFailOnFocused :: Bool -> Config -> Config
setFailOnFocused Bool
value Config
config = Config
config {configFailOnFocused :: Bool
configFailOnFocused = Bool
value}

    setFailFast :: Bool -> Config -> Config
    setFailFast :: Bool -> Config -> Config
setFailFast Bool
value Config
config = Config
config {configFailFast :: Bool
configFailFast = Bool
value}

    setRandomize :: Bool -> Config -> Config
    setRandomize :: Bool -> Config -> Config
setRandomize Bool
value Config
config = Config
config {configRandomize :: Bool
configRandomize = Bool
value}

    setRerun :: Config -> Config
setRerun Config
config = Config
config {configRerun :: Bool
configRerun = Bool
True}
    setRerunAllOnSuccess :: Config -> Config
setRerunAllOnSuccess Config
config = Config
config {configRerunAllOnSuccess :: Bool
configRerunAllOnSuccess = Bool
True}

commandLineOnlyOptions :: [Option Config]
commandLineOnlyOptions :: [Option Config]
commandLineOnlyOptions = [
    String
-> Maybe Char -> (Config -> Config) -> String -> Option Config
mkOptionNoArg String
"ignore-dot-hspec" Maybe Char
forall a. Maybe a
Nothing Config -> Config
setIgnoreConfigFile String
"do not read options from ~/.hspec and .hspec"
  , String
-> Maybe Char -> OptionSetter Config -> String -> Option Config
mkOption String
"match" (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'm') (String
-> (String -> Maybe String)
-> (String -> Config -> Config)
-> OptionSetter Config
forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"PATTERN" String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String -> Config -> Config
addMatch) String
"only run examples that match given PATTERN"
  , String -> OptionSetter Config -> String -> Option Config
forall config.
String -> OptionSetter config -> String -> Option config
option String
"skip" (String
-> (String -> Maybe String)
-> (String -> Config -> Config)
-> OptionSetter Config
forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"PATTERN" String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String -> Config -> Config
addSkip) String
"skip examples that match given PATTERN"
  ]
  where
    setIgnoreConfigFile :: Config -> Config
setIgnoreConfigFile Config
config = Config
config {configIgnoreConfigFile :: Bool
configIgnoreConfigFile = Bool
True}

addMatch :: String -> Config -> Config
addMatch :: String -> Config -> Config
addMatch String
s Config
c = Config
c {configFilterPredicate :: Maybe (Path -> Bool)
configFilterPredicate = (Path -> Bool) -> Maybe (Path -> Bool)
forall a. a -> Maybe a
Just (String -> Path -> Bool
filterPredicate String
s) Maybe (Path -> Bool)
-> Maybe (Path -> Bool) -> Maybe (Path -> Bool)
`filterOr` Config -> Maybe (Path -> Bool)
configFilterPredicate Config
c}

addSkip :: String -> Config -> Config
addSkip :: String -> Config -> Config
addSkip String
s Config
c = Config
c {configSkipPredicate :: Maybe (Path -> Bool)
configSkipPredicate = (Path -> Bool) -> Maybe (Path -> Bool)
forall a. a -> Maybe a
Just (String -> Path -> Bool
filterPredicate String
s) Maybe (Path -> Bool)
-> Maybe (Path -> Bool) -> Maybe (Path -> Bool)
`filterOr` Config -> Maybe (Path -> Bool)
configSkipPredicate Config
c}

filterOr :: Maybe (Path -> Bool) -> Maybe (Path -> Bool) -> Maybe (Path -> Bool)
filterOr :: Maybe (Path -> Bool)
-> Maybe (Path -> Bool) -> Maybe (Path -> Bool)
filterOr Maybe (Path -> Bool)
p1_ Maybe (Path -> Bool)
p2_ = case (Maybe (Path -> Bool)
p1_, Maybe (Path -> Bool)
p2_) of
  (Just Path -> Bool
p1, Just Path -> Bool
p2) -> (Path -> Bool) -> Maybe (Path -> Bool)
forall a. a -> Maybe a
Just ((Path -> Bool) -> Maybe (Path -> Bool))
-> (Path -> Bool) -> Maybe (Path -> Bool)
forall a b. (a -> b) -> a -> b
$ \Path
path -> Path -> Bool
p1 Path
path Bool -> Bool -> Bool
|| Path -> Bool
p2 Path
path
  (Maybe (Path -> Bool), Maybe (Path -> Bool))
_ -> Maybe (Path -> Bool)
p1_ Maybe (Path -> Bool)
-> Maybe (Path -> Bool) -> Maybe (Path -> Bool)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Path -> Bool)
p2_

formatOrList :: [String] -> String
formatOrList :: [String] -> String
formatOrList [String]
xs = case [String]
xs of
  [] -> String
""
  String
x : [String]
ys -> (case [String]
ys of
    [] -> String
x
    String
_ : [] -> String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" or "
    String
_ : String
_ : [String]
_ -> String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", ") String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
formatOrList [String]
ys