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

, filterOr

, setConfigAnnotation
, getConfigAnnotation

, addExtensionOptions
, getExtensionOptions

, getSeed
, getFormatter

, commandLineOnlyOptions
, formatterOptions
, smallCheckOptions
, quickCheckOptions
, runnerOptions

, flag
, option

#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.Annotations (Annotations)
import qualified Test.Hspec.Core.Annotations as Annotations

import           Test.Hspec.Core.Format (Format, FormatConfig)
import           Test.Hspec.Core.Formatters.Pretty (pretty2)
import qualified Test.Hspec.Core.Formatters.V1.Monad as V1
import qualified Test.Hspec.Core.Formatters.V1.Internal as V1 (formatterToFormat)
import           Test.Hspec.Core.Util

import           GetOpt.Declarative

setConfigAnnotation :: Typeable value => value -> Config -> Config
setConfigAnnotation :: forall value. Typeable value => value -> Config -> Config
setConfigAnnotation value
value Config
config = Config
config { configAnnotations = Annotations.setValue value $ configAnnotations config }

getConfigAnnotation :: Typeable value => Config -> Maybe value
getConfigAnnotation :: forall value. Typeable value => Config -> Maybe value
getConfigAnnotation = Annotations -> Maybe value
forall value. Typeable value => Annotations -> Maybe value
Annotations.getValue (Annotations -> Maybe value)
-> (Config -> Annotations) -> Config -> Maybe value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Annotations
configAnnotations

newtype ExtensionOptions = ExtensionOptions { ExtensionOptions -> [(String, [Option Config])]
unExtensionOptions :: [(String, [Option Config])] }

addExtensionOptions :: String -> [Option Config] -> Config -> Config
addExtensionOptions :: String -> [Option Config] -> Config -> Config
addExtensionOptions String
section [Option Config]
opts Config
config = [(String, [Option Config])] -> Config -> Config
setExtensionOptions ((String
section, [Option Config]
opts) (String, [Option Config])
-> [(String, [Option Config])] -> [(String, [Option Config])]
forall a. a -> [a] -> [a]
: Config -> [(String, [Option Config])]
getExtensionOptions Config
config) Config
config

setExtensionOptions :: [(String, [Option Config])] -> Config -> Config
setExtensionOptions :: [(String, [Option Config])] -> Config -> Config
setExtensionOptions = ExtensionOptions -> Config -> Config
forall value. Typeable value => value -> Config -> Config
setConfigAnnotation (ExtensionOptions -> Config -> Config)
-> ([(String, [Option Config])] -> ExtensionOptions)
-> [(String, [Option Config])]
-> Config
-> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, [Option Config])] -> ExtensionOptions
ExtensionOptions

getExtensionOptions :: Config -> [(String, [Option Config])]
getExtensionOptions :: Config -> [(String, [Option Config])]
getExtensionOptions = [(String, [Option Config])]
-> (ExtensionOptions -> [(String, [Option Config])])
-> Maybe ExtensionOptions
-> [(String, [Option Config])]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ExtensionOptions -> [(String, [Option Config])]
unExtensionOptions (Maybe ExtensionOptions -> [(String, [Option Config])])
-> (Config -> Maybe ExtensionOptions)
-> Config
-> [(String, [Option Config])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Maybe ExtensionOptions
forall value. Typeable value => Config -> Maybe value
getConfigAnnotation

getFormatter :: Config -> Maybe (FormatConfig -> IO Format)
getFormatter :: Config -> Maybe (FormatConfig -> IO Format)
getFormatter Config
config = Config -> Maybe (FormatConfig -> IO Format)
configFormat Config
config Maybe (FormatConfig -> IO Format)
-> Maybe (FormatConfig -> IO Format)
-> Maybe (FormatConfig -> IO Format)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Formatter -> FormatConfig -> IO Format
V1.formatterToFormat (Formatter -> FormatConfig -> IO Format)
-> Maybe Formatter -> Maybe (FormatConfig -> IO Format)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> Maybe Formatter
configFormatter Config
config

getSeed :: Config -> Maybe Integer
getSeed :: Config -> Maybe Integer
getSeed Config
config = Config -> Maybe Integer
configSeed Config
config Maybe Integer -> Maybe Integer -> Maybe Integer
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe Integer
configQuickCheckSeed Config
config

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
$c== :: ColorMode -> ColorMode -> Bool
== :: ColorMode -> ColorMode -> Bool
$c/= :: ColorMode -> ColorMode -> Bool
/= :: 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
$cshowsPrec :: Int -> ColorMode -> ShowS
showsPrec :: Int -> ColorMode -> ShowS
$cshow :: ColorMode -> String
show :: ColorMode -> String
$cshowList :: [ColorMode] -> ShowS
showList :: [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
$c== :: UnicodeMode -> UnicodeMode -> Bool
== :: UnicodeMode -> UnicodeMode -> Bool
$c/= :: UnicodeMode -> UnicodeMode -> Bool
/= :: 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
$cshowsPrec :: Int -> UnicodeMode -> ShowS
showsPrec :: Int -> UnicodeMode -> ShowS
$cshow :: UnicodeMode -> String
show :: UnicodeMode -> String
$cshowList :: [UnicodeMode] -> ShowS
showList :: [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 -> Bool
configFailOnEmptyDescription :: Bool
, Config -> Maybe Int
configPrintSlowItems :: Maybe Int
, Config -> Bool
configPrintCpuTime :: Bool
, Config -> Bool
configFailFast :: Bool
, Config -> Bool
configRandomize :: Bool
, Config -> Maybe Integer
configSeed :: Maybe Integer
, Config -> Maybe Integer
configQuickCheckSeed :: Maybe Integer
, 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 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 -> SomeException -> String
configFormatException :: SomeException -> String -- ^ @since 2.11.5
, Config -> Bool
configTimes :: Bool
, Config -> Bool
configExpertMode :: Bool -- ^ @since 2.11.2
, Config -> [(String, FormatConfig -> IO Format)]
configAvailableFormatters :: [(String, FormatConfig -> IO Format)] -- ^ @since 2.9.0
, Config -> Maybe (FormatConfig -> IO Format)
configFormat :: Maybe (FormatConfig -> IO Format)
, Config -> Maybe Formatter
configFormatter :: Maybe V1.Formatter
, Config -> Bool
configHtmlOutput :: Bool
, Config -> Maybe Int
configConcurrentJobs :: Maybe Int
, Config -> Annotations
configAnnotations :: Annotations
}
{-# DEPRECATED configFormatter "Use [@useFormatter@](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Formatters-V1.html#v:useFormatter) instead." #-}
{-# DEPRECATED configQuickCheckSeed "Use `configSeed` instead." #-}

mkDefaultConfig :: [(String, FormatConfig -> IO Format)] -> Config
mkDefaultConfig :: [(String, FormatConfig -> IO Format)] -> Config
mkDefaultConfig [(String, FormatConfig -> IO Format)]
formatters = 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
, configFailOnEmptyDescription :: Bool
configFailOnEmptyDescription = 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
, configSeed :: Maybe Integer
configSeed = Maybe Integer
forall a. Maybe a
Nothing
, configQuickCheckSeed :: Maybe Integer
configQuickCheckSeed = Maybe Integer
forall a. Maybe a
Nothing
, 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
, 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 :: Maybe Int
configSmallCheckDepth = Maybe Int
forall a. Maybe a
Nothing
, configColorMode :: ColorMode
configColorMode = ColorMode
ColorAuto
, configUnicodeMode :: UnicodeMode
configUnicodeMode = UnicodeMode
UnicodeAuto
, configDiff :: Bool
configDiff = Bool
True
, configDiffContext :: Maybe Int
configDiffContext = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
defaultDiffContext
, configExternalDiff :: Maybe (Maybe Int -> String -> String -> IO ())
configExternalDiff = Maybe (Maybe Int -> String -> String -> IO ())
forall a. Maybe a
Nothing
, configPrettyPrint :: Bool
configPrettyPrint = Bool
True
, configPrettyPrintFunction :: Bool -> String -> String -> (String, String)
configPrettyPrintFunction = Bool -> String -> String -> (String, String)
pretty2
, configFormatException :: SomeException -> String
configFormatException = (SomeException -> String) -> SomeException -> String
formatExceptionWith SomeException -> String
forall a. Show a => a -> String
show
, configTimes :: Bool
configTimes = Bool
False
, configExpertMode :: Bool
configExpertMode = Bool
False
, configAvailableFormatters :: [(String, FormatConfig -> IO Format)]
configAvailableFormatters = [(String, FormatConfig -> IO Format)]
formatters
, 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
, configAnnotations :: Annotations
configAnnotations = Annotations
forall a. Monoid a => a
mempty
}

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
  String -> String -> String -> (String -> IO ()) -> IO ()
forall a. String -> String -> String -> (String -> IO a) -> IO a
withTempFile String
tmp String
"hspec-expected" String
expected ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ String
expectedFile -> do
    String -> String -> String -> (String -> IO ()) -> IO ()
forall a. String -> String -> String -> (String -> IO a) -> IO a
withTempFile String
tmp String
"hspec-actual" String
actual ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ String
actualFile -> do
      IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ())
-> (String -> IO ExitCode) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ExitCode
system (String -> IO ()) -> String -> IO ()
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
  IO (String, Handle)
-> ((String, Handle) -> IO ())
-> ((String, Handle) -> IO a)
-> IO a
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 (String -> IO ())
-> ((String, Handle) -> String) -> (String, Handle) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Handle) -> String
forall a b. (a, b) -> a
fst) (((String, Handle) -> IO a) -> IO a)
-> ((String, Handle) -> IO a) -> IO a
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 = 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

flag :: String -> (Bool -> config -> config) -> String -> Option config
flag :: forall config.
String -> (Bool -> config -> config) -> String -> Option config
flag 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 :: forall config. Option config -> Option config
undocumented Option config
opt = Option config
opt {optionDocumented = False}

argument :: String -> (String -> Maybe a) -> (a -> config -> config) -> OptionSetter config
argument :: forall a config.
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 config.
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
forall config.
String -> (Bool -> config -> config) -> String -> Option config
flag String
"color" Bool -> Config -> Config
setColor String
"colorize the output"
  , String -> (Bool -> Config -> Config) -> String -> Option Config
forall config.
String -> (Bool -> config -> config) -> String -> Option config
flag String
"unicode" Bool -> Config -> Config
setUnicode String
"output unicode"
  , String -> (Bool -> Config -> Config) -> String -> Option Config
forall config.
String -> (Bool -> config -> config) -> String -> Option config
flag String
"diff" Bool -> Config -> Config
setDiff String
"show colorized diffs"
  , String -> OptionSetter Config -> String -> Option Config
forall config.
String -> OptionSetter config -> String -> Option config
option String
"diff-context" (String
-> (String -> Maybe (Maybe Int))
-> (Maybe Int -> Config -> Config)
-> OptionSetter Config
forall a config.
String
-> (String -> Maybe a)
-> (a -> config -> config)
-> OptionSetter config
argument String
"N" String -> Maybe (Maybe Int)
readDiffContext Maybe Int -> Config -> Config
setDiffContext) (String -> Option Config) -> String -> Option Config
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
        String
"output N lines of diff context (default: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
defaultDiffContext String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
      , String
"use a value of 'full' to see the full context"
      ]
  , String -> OptionSetter Config -> String -> Option Config
forall config.
String -> OptionSetter config -> String -> Option config
option String
"diff-command" (String
-> (String -> Maybe String)
-> (String -> Config -> Config)
-> OptionSetter Config
forall a config.
String
-> (String -> Maybe a)
-> (a -> config -> config)
-> OptionSetter config
argument String
"CMD" String -> Maybe String
forall a. a -> Maybe a
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
forall config.
String -> (Bool -> config -> config) -> String -> Option config
flag String
"pretty" Bool -> Config -> Config
setPretty String
"try to pretty-print diff values"
  , String
-> Maybe Char -> (Config -> Config) -> String -> Option Config
mkOptionNoArg String
"show-exceptions" Maybe Char
forall a. Maybe a
Nothing Config -> Config
setShowException String
"use `show` when formatting exceptions"
  , String
-> Maybe Char -> (Config -> Config) -> String -> Option Config
mkOptionNoArg String
"display-exceptions" Maybe Char
forall a. Maybe a
Nothing Config -> Config
setDisplayException String
"use `displayException` when formatting exceptions"

  , String -> (Bool -> Config -> Config) -> String -> Option Config
forall config.
String -> (Bool -> config -> config) -> String -> Option config
flag 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
  , String -> (Bool -> Config -> Config) -> String -> Option Config
forall config.
String -> (Bool -> config -> config) -> String -> Option config
flag String
"expert" Bool -> Config -> Config
setExpertMode String
"be less verbose"

    -- 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
    setDiffCommand :: String -> Config -> Config
    setDiffCommand :: String -> Config -> Config
setDiffCommand String
command Config
config = Config
config {
      configExternalDiff = case strip command of
        String
"" -> Maybe (Maybe Int -> String -> String -> IO ())
forall a. Maybe a
Nothing
        String
_ -> (Maybe Int -> String -> String -> IO ())
-> Maybe (Maybe Int -> String -> String -> IO ())
forall a. a -> Maybe a
Just ((Maybe Int -> String -> String -> IO ())
 -> Maybe (Maybe Int -> String -> String -> IO ()))
-> (Maybe Int -> String -> String -> IO ())
-> Maybe (Maybe Int -> String -> String -> IO ())
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 = 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 = Just f}

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

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

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

    readDiffContext :: String -> Maybe (Maybe Int)
    readDiffContext :: String -> Maybe (Maybe Int)
readDiffContext String
input = case String
input of
      String
"full" -> Maybe Int -> Maybe (Maybe Int)
forall a. a -> Maybe a
Just Maybe Int
forall a. Maybe a
Nothing
      String
_ -> case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
input of
        Maybe Int
Nothing -> Maybe (Maybe Int)
forall a. Maybe a
Nothing
        Maybe Int
mn -> Maybe Int -> Maybe (Maybe Int)
forall a. a -> Maybe a
Just ((Int -> Bool) -> Maybe Int -> Maybe Int
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Int -> Int -> Bool
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 = value }

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

    setShowException :: Config -> Config
    setShowException :: Config -> Config
setShowException Config
config = Config
config {configFormatException = formatExceptionWith show}

    setDisplayException :: Config -> Config
    setDisplayException :: Config -> Config
setDisplayException Config
config = Config
config {configFormatException = formatExceptionWith displayException}

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

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

    setExpertMode :: Bool -> Config -> Config
    setExpertMode :: Bool -> Config -> Config
setExpertMode Bool
v Config
config = Config
config {configExpertMode = v}

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 = 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
      Maybe Int
Nothing -> Maybe Config
forall a. Maybe a
Nothing
      Maybe Int
mn -> Config -> Maybe Config
forall a. a -> Maybe a
Just (Maybe Int -> Config -> Config
setter ((Int -> Bool) -> Maybe Int -> Maybe Int
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) Maybe Int
mn) Config
c)

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 config.
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 = Just 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 config.
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 config.
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 config.
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 config.
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)"

    -- 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 config.
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 = Just n}

setMaxDiscardRatio :: Int -> Config -> Config
setMaxDiscardRatio :: Int -> Config -> Config
setMaxDiscardRatio Int
n Config
c = Config
c {configQuickCheckMaxDiscardRatio = Just n}

setMaxSize :: Int -> Config -> Config
setMaxSize :: Int -> Config -> Config
setMaxSize Int
n Config
c = Config
c {configQuickCheckMaxSize = Just n}

setMaxShrinks :: Int -> Config -> Config
setMaxShrinks :: Int -> Config -> Config
setMaxShrinks Int
n Config
c = Config
c {configQuickCheckMaxShrinks = Just n}

setSeed :: Integer -> Config -> Config
setSeed :: Integer -> Config -> Config
setSeed Integer
n Config
c = Config
c {configSeed = Just n}

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

allFailOnItems :: [FailOn]
allFailOnItems :: [FailOn]
allFailOnItems = [FailOn
forall a. Bounded a => a
minBound .. FailOn
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"
  FailOn
FailOnEmptyDescription -> String
"empty-description"

readFailOn :: String -> Maybe FailOn
readFailOn :: String -> Maybe FailOn
readFailOn = (String -> [(String, FailOn)] -> Maybe FailOn
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String, FailOn)]
items)
  where
    items :: [(String, FailOn)]
items = (FailOn -> (String, FailOn)) -> [FailOn] -> [(String, FailOn)]
forall a b. (a -> b) -> [a] -> [b]
map (FailOn -> String
showFailOn (FailOn -> String)
-> (FailOn -> FailOn) -> FailOn -> (String, FailOn)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& FailOn -> FailOn
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 (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
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 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
go String
ys

runnerOptions :: [Option Config]
runnerOptions :: [Option Config]
runnerOptions = [
    String -> (Bool -> Config -> Config) -> String -> Option Config
forall config.
String -> (Bool -> config -> config) -> String -> Option config
flag String
"dry-run" Bool -> Config -> Config
setDryRun String
"pretend that everything passed; don't verify anything"
  , String -> (Bool -> Config -> Config) -> String -> Option Config
forall config.
String -> (Bool -> config -> config) -> String -> Option config
flag String
"focused-only" Bool -> Config -> Config
setFocusedOnly String
"do not run anything, unless there are focused spec items"

  , 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 -> (Bool -> Config -> Config) -> String -> Option Config
forall config.
String -> (Bool -> config -> config) -> String -> Option config
flag String
"fail-on-focused" Bool -> Config -> Config
setFailOnFocused String
"fail on focused spec items"
  , 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 -> (Bool -> Config -> Config) -> String -> Option Config
forall config.
String -> (Bool -> config -> config) -> String -> Option config
flag 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" Maybe Char
forall a. Maybe a
Nothing (String
-> (String -> Maybe [FailOn])
-> ([FailOn] -> Config -> Config)
-> OptionSetter Config
forall a config.
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" Maybe Char
forall a. Maybe a
Nothing (String
-> (String -> Maybe [FailOn])
-> ([FailOn] -> Config -> Config)
-> OptionSetter Config
forall a config.
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
forall config.
String -> (Bool -> config -> config) -> String -> Option config
flag String
"strict" Bool -> Config -> Config
setStrict (String -> Option Config) -> String -> Option Config
forall a b. (a -> b) -> a -> b
$ String
"same as --fail-on=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [FailOn] -> String
showFailOnItems [FailOn]
strict

  , String -> (Bool -> Config -> Config) -> String -> Option Config
forall config.
String -> (Bool -> config -> config) -> String -> Option config
flag String
"fail-fast" Bool -> Config -> Config
setFailFast String
"abort on first failure"
  , String -> (Bool -> Config -> Config) -> String -> Option Config
forall config.
String -> (Bool -> config -> config) -> String -> Option config
flag 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 config.
String
-> (String -> Maybe a)
-> (a -> config -> config)
-> OptionSetter config
argument String
"FILE" String -> Maybe String
forall a. a -> Maybe a
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 config.
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)"
  , 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 config.
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 --randomize and QuickCheck properties"
  ]
  where
    strict :: [FailOn]
strict = [FailOn
FailOnFocused, FailOn
FailOnPending]

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

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

    helpForFailOn :: String
    helpForFailOn :: String
helpForFailOn = [String] -> String
unlines ([String] -> String)
-> ((FailOn -> String) -> [String]) -> (FailOn -> String) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FailOn -> String) -> [FailOn] -> [String])
-> [FailOn] -> (FailOn -> String) -> [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FailOn -> String) -> [FailOn] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [FailOn]
allFailOnItems ((FailOn -> String) -> String) -> (FailOn -> String) -> String
forall a b. (a -> b) -> a -> b
$ \ FailOn
item ->
      FailOn -> String
showFailOn FailOn
item String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
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 all spec items have been filtered"
          FailOn
FailOnFocused -> String
"fail on focused spec items"
          FailOn
FailOnPending -> String
"fail on pending spec items"
          FailOn
FailOnEmptyDescription -> String
"fail on empty descriptions"

    setFailOnItems :: Bool -> [FailOn] -> Config -> Config
    setFailOnItems :: Bool -> [FailOn] -> Config -> Config
setFailOnItems Bool
value = (Config -> [FailOn] -> Config) -> [FailOn] -> Config -> Config
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Config -> [FailOn] -> Config) -> [FailOn] -> Config -> Config)
-> (Config -> [FailOn] -> Config) -> [FailOn] -> Config -> Config
forall a b. (a -> b) -> a -> b
$ (FailOn -> Config -> Config) -> Config -> [FailOn] -> Config
forall a b. (a -> b -> b) -> 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
          FailOn
FailOnEmptyDescription -> Bool -> Config -> Config
setFailOnEmptyDescription

    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 a. a -> Maybe a
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 = Just file}

    setMaxJobs :: Int -> Config -> Config
    setMaxJobs :: Int -> Config -> Config
setMaxJobs Int
n Config
c = Config
c {configConcurrentJobs = Just n}

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

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

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

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

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

    setFailOnEmptyDescription :: Bool -> Config -> Config
    setFailOnEmptyDescription :: Bool -> Config -> Config
setFailOnEmptyDescription Bool
value Config
config = Config
config {configFailOnEmptyDescription = 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 = value}

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

    setRerun :: Config -> Config
setRerun Config
config = Config
config {configRerun = True}
    setRerunAllOnSuccess :: Config -> Config
setRerunAllOnSuccess Config
config = Config
config {configRerunAllOnSuccess = 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 config.
String
-> (String -> Maybe a)
-> (a -> config -> config)
-> OptionSetter config
argument String
"PATTERN" String -> Maybe String
forall a. a -> Maybe a
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 config.
String
-> (String -> Maybe a)
-> (a -> config -> config)
-> OptionSetter config
argument String
"PATTERN" String -> Maybe String
forall a. a -> Maybe a
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 = True}

addMatch :: String -> Config -> Config
addMatch :: String -> Config -> Config
addMatch String
s Config
c = Config
c {configFilterPredicate = Just (filterPredicate s) `filterOr` configFilterPredicate c}

addSkip :: String -> Config -> Config
addSkip :: String -> Config -> Config
addSkip String
s Config
c = Config
c {configSkipPredicate = Just (filterPredicate s) `filterOr` configSkipPredicate 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 a. Maybe a -> Maybe a -> Maybe a
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