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

, commandLineOnlyOptions
, formatterOptions
, smallCheckOptions
, quickCheckOptions
, runnerOptions

#ifdef TEST
, splitOn
#endif
) where

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

import           System.Directory (getTemporaryDirectory, removeFile)
import           System.IO (openTempFile, hClose)
import           System.Process (system)

import           Test.Hspec.Core.Example (Params(..), defaultParams)
import           Test.Hspec.Core.Format (Format, FormatConfig)
import           Test.Hspec.Core.Formatters.Pretty (pretty2)
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
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
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
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
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
configFailOnEmpty :: Bool
, Config -> Bool
configFailOnFocused :: Bool
, Config -> Bool
configFailOnPending :: 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 -> Maybe Int
configSmallCheckDepth :: Maybe Int
, Config -> ColorMode
configColorMode :: ColorMode
, Config -> UnicodeMode
configUnicodeMode :: UnicodeMode
, Config -> Bool
configDiff :: Bool
, Config -> Maybe Int
configDiffContext :: Maybe Int

-- |
-- An action that is used to print diffs.  The first argument is the value of
-- `configDiffContext`.  The remaining two arguments are the @expected@ and
-- @actual@ value.
--
-- @since 2.10.6
, Config -> Maybe (Maybe Int -> String -> String -> IO ())
configExternalDiff :: Maybe (Maybe Int -> String -> String -> IO ())

, Config -> Bool
configPrettyPrint :: Bool
, Config -> Bool -> String -> String -> (String, String)
configPrettyPrintFunction :: Bool -> String -> String -> (String, String)
, 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 {
  configIgnoreConfigFile :: Bool
configIgnoreConfigFile = Bool
False
, configDryRun :: Bool
configDryRun = Bool
False
, configFocusedOnly :: Bool
configFocusedOnly = Bool
False
, configFailOnEmpty :: Bool
configFailOnEmpty = Bool
False
, configFailOnFocused :: Bool
configFailOnFocused = Bool
False
, configFailOnPending :: Bool
configFailOnPending = Bool
False
, configPrintSlowItems :: Maybe Int
configPrintSlowItems = forall a. Maybe a
Nothing
, configPrintCpuTime :: Bool
configPrintCpuTime = Bool
False
, configFailFast :: Bool
configFailFast = Bool
False
, configRandomize :: Bool
configRandomize = Bool
False
, configFailureReport :: Maybe String
configFailureReport = forall a. Maybe a
Nothing
, configRerun :: Bool
configRerun = Bool
False
, configRerunAllOnSuccess :: Bool
configRerunAllOnSuccess = Bool
False
, configFilterPredicate :: Maybe (Path -> Bool)
configFilterPredicate = forall a. Maybe a
Nothing
, configSkipPredicate :: Maybe (Path -> Bool)
configSkipPredicate = forall a. Maybe a
Nothing
, configQuickCheckSeed :: Maybe Integer
configQuickCheckSeed = forall a. Maybe a
Nothing
, configQuickCheckMaxSuccess :: Maybe Int
configQuickCheckMaxSuccess = forall a. Maybe a
Nothing
, configQuickCheckMaxDiscardRatio :: Maybe Int
configQuickCheckMaxDiscardRatio = forall a. Maybe a
Nothing
, configQuickCheckMaxSize :: Maybe Int
configQuickCheckMaxSize = forall a. Maybe a
Nothing
, configQuickCheckMaxShrinks :: Maybe Int
configQuickCheckMaxShrinks = forall a. Maybe a
Nothing
, configSmallCheckDepth :: Maybe Int
configSmallCheckDepth = Params -> Maybe Int
paramsSmallCheckDepth Params
defaultParams
, configColorMode :: ColorMode
configColorMode = ColorMode
ColorAuto
, configUnicodeMode :: UnicodeMode
configUnicodeMode = UnicodeMode
UnicodeAuto
, configDiff :: Bool
configDiff = Bool
True
, configDiffContext :: Maybe Int
configDiffContext = forall a. a -> Maybe a
Just Int
defaultDiffContext
, configExternalDiff :: Maybe (Maybe Int -> String -> String -> IO ())
configExternalDiff = forall a. Maybe a
Nothing
, configPrettyPrint :: Bool
configPrettyPrint = Bool
True
, configPrettyPrintFunction :: Bool -> String -> String -> (String, String)
configPrettyPrintFunction = Bool -> String -> String -> (String, String)
pretty2
, configTimes :: Bool
configTimes = Bool
False
, configAvailableFormatters :: [(String, FormatConfig -> IO Format)]
configAvailableFormatters = forall a b. (a -> b) -> [a] -> [b]
map (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 = forall a. Maybe a
Nothing
, configFormatter :: Maybe Formatter
configFormatter = forall a. Maybe a
Nothing
, configHtmlOutput :: Bool
configHtmlOutput = Bool
False
, configConcurrentJobs :: Maybe Int
configConcurrentJobs = forall a. Maybe a
Nothing
}

defaultDiffContext :: Int
defaultDiffContext :: Int
defaultDiffContext = Int
3

externalDiff :: String -> String -> String -> IO ()
externalDiff :: String -> String -> String -> IO ()
externalDiff String
command String
expected String
actual = do
  String
tmp <- IO String
getTemporaryDirectory
  forall a. String -> String -> String -> (String -> IO a) -> IO a
withTempFile String
tmp String
"hspec-expected" String
expected forall a b. (a -> b) -> a -> b
$ \ String
expectedFile -> do
    forall a. String -> String -> String -> (String -> IO a) -> IO a
withTempFile String
tmp String
"hspec-actual" String
actual forall a b. (a -> b) -> a -> b
$ \ String
actualFile -> do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ExitCode
system forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
command, String
expectedFile, String
actualFile]

withTempFile :: FilePath -> FilePath -> String -> (FilePath -> IO a) -> IO a
withTempFile :: forall a. String -> String -> String -> (String -> IO a) -> IO a
withTempFile String
dir String
file String
contents String -> IO a
action = do
  forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> String -> IO (String, Handle)
openTempFile String
dir String
file) (String -> IO ()
removeFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ \ (String
path, Handle
h) -> do
    Handle -> IO ()
hClose Handle
h
    String -> String -> IO ()
writeFile String
path String
contents
    String -> IO a
action String
path

option :: String -> OptionSetter config -> String -> Option config
option :: forall config.
String -> OptionSetter config -> String -> Option config
option String
name OptionSetter config
arg String
help = forall config.
String
-> Maybe Char
-> OptionSetter config
-> String
-> Bool
-> Option config
Option String
name 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 = forall config.
String -> OptionSetter config -> String -> Option config
option String
name (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 = forall config.
String
-> Maybe Char
-> OptionSetter config
-> String
-> Bool
-> Option config
Option String
name Maybe Char
shortcut (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 = 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 :: forall config. 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 :: forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
name String -> Maybe a
parser a -> Config -> Config
setter = forall config.
String -> (String -> config -> Maybe config) -> OptionSetter config
Arg String
name forall a b. (a -> b) -> a -> b
$ \ String
input Config
c -> forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Config -> Config
setter Config
c 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" (forall a. a -> Maybe a
Just Char
'f') (forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"NAME" 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"
  , forall config.
String -> OptionSetter config -> String -> Option config
option String
"diff-context" (forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"N" String -> Maybe (Maybe Int)
readDiffContext Maybe Int -> Config -> Config
setDiffContext) forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
        String
"output N lines of diff context (default: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
defaultDiffContext forall a. Semigroup a => a -> a -> a
<> String
")"
      , String
"use a value of 'full' to see the full context"
      ]
  , forall config.
String -> OptionSetter config -> String -> Option config
option String
"diff-command" (forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"CMD" forall (m :: * -> *) a. Monad m => a -> m a
return String -> Config -> Config
setDiffCommand) String
"use an external diff command\nexample: --diff-command=\"git diff\""
  , 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" 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
  , forall config. Option config -> Option config
undocumented forall a b. (a -> b) -> a -> b
$ String
-> Maybe Char -> (Config -> Config) -> String -> Option Config
mkOptionNoArg String
"html" forall a. Maybe a
Nothing Config -> Config
setHtml String
"produce HTML output"
  ]
  where
    setDiffCommand :: String -> Config -> Config
    setDiffCommand :: String -> Config -> Config
setDiffCommand String
command Config
config = Config
config {
      configExternalDiff :: Maybe (Maybe Int -> String -> String -> IO ())
configExternalDiff = case ShowS
strip String
command of
        String
"" -> forall a. Maybe a
Nothing
        String
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \ Maybe Int
_context -> String -> String -> String -> IO ()
externalDiff String
command
    }

    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 " forall a. [a] -> [a] -> [a]
++ ([String] -> String
formatOrList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 = (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 = 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}

    readDiffContext :: String -> Maybe (Maybe Int)
    readDiffContext :: String -> Maybe (Maybe Int)
readDiffContext String
input = case String
input of
      String
"full" -> forall a. a -> Maybe a
Just forall a. Maybe a
Nothing
      String
_ -> case forall a. Read a => String -> Maybe a
readMaybe String
input of
        Maybe Int
Nothing -> forall a. Maybe a
Nothing
        Maybe Int
mn -> forall a. a -> Maybe a
Just (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. Ord a => a -> a -> Bool
>= Int
0) Maybe Int
mn)

    setDiffContext :: Maybe Int -> Config -> Config
    setDiffContext :: Maybe Int -> Config -> Config
setDiffContext Maybe Int
value Config
c = Config
c { configDiffContext :: Maybe Int
configDiffContext = Maybe Int
value }

    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 = forall config.
String
-> Maybe Char
-> OptionSetter config
-> String
-> Bool
-> Option config
Option String
name (forall a. a -> Maybe a
Just Char
'p') (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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> Config -> Config
setter forall a b. (a -> b) -> a -> b
$ 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 forall a. Read a => String -> Maybe a
readMaybe String
input of
      Maybe Int
Nothing -> forall a. Maybe a
Nothing
      Maybe Int
mn -> forall a. a -> Maybe a
Just (Maybe Int -> Config -> Config
setter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. Ord a => a -> a -> Bool
> Int
0) Maybe Int
mn) Config
c)

smallCheckOptions :: [Option Config]
smallCheckOptions :: [Option Config]
smallCheckOptions = [
    forall config.
String -> OptionSetter config -> String -> Option config
option String
"depth" (forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"N" 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 :: Maybe Int
configSmallCheckDepth = forall a. a -> Maybe a
Just Int
n}

quickCheckOptions :: [Option Config]
quickCheckOptions :: [Option Config]
quickCheckOptions = [
    forall config.
String
-> Maybe Char
-> OptionSetter config
-> String
-> Bool
-> Option config
Option String
"qc-max-success" (forall a. a -> Maybe a
Just Char
'a') (forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"N" 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
  , forall config.
String -> OptionSetter config -> String -> Option config
option String
"qc-max-discard" (forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"N" forall a. Read a => String -> Maybe a
readMaybe Int -> Config -> Config
setMaxDiscardRatio) String
"maximum number of discarded tests per successful test before giving up"
  , forall config.
String -> OptionSetter config -> String -> Option config
option String
"qc-max-size" (forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"N" forall a. Read a => String -> Maybe a
readMaybe Int -> Config -> Config
setMaxSize) String
"size to use for the biggest test cases"
  , forall config.
String -> OptionSetter config -> String -> Option config
option String
"qc-max-shrinks" (forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"N" 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)"
  , forall config.
String -> OptionSetter config -> String -> Option config
option String
"seed" (forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"N" forall a. Read a => String -> Maybe a
readMaybe Integer -> Config -> Config
setSeed) String
"used seed for QuickCheck properties"

    -- for compatibility with test-framework
  , forall config. Option config -> Option config
undocumented forall a b. (a -> b) -> a -> b
$ forall config.
String -> OptionSetter config -> String -> Option config
option String
"maximum-generated-tests" (forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"NUMBER" 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 = 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 = 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 = 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 = 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 = forall a. a -> Maybe a
Just Integer
n}

data FailOn =
    FailOnEmpty
  | FailOnFocused
  | FailOnPending
  deriving (FailOn
forall a. a -> a -> Bounded a
maxBound :: FailOn
$cmaxBound :: FailOn
minBound :: FailOn
$cminBound :: FailOn
Bounded, Int -> FailOn
FailOn -> Int
FailOn -> [FailOn]
FailOn -> FailOn
FailOn -> FailOn -> [FailOn]
FailOn -> FailOn -> FailOn -> [FailOn]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FailOn -> FailOn -> FailOn -> [FailOn]
$cenumFromThenTo :: FailOn -> FailOn -> FailOn -> [FailOn]
enumFromTo :: FailOn -> FailOn -> [FailOn]
$cenumFromTo :: FailOn -> FailOn -> [FailOn]
enumFromThen :: FailOn -> FailOn -> [FailOn]
$cenumFromThen :: FailOn -> FailOn -> [FailOn]
enumFrom :: FailOn -> [FailOn]
$cenumFrom :: FailOn -> [FailOn]
fromEnum :: FailOn -> Int
$cfromEnum :: FailOn -> Int
toEnum :: Int -> FailOn
$ctoEnum :: Int -> FailOn
pred :: FailOn -> FailOn
$cpred :: FailOn -> FailOn
succ :: FailOn -> FailOn
$csucc :: FailOn -> FailOn
Enum)

allFailOnItems :: [FailOn]
allFailOnItems :: [FailOn]
allFailOnItems = [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]

showFailOn :: FailOn -> String
showFailOn :: FailOn -> String
showFailOn FailOn
item = case FailOn
item of
  FailOn
FailOnEmpty -> String
"empty"
  FailOn
FailOnFocused -> String
"focused"
  FailOn
FailOnPending -> String
"pending"

readFailOn :: String -> Maybe FailOn
readFailOn :: String -> Maybe FailOn
readFailOn = (forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String, FailOn)]
items)
  where
    items :: [(String, FailOn)]
items = forall a b. (a -> b) -> [a] -> [b]
map (FailOn -> String
showFailOn forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) [FailOn]
allFailOnItems

splitOn :: Char -> String -> [String]
splitOn :: Char -> String -> [String]
splitOn Char
sep = String -> [String]
go
  where
    go :: String -> [String]
go String
xs =  case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
sep) String
xs of
      (String
"", String
"") -> []
      (String
y, String
"") -> [String
y]
      (String
y, Char
_ : String
ys) -> String
y forall a. a -> [a] -> [a]
: String -> [String]
go String
ys

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"

  , forall config. Option config -> Option config
undocumented forall a b. (a -> b) -> a -> b
$ String -> (Bool -> Config -> Config) -> String -> Option Config
mkFlag String
"fail-on-focused" Bool -> Config -> Config
setFailOnFocused String
"fail on focused spec items"
  , forall config. Option config -> Option config
undocumented forall a b. (a -> b) -> a -> b
$ String -> (Bool -> Config -> Config) -> String -> Option Config
mkFlag String
"fail-on-pending" Bool -> Config -> Config
setFailOnPending String
"fail on pending spec items"

  , String
-> Maybe Char -> OptionSetter Config -> String -> Option Config
mkOption    String
"fail-on" forall a. Maybe a
Nothing (forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"ITEMS" String -> Maybe [FailOn]
readFailOnItems (Bool -> [FailOn] -> Config -> Config
setFailOnItems Bool
True )) String
helpForFailOn
  , String
-> Maybe Char -> OptionSetter Config -> String -> Option Config
mkOption String
"no-fail-on" forall a. Maybe a
Nothing (forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"ITEMS" String -> Maybe [FailOn]
readFailOnItems (Bool -> [FailOn] -> Config -> Config
setFailOnItems Bool
False)) String
helpForFailOn
  , String -> (Bool -> Config -> Config) -> String -> Option Config
mkFlag String
"strict" Bool -> Config -> Config
setStrict forall a b. (a -> b) -> a -> b
$ String
"same as --fail-on=" forall a. Semigroup a => a -> a -> a
<> [FailOn] -> String
showFailOnItems [FailOn]
strict

  , 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" (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)"
  , forall config.
String -> OptionSetter config -> String -> Option config
option String
"failure-report" (forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"FILE" 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" 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" (forall a. a -> Maybe a
Just Char
'j') (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
    strict :: [FailOn]
strict = [FailOn
FailOnFocused, FailOn
FailOnPending]

    readFailOnItems :: String -> Maybe [FailOn]
    readFailOnItems :: String -> Maybe [FailOn]
readFailOnItems = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> Maybe FailOn
readFailOn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> [String]
splitOn Char
','

    showFailOnItems :: [FailOn] -> String
    showFailOnItems :: [FailOn] -> String
showFailOnItems = forall a. [a] -> [[a]] -> [a]
intercalate String
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map FailOn -> String
showFailOn

    helpForFailOn :: String
    helpForFailOn :: String
helpForFailOn = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [FailOn]
allFailOnItems forall a b. (a -> b) -> a -> b
$ \ FailOn
item ->
      FailOn -> String
showFailOn FailOn
item forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> FailOn -> String
help FailOn
item
      where
        help :: FailOn -> String
help FailOn
item = case FailOn
item of
          FailOn
FailOnEmpty -> String
"fail if no spec items have been run"
          FailOn
FailOnFocused -> String
"fail on focused spec items"
          FailOn
FailOnPending -> String
"fail on pending spec items"

    setFailOnItems :: Bool -> [FailOn] -> Config -> Config
    setFailOnItems :: Bool -> [FailOn] -> Config -> Config
setFailOnItems Bool
value = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (FailOn -> Bool -> Config -> Config
`setItem` Bool
value)
      where
        setItem :: FailOn -> Bool -> Config -> Config
setItem FailOn
item = case FailOn
item of
          FailOn
FailOnEmpty -> Bool -> Config -> Config
setFailOnEmpty
          FailOn
FailOnFocused -> Bool -> Config -> Config
setFailOnFocused
          FailOn
FailOnPending -> Bool -> Config -> Config
setFailOnPending

    readMaxJobs :: String -> Maybe Int
    readMaxJobs :: String -> Maybe Int
readMaxJobs String
s = do
      Int
n <- forall a. Read a => String -> Maybe a
readMaybe String
s
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
n forall a. Ord a => a -> a -> Bool
> Int
0
      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 = 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 = 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}

    setFailOnEmpty :: Bool -> Config -> Config
    setFailOnEmpty :: Bool -> Config -> Config
setFailOnEmpty Bool
value Config
config = Config
config {configFailOnEmpty :: Bool
configFailOnEmpty = Bool
value}

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

    setFailOnPending :: Bool -> Config -> Config
    setFailOnPending :: Bool -> Config -> Config
setFailOnPending Bool
value Config
config = Config
config {configFailOnPending :: Bool
configFailOnPending = Bool
value}

    setStrict :: Bool -> Config -> Config
    setStrict :: Bool -> Config -> Config
setStrict = (Bool -> [FailOn] -> Config -> Config
`setFailOnItems` [FailOn]
strict)

    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" 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" (forall a. a -> Maybe a
Just Char
'm') (forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"PATTERN" forall (m :: * -> *) a. Monad m => a -> m a
return String -> Config -> Config
addMatch) String
"only run examples that match given PATTERN"
  , forall config.
String -> OptionSetter config -> String -> Option config
option String
"skip" (forall a.
String
-> (String -> Maybe a)
-> (a -> Config -> Config)
-> OptionSetter Config
argument String
"PATTERN" 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 = 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 = 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) -> forall a. a -> Maybe a
Just 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_ 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 forall a. [a] -> [a] -> [a]
++ String
" or "
    String
_ : String
_ : [String]
_ -> String
x forall a. [a] -> [a] -> [a]
++ String
", ") forall a. [a] -> [a] -> [a]
++ [String] -> String
formatOrList [String]
ys