module Test.Hspec.Core.Config.Options (
  Config(..)
, ColorMode (..)
, defaultConfig
, filterOr
, parseOptions
, ConfigFile
, ignoreConfigFile
, envVarName
) where

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

import           System.IO
import           System.Exit
import           System.Console.GetOpt

import           Test.Hspec.Core.Formatters
import           Test.Hspec.Core.Config.Util
import           Test.Hspec.Core.Util
import           Test.Hspec.Core.Example (Params(..), defaultParams)
import           Data.Functor.Identity
import           Data.Maybe

type ConfigFile = (FilePath, [String])

type EnvVar = [String]

envVarName :: String
envVarName :: String
envVarName = String
"HSPEC_OPTIONS"

data Config = Config {
  Config -> Bool
configIgnoreConfigFile :: Bool
, Config -> Bool
configDryRun :: Bool
, Config -> Bool
configFocusedOnly :: Bool
, Config -> Bool
configFailOnFocused :: Bool
, Config -> Bool
configPrintCpuTime :: Bool
, Config -> Bool
configFastFail :: 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 -> Int
configSmallCheckDepth :: Int
, Config -> ColorMode
configColorMode :: ColorMode
, Config -> Bool
configDiff :: Bool
, Config -> Maybe Formatter
configFormatter :: Maybe Formatter
, Config -> Bool
configHtmlOutput :: Bool
, Config -> Either Handle String
configOutputFile :: Either Handle FilePath
, Config -> Maybe Int
configConcurrentJobs :: Maybe Int
}

defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Bool
-> Bool
-> Maybe (Path -> Bool)
-> Maybe (Path -> Bool)
-> Maybe Integer
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Int
-> ColorMode
-> Bool
-> Maybe Formatter
-> Bool
-> Either Handle String
-> Maybe Int
-> Config
Config {
  configIgnoreConfigFile :: Bool
configIgnoreConfigFile = Bool
False
, configDryRun :: Bool
configDryRun = Bool
False
, configFocusedOnly :: Bool
configFocusedOnly = Bool
False
, configFailOnFocused :: Bool
configFailOnFocused = Bool
False
, configPrintCpuTime :: Bool
configPrintCpuTime = Bool
False
, configFastFail :: Bool
configFastFail = 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
, configSmallCheckDepth :: Int
configSmallCheckDepth = Params -> Int
paramsSmallCheckDepth Params
defaultParams
, configColorMode :: ColorMode
configColorMode = ColorMode
ColorAuto
, configDiff :: Bool
configDiff = Bool
True
, configFormatter :: Maybe Formatter
configFormatter = Maybe Formatter
forall a. Maybe a
Nothing
, configHtmlOutput :: Bool
configHtmlOutput = Bool
False
, configOutputFile :: Either Handle String
configOutputFile = Handle -> Either Handle String
forall a b. a -> Either a b
Left Handle
stdout
, configConcurrentJobs :: Maybe Int
configConcurrentJobs = Maybe Int
forall a. Maybe a
Nothing
}

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_

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}

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

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}

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}

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}

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}

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)

type Result m = Either InvalidArgument (m Config)

data InvalidArgument = InvalidArgument String String

data Arg a = Arg {
  Arg a -> String
_argumentName   :: String
, Arg a -> String -> Maybe a
_argumentParser :: String -> Maybe a
, Arg a -> a -> Config -> Config
_argumentSetter :: a -> Config -> Config
}

mkOption :: Monad m => [Char] -> String -> Arg a -> String -> OptDescr (Result m -> Result m)
mkOption :: String
-> String -> Arg a -> String -> OptDescr (Result m -> Result m)
mkOption String
shortcut String
name (Arg String
argName String -> Maybe a
parser a -> Config -> Config
setter) String
help = String
-> [String]
-> ArgDescr (Result m -> Result m)
-> String
-> OptDescr (Result m -> Result m)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
shortcut [String
name] ((String -> Result m -> Result m)
-> String -> ArgDescr (Result m -> Result m)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Result m -> Result m
forall (m :: * -> *).
Monad m =>
String
-> Either InvalidArgument (m Config)
-> Either InvalidArgument (m Config)
arg String
argName) String
help
  where
    arg :: String
-> Either InvalidArgument (m Config)
-> Either InvalidArgument (m Config)
arg String
input Either InvalidArgument (m Config)
x = Either InvalidArgument (m Config)
x Either InvalidArgument (m Config)
-> (m Config -> Either InvalidArgument (m Config))
-> Either InvalidArgument (m Config)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \m Config
c -> case String -> Maybe a
parser String
input of
      Just a
n -> m Config -> Either InvalidArgument (m Config)
forall a b. b -> Either a b
Right (a -> Config -> Config
setter a
n (Config -> Config) -> m Config -> m Config
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m Config
c)
      Maybe a
Nothing -> InvalidArgument -> Either InvalidArgument (m Config)
forall a b. a -> Either a b
Left (String -> String -> InvalidArgument
InvalidArgument String
name String
input)

mkFlag :: Monad m => String -> (Bool -> Config -> Config) -> String -> [OptDescr (Result m -> Result m)]
mkFlag :: String
-> (Bool -> Config -> Config)
-> String
-> [OptDescr (Result m -> Result m)]
mkFlag String
name Bool -> Config -> Config
setter String
help = [
    String
-> [String]
-> ArgDescr (Result m -> Result m)
-> String
-> OptDescr (Result m -> Result m)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
name] ((Result m -> Result m) -> ArgDescr (Result m -> Result m)
forall a. a -> ArgDescr a
NoArg ((Result m -> Result m) -> ArgDescr (Result m -> Result m))
-> (Result m -> Result m) -> ArgDescr (Result m -> Result m)
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Result m -> Result m
forall (m :: * -> *) a.
Monad m =>
(Config -> Config) -> Either a (m Config) -> Either a (m Config)
set ((Config -> Config) -> Result m -> Result m)
-> (Config -> Config) -> Result m -> Result m
forall a b. (a -> b) -> a -> b
$ Bool -> Config -> Config
setter Bool
True) String
help
  , String
-> [String]
-> ArgDescr (Result m -> Result m)
-> String
-> OptDescr (Result m -> Result m)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"no-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name] ((Result m -> Result m) -> ArgDescr (Result m -> Result m)
forall a. a -> ArgDescr a
NoArg ((Result m -> Result m) -> ArgDescr (Result m -> Result m))
-> (Result m -> Result m) -> ArgDescr (Result m -> Result m)
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Result m -> Result m
forall (m :: * -> *) a.
Monad m =>
(Config -> Config) -> Either a (m Config) -> Either a (m Config)
set ((Config -> Config) -> Result m -> Result m)
-> (Config -> Config) -> Result m -> Result m
forall a b. (a -> b) -> a -> b
$ Bool -> Config -> Config
setter Bool
False) (String
"do not " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
help)
  ]

commandLineOptions :: [OptDescr (Result Maybe -> Result Maybe)]
commandLineOptions :: [OptDescr (Result Maybe -> Result Maybe)]
commandLineOptions = [
    String
-> [String]
-> ArgDescr (Result Maybe -> Result Maybe)
-> String
-> OptDescr (Result Maybe -> Result Maybe)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"help"] ((Result Maybe -> Result Maybe)
-> ArgDescr (Result Maybe -> Result Maybe)
forall a. a -> ArgDescr a
NoArg (Result Maybe -> Result Maybe -> Result Maybe
forall a b. a -> b -> a
const (Result Maybe -> Result Maybe -> Result Maybe)
-> Result Maybe -> Result Maybe -> Result Maybe
forall a b. (a -> b) -> a -> b
$ Maybe Config -> Result Maybe
forall a b. b -> Either a b
Right Maybe Config
forall a. Maybe a
Nothing)) String
"display this help and exit"
  , String
-> [String]
-> ArgDescr (Result Maybe -> Result Maybe)
-> String
-> OptDescr (Result Maybe -> Result Maybe)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"ignore-dot-hspec"] ((Result Maybe -> Result Maybe)
-> ArgDescr (Result Maybe -> Result Maybe)
forall a. a -> ArgDescr a
NoArg Result Maybe -> Result Maybe
forall a. Either a (Maybe Config) -> Either a (Maybe Config)
setIgnoreConfigFile) String
"do not read options from ~/.hspec and .hspec"
  , String
-> String
-> Arg String
-> String
-> OptDescr (Result Maybe -> Result Maybe)
forall (m :: * -> *) a.
Monad m =>
String
-> String -> Arg a -> String -> OptDescr (Result m -> Result m)
mkOption String
"m" String
"match" (String
-> (String -> Maybe String)
-> (String -> Config -> Config)
-> Arg String
forall a.
String -> (String -> Maybe a) -> (a -> Config -> Config) -> Arg a
Arg 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
-> String
-> Arg String
-> String
-> OptDescr (Result Maybe -> Result Maybe)
forall (m :: * -> *) a.
Monad m =>
String
-> String -> Arg a -> String -> OptDescr (Result m -> Result m)
mkOption [] String
"skip" (String
-> (String -> Maybe String)
-> (String -> Config -> Config)
-> Arg String
forall a.
String -> (String -> Maybe a) -> (a -> Config -> Config) -> Arg a
Arg 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 :: Either a (Maybe Config) -> Either a (Maybe Config)
setIgnoreConfigFile = (Config -> Config)
-> Either a (Maybe Config) -> Either a (Maybe Config)
forall (m :: * -> *) a.
Monad m =>
(Config -> Config) -> Either a (m Config) -> Either a (m Config)
set ((Config -> Config)
 -> Either a (Maybe Config) -> Either a (Maybe Config))
-> (Config -> Config)
-> Either a (Maybe Config)
-> Either a (Maybe Config)
forall a b. (a -> b) -> a -> b
$ \Config
config -> Config
config {configIgnoreConfigFile :: Bool
configIgnoreConfigFile = Bool
True}

formatterOptions :: Monad m => [OptDescr (Result m -> Result m)]
formatterOptions :: [OptDescr (Result m -> Result m)]
formatterOptions = [[OptDescr (Result m -> Result m)]]
-> [OptDescr (Result m -> Result m)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
    [String
-> String
-> Arg Formatter
-> String
-> OptDescr (Result m -> Result m)
forall (m :: * -> *) a.
Monad m =>
String
-> String -> Arg a -> String -> OptDescr (Result m -> Result m)
mkOption String
"f" String
"format" (String
-> (String -> Maybe Formatter)
-> (Formatter -> Config -> Config)
-> Arg Formatter
forall a.
String -> (String -> Maybe a) -> (a -> Config -> Config) -> Arg a
Arg String
"FORMATTER" String -> Maybe Formatter
readFormatter Formatter -> Config -> Config
setFormatter) String
helpForFormat]
  , String
-> (Bool -> Config -> Config)
-> String
-> [OptDescr (Result m -> Result m)]
forall (m :: * -> *).
Monad m =>
String
-> (Bool -> Config -> Config)
-> String
-> [OptDescr (Result m -> Result m)]
mkFlag String
"color" Bool -> Config -> Config
setColor String
"colorize the output"
  , String
-> (Bool -> Config -> Config)
-> String
-> [OptDescr (Result m -> Result m)]
forall (m :: * -> *).
Monad m =>
String
-> (Bool -> Config -> Config)
-> String
-> [OptDescr (Result m -> Result m)]
mkFlag String
"diff" Bool -> Config -> Config
setDiff String
"show colorized diffs"
  , [String
-> [String]
-> ArgDescr (Result m -> Result m)
-> String
-> OptDescr (Result m -> Result m)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"print-cpu-time"] ((Result m -> Result m) -> ArgDescr (Result m -> Result m)
forall a. a -> ArgDescr a
NoArg Result m -> Result m
forall a. Either a (m Config) -> Either a (m Config)
setPrintCpuTime) String
"include used CPU time in summary"]
  ]
  where
    formatters :: [(String, Formatter)]
    formatters :: [(String, Formatter)]
formatters = [
        (String
"checks", Formatter
checks)
      , (String
"specdoc", Formatter
specdoc)
      , (String
"progress", Formatter
progress)
      , (String
"failed-examples", Formatter
failed_examples)
      , (String
"silent", Formatter
silent)
      ]

    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, Formatter) -> String)
-> [(String, Formatter)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Formatter) -> String
forall a b. (a, b) -> a
fst [(String, Formatter)]
formatters)

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

    setFormatter :: Formatter -> Config -> Config
    setFormatter :: Formatter -> Config -> Config
setFormatter Formatter
f Config
c = Config
c {configFormatter :: Maybe Formatter
configFormatter = Formatter -> Maybe Formatter
forall a. a -> Maybe a
Just Formatter
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}

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

    setPrintCpuTime :: Either a (m Config) -> Either a (m Config)
setPrintCpuTime = (Config -> Config) -> Either a (m Config) -> Either a (m Config)
forall (m :: * -> *) a.
Monad m =>
(Config -> Config) -> Either a (m Config) -> Either a (m Config)
set ((Config -> Config) -> Either a (m Config) -> Either a (m Config))
-> (Config -> Config) -> Either a (m Config) -> Either a (m Config)
forall a b. (a -> b) -> a -> b
$ \Config
config -> Config
config {configPrintCpuTime :: Bool
configPrintCpuTime = Bool
True}

smallCheckOptions :: Monad m => [OptDescr (Result m -> Result m)]
smallCheckOptions :: [OptDescr (Result m -> Result m)]
smallCheckOptions = [
    String
-> String -> Arg Int -> String -> OptDescr (Result m -> Result m)
forall (m :: * -> *) a.
Monad m =>
String
-> String -> Arg a -> String -> OptDescr (Result m -> Result m)
mkOption [] String
"depth" (String
-> (String -> Maybe Int) -> (Int -> Config -> Config) -> Arg Int
forall a.
String -> (String -> Maybe a) -> (a -> Config -> Config) -> Arg a
Arg 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"
  ]

quickCheckOptions :: Monad m => [OptDescr (Result m -> Result m)]
quickCheckOptions :: [OptDescr (Result m -> Result m)]
quickCheckOptions = [
    String
-> String -> Arg Int -> String -> OptDescr (Result m -> Result m)
forall (m :: * -> *) a.
Monad m =>
String
-> String -> Arg a -> String -> OptDescr (Result m -> Result m)
mkOption String
"a" String
"qc-max-success" (String
-> (String -> Maybe Int) -> (Int -> Config -> Config) -> Arg Int
forall a.
String -> (String -> Maybe a) -> (a -> Config -> Config) -> Arg a
Arg 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"
  , String
-> String -> Arg Int -> String -> OptDescr (Result m -> Result m)
forall (m :: * -> *) a.
Monad m =>
String
-> String -> Arg a -> String -> OptDescr (Result m -> Result m)
mkOption String
"" String
"qc-max-size" (String
-> (String -> Maybe Int) -> (Int -> Config -> Config) -> Arg Int
forall a.
String -> (String -> Maybe a) -> (a -> Config -> Config) -> Arg a
Arg 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
-> String -> Arg Int -> String -> OptDescr (Result m -> Result m)
forall (m :: * -> *) a.
Monad m =>
String
-> String -> Arg a -> String -> OptDescr (Result m -> Result m)
mkOption String
"" String
"qc-max-discard" (String
-> (String -> Maybe Int) -> (Int -> Config -> Config) -> Arg Int
forall a.
String -> (String -> Maybe a) -> (a -> Config -> Config) -> Arg a
Arg 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
-> String
-> Arg Integer
-> String
-> OptDescr (Result m -> Result m)
forall (m :: * -> *) a.
Monad m =>
String
-> String -> Arg a -> String -> OptDescr (Result m -> Result m)
mkOption [] String
"seed" (String
-> (String -> Maybe Integer)
-> (Integer -> Config -> Config)
-> Arg Integer
forall a.
String -> (String -> Maybe a) -> (a -> Config -> Config) -> Arg a
Arg String
"N" String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe Integer -> Config -> Config
setSeed) String
"used seed for QuickCheck properties"
  ]

runnerOptions :: Monad m => [OptDescr (Result m -> Result m)]
runnerOptions :: [OptDescr (Result m -> Result m)]
runnerOptions = [[OptDescr (Result m -> Result m)]]
-> [OptDescr (Result m -> Result m)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
    String
-> (Bool -> Config -> Config)
-> String
-> [OptDescr (Result m -> Result m)]
forall (m :: * -> *).
Monad m =>
String
-> (Bool -> Config -> Config)
-> String
-> [OptDescr (Result m -> Result m)]
mkFlag String
"dry-run" Bool -> Config -> Config
setDryRun String
"pretend that everything passed; don't verify anything"
  , String
-> (Bool -> Config -> Config)
-> String
-> [OptDescr (Result m -> Result m)]
forall (m :: * -> *).
Monad m =>
String
-> (Bool -> Config -> Config)
-> String
-> [OptDescr (Result m -> Result m)]
mkFlag String
"focused-only" Bool -> Config -> Config
setFocusedOnly String
"do not run anything, unless there are focused spec items"
  , String
-> (Bool -> Config -> Config)
-> String
-> [OptDescr (Result m -> Result m)]
forall (m :: * -> *).
Monad m =>
String
-> (Bool -> Config -> Config)
-> String
-> [OptDescr (Result m -> Result m)]
mkFlag String
"fail-on-focused" Bool -> Config -> Config
setFailOnFocused String
"fail on focused spec items"
  , String
-> (Bool -> Config -> Config)
-> String
-> [OptDescr (Result m -> Result m)]
forall (m :: * -> *).
Monad m =>
String
-> (Bool -> Config -> Config)
-> String
-> [OptDescr (Result m -> Result m)]
mkFlag String
"fail-fast" Bool -> Config -> Config
setFastFail String
"abort on first failure"
  , String
-> (Bool -> Config -> Config)
-> String
-> [OptDescr (Result m -> Result m)]
forall (m :: * -> *).
Monad m =>
String
-> (Bool -> Config -> Config)
-> String
-> [OptDescr (Result m -> Result m)]
mkFlag String
"randomize" Bool -> Config -> Config
setRandomize String
"randomize execution order"
  ] [OptDescr (Result m -> Result m)]
-> [OptDescr (Result m -> Result m)]
-> [OptDescr (Result m -> Result m)]
forall a. [a] -> [a] -> [a]
++ [
    String
-> [String]
-> ArgDescr (Result m -> Result m)
-> String
-> OptDescr (Result m -> Result m)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"r" [String
"rerun"] ((Result m -> Result m) -> ArgDescr (Result m -> Result m)
forall a. a -> ArgDescr a
NoArg  Result m -> Result m
forall a. Either a (m Config) -> Either a (m Config)
setRerun) String
"rerun all examples that failed in the previous test run (only works in combination with --failure-report or in GHCi)"
  , String
-> String
-> Arg String
-> String
-> OptDescr (Result m -> Result m)
forall (m :: * -> *) a.
Monad m =>
String
-> String -> Arg a -> String -> OptDescr (Result m -> Result m)
mkOption [] String
"failure-report" (String
-> (String -> Maybe String)
-> (String -> Config -> Config)
-> Arg String
forall a.
String -> (String -> Maybe a) -> (a -> Config -> Config) -> Arg a
Arg 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
-> [String]
-> ArgDescr (Result m -> Result m)
-> String
-> OptDescr (Result m -> Result m)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"rerun-all-on-success"] ((Result m -> Result m) -> ArgDescr (Result m -> Result m)
forall a. a -> ArgDescr a
NoArg Result m -> Result m
forall a. Either a (m Config) -> Either a (m 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
-> String -> Arg Int -> String -> OptDescr (Result m -> Result m)
forall (m :: * -> *) a.
Monad m =>
String
-> String -> Arg a -> String -> OptDescr (Result m -> Result m)
mkOption String
"j" String
"jobs" (String
-> (String -> Maybe Int) -> (Int -> Config -> Config) -> Arg Int
forall a.
String -> (String -> Maybe a) -> (a -> Config -> Config) -> Arg a
Arg 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}

    setFastFail :: Bool -> Config -> Config
    setFastFail :: Bool -> Config -> Config
setFastFail Bool
value Config
config = Config
config {configFastFail :: Bool
configFastFail = Bool
value}

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

    setRerun :: Either a (m Config) -> Either a (m Config)
setRerun        = (Config -> Config) -> Either a (m Config) -> Either a (m Config)
forall (m :: * -> *) a.
Monad m =>
(Config -> Config) -> Either a (m Config) -> Either a (m Config)
set ((Config -> Config) -> Either a (m Config) -> Either a (m Config))
-> (Config -> Config) -> Either a (m Config) -> Either a (m Config)
forall a b. (a -> b) -> a -> b
$ \Config
config -> Config
config {configRerun :: Bool
configRerun = Bool
True}
    setRerunAllOnSuccess :: Either a (m Config) -> Either a (m Config)
setRerunAllOnSuccess = (Config -> Config) -> Either a (m Config) -> Either a (m Config)
forall (m :: * -> *) a.
Monad m =>
(Config -> Config) -> Either a (m Config) -> Either a (m Config)
set ((Config -> Config) -> Either a (m Config) -> Either a (m Config))
-> (Config -> Config) -> Either a (m Config) -> Either a (m Config)
forall a b. (a -> b) -> a -> b
$ \Config
config -> Config
config {configRerunAllOnSuccess :: Bool
configRerunAllOnSuccess = Bool
True}

documentedConfigFileOptions :: Monad m => [(String, [OptDescr (Result m -> Result m)])]
documentedConfigFileOptions :: [(String, [OptDescr (Result m -> Result m)])]
documentedConfigFileOptions = [
    (String
"RUNNER OPTIONS", [OptDescr (Result m -> Result m)]
forall (m :: * -> *). Monad m => [OptDescr (Result m -> Result m)]
runnerOptions)
  , (String
"FORMATTER OPTIONS", [OptDescr (Result m -> Result m)]
forall (m :: * -> *). Monad m => [OptDescr (Result m -> Result m)]
formatterOptions)
  , (String
"OPTIONS FOR QUICKCHECK", [OptDescr (Result m -> Result m)]
forall (m :: * -> *). Monad m => [OptDescr (Result m -> Result m)]
quickCheckOptions)
  , (String
"OPTIONS FOR SMALLCHECK", [OptDescr (Result m -> Result m)]
forall (m :: * -> *). Monad m => [OptDescr (Result m -> Result m)]
smallCheckOptions)
  ]

documentedOptions :: [(String, [OptDescr (Result Maybe -> Result Maybe)])]
documentedOptions :: [(String, [OptDescr (Result Maybe -> Result Maybe)])]
documentedOptions = (String
"OPTIONS", [OptDescr (Result Maybe -> Result Maybe)]
commandLineOptions) (String, [OptDescr (Result Maybe -> Result Maybe)])
-> [(String, [OptDescr (Result Maybe -> Result Maybe)])]
-> [(String, [OptDescr (Result Maybe -> Result Maybe)])]
forall a. a -> [a] -> [a]
: [(String, [OptDescr (Result Maybe -> Result Maybe)])]
forall (m :: * -> *).
Monad m =>
[(String, [OptDescr (Result m -> Result m)])]
documentedConfigFileOptions

configFileOptions :: Monad m => [OptDescr (Result m -> Result m)]
configFileOptions :: [OptDescr (Result m -> Result m)]
configFileOptions = ([[OptDescr (Result m -> Result m)]]
-> [OptDescr (Result m -> Result m)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[OptDescr (Result m -> Result m)]]
 -> [OptDescr (Result m -> Result m)])
-> ([(String, [OptDescr (Result m -> Result m)])]
    -> [[OptDescr (Result m -> Result m)]])
-> [(String, [OptDescr (Result m -> Result m)])]
-> [OptDescr (Result m -> Result m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, [OptDescr (Result m -> Result m)])
 -> [OptDescr (Result m -> Result m)])
-> [(String, [OptDescr (Result m -> Result m)])]
-> [[OptDescr (Result m -> Result m)]]
forall a b. (a -> b) -> [a] -> [b]
map (String, [OptDescr (Result m -> Result m)])
-> [OptDescr (Result m -> Result m)]
forall a b. (a, b) -> b
snd) [(String, [OptDescr (Result m -> Result m)])]
forall (m :: * -> *).
Monad m =>
[(String, [OptDescr (Result m -> Result m)])]
documentedConfigFileOptions

set :: Monad m => (Config -> Config) -> Either a (m Config) -> Either a (m Config)
set :: (Config -> Config) -> Either a (m Config) -> Either a (m Config)
set = (m Config -> m Config)
-> Either a (m Config) -> Either a (m Config)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((m Config -> m Config)
 -> Either a (m Config) -> Either a (m Config))
-> ((Config -> Config) -> m Config -> m Config)
-> (Config -> Config)
-> Either a (m Config)
-> Either a (m Config)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Config) -> m Config -> m Config
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

undocumentedOptions :: Monad m => [OptDescr (Result m -> Result m)]
undocumentedOptions :: [OptDescr (Result m -> Result m)]
undocumentedOptions = [
    -- for compatibility with test-framework
    String
-> String -> Arg Int -> String -> OptDescr (Result m -> Result m)
forall (m :: * -> *) a.
Monad m =>
String
-> String -> Arg a -> String -> OptDescr (Result m -> Result m)
mkOption [] String
"maximum-generated-tests" (String
-> (String -> Maybe Int) -> (Int -> Config -> Config) -> Arg Int
forall a.
String -> (String -> Maybe a) -> (a -> Config -> Config) -> Arg a
Arg 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"

    -- undocumented for now, as we probably want to change this to produce a
    -- standalone HTML report in the future
  , String
-> [String]
-> ArgDescr (Result m -> Result m)
-> String
-> OptDescr (Result m -> Result m)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option []  [String
"html"]                    ((Result m -> Result m) -> ArgDescr (Result m -> Result m)
forall a. a -> ArgDescr a
NoArg Result m -> Result m
forall a. Either a (m Config) -> Either a (m Config)
setHtml)                    String
"produce HTML output"

  , String
-> String
-> Arg String
-> String
-> OptDescr (Result m -> Result m)
forall (m :: * -> *) a.
Monad m =>
String
-> String -> Arg a -> String -> OptDescr (Result m -> Result m)
mkOption String
"o"  String
"out"                    (String
-> (String -> Maybe String)
-> (String -> Config -> Config)
-> Arg String
forall a.
String -> (String -> Maybe a) -> (a -> Config -> Config) -> Arg a
Arg String
"FILE" String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String -> Config -> Config
setOutputFile)  String
"write output to a file instead of STDOUT"

    -- now a noop
  , String
-> [String]
-> ArgDescr (Result m -> Result m)
-> String
-> OptDescr (Result m -> Result m)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"v" [String
"verbose"]                 ((Result m -> Result m) -> ArgDescr (Result m -> Result m)
forall a. a -> ArgDescr a
NoArg Result m -> Result m
forall a. a -> a
id)                         String
"do not suppress output to stdout when evaluating examples"
  ]
  where
    setHtml :: Either a (m Config) -> Either a (m Config)
setHtml = (Config -> Config) -> Either a (m Config) -> Either a (m Config)
forall (m :: * -> *) a.
Monad m =>
(Config -> Config) -> Either a (m Config) -> Either a (m Config)
set ((Config -> Config) -> Either a (m Config) -> Either a (m Config))
-> (Config -> Config) -> Either a (m Config) -> Either a (m Config)
forall a b. (a -> b) -> a -> b
$ \Config
config -> Config
config {configHtmlOutput :: Bool
configHtmlOutput = Bool
True}

    setOutputFile :: String -> Config -> Config
    setOutputFile :: String -> Config -> Config
setOutputFile String
file Config
c = Config
c {configOutputFile :: Either Handle String
configOutputFile = String -> Either Handle String
forall a b. b -> Either a b
Right String
file}

recognizedOptions :: [OptDescr (Result Maybe -> Result Maybe)]
recognizedOptions :: [OptDescr (Result Maybe -> Result Maybe)]
recognizedOptions = [OptDescr (Result Maybe -> Result Maybe)]
commandLineOptions [OptDescr (Result Maybe -> Result Maybe)]
-> [OptDescr (Result Maybe -> Result Maybe)]
-> [OptDescr (Result Maybe -> Result Maybe)]
forall a. [a] -> [a] -> [a]
++ [OptDescr (Result Maybe -> Result Maybe)]
forall (m :: * -> *). Monad m => [OptDescr (Result m -> Result m)]
configFileOptions [OptDescr (Result Maybe -> Result Maybe)]
-> [OptDescr (Result Maybe -> Result Maybe)]
-> [OptDescr (Result Maybe -> Result Maybe)]
forall a. [a] -> [a] -> [a]
++ [OptDescr (Result Maybe -> Result Maybe)]
forall (m :: * -> *). Monad m => [OptDescr (Result m -> Result m)]
undocumentedOptions

parseOptions :: Config -> String -> [ConfigFile] -> Maybe EnvVar -> [String] -> Either (ExitCode, String) Config
parseOptions :: Config
-> String
-> [ConfigFile]
-> Maybe [String]
-> [String]
-> Either (ExitCode, String) Config
parseOptions Config
config String
prog [ConfigFile]
configFiles Maybe [String]
envVar [String]
args = do
      (Config -> ConfigFile -> Either (ExitCode, String) Config)
-> Config -> [ConfigFile] -> Either (ExitCode, String) Config
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (String -> Config -> ConfigFile -> Either (ExitCode, String) Config
parseFileOptions String
prog) Config
config [ConfigFile]
configFiles
  Either (ExitCode, String) Config
-> (Config -> Either (ExitCode, String) Config)
-> Either (ExitCode, String) Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> Maybe [String] -> Config -> Either (ExitCode, String) Config
parseEnvVarOptions String
prog Maybe [String]
envVar
  Either (ExitCode, String) Config
-> (Config -> Either (ExitCode, String) Config)
-> Either (ExitCode, String) Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> [String] -> Config -> Either (ExitCode, String) Config
parseCommandLineOptions String
prog [String]
args

parseCommandLineOptions :: String -> [String] -> Config -> Either (ExitCode, String) Config
parseCommandLineOptions :: String -> [String] -> Config -> Either (ExitCode, String) Config
parseCommandLineOptions String
prog [String]
args Config
config = case [OptDescr (Result Maybe -> Result Maybe)]
-> Config -> [String] -> Either String (Maybe Config)
forall (m :: * -> *).
Monad m =>
[OptDescr (Result m -> Result m)]
-> Config -> [String] -> Either String (m Config)
parse [OptDescr (Result Maybe -> Result Maybe)]
recognizedOptions Config
config [String]
args of
  Right Maybe Config
Nothing -> (ExitCode, String) -> Either (ExitCode, String) Config
forall a b. a -> Either a b
Left (ExitCode
ExitSuccess, String
usage)
  Right (Just Config
c) -> Config -> Either (ExitCode, String) Config
forall a b. b -> Either a b
Right Config
c
  Left String
err -> String -> Either (ExitCode, String) Config
forall b. String -> Either (ExitCode, String) b
failure String
err
  where
    failure :: String -> Either (ExitCode, String) b
failure String
err = (ExitCode, String) -> Either (ExitCode, String) b
forall a b. a -> Either a b
Left (Int -> ExitCode
ExitFailure Int
1, String
prog String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nTry `" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prog String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" --help' for more information.\n")

    usage :: String
    usage :: String
usage = String
"Usage: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prog String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" [OPTION]...\n\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, [OptDescr (Result Maybe -> Result Maybe)]) -> String)
-> [(String, [OptDescr (Result Maybe -> Result Maybe)])]
-> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> [OptDescr (Result Maybe -> Result Maybe)] -> String)
-> (String, [OptDescr (Result Maybe -> Result Maybe)]) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> [OptDescr (Result Maybe -> Result Maybe)] -> String
forall a. String -> [OptDescr a] -> String
mkUsageInfo) [(String, [OptDescr (Result Maybe -> Result Maybe)])]
documentedOptions)

parseFileOptions :: String -> Config -> ConfigFile -> Either (ExitCode, String) Config
parseFileOptions :: String -> Config -> ConfigFile -> Either (ExitCode, String) Config
parseFileOptions String
prog Config
config (String
name, [String]
args) =
  String
-> String -> [String] -> Config -> Either (ExitCode, String) Config
parseOtherOptions String
prog (String
"in config file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name) [String]
args Config
config

parseEnvVarOptions :: String -> (Maybe EnvVar) -> Config -> Either (ExitCode, String) Config
parseEnvVarOptions :: String
-> Maybe [String] -> Config -> Either (ExitCode, String) Config
parseEnvVarOptions String
prog Maybe [String]
args =
  String
-> String -> [String] -> Config -> Either (ExitCode, String) Config
parseOtherOptions String
prog (String
"from environment variable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
envVarName) ([String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [String]
args)

parseOtherOptions :: String -> String -> [String] -> Config -> Either (ExitCode, String) Config
parseOtherOptions :: String
-> String -> [String] -> Config -> Either (ExitCode, String) Config
parseOtherOptions String
prog String
source [String]
args Config
config = case [OptDescr (Result Identity -> Result Identity)]
-> Config -> [String] -> Either String (Identity Config)
forall (m :: * -> *).
Monad m =>
[OptDescr (Result m -> Result m)]
-> Config -> [String] -> Either String (m Config)
parse [OptDescr (Result Identity -> Result Identity)]
forall (m :: * -> *). Monad m => [OptDescr (Result m -> Result m)]
configFileOptions Config
config [String]
args of
  Right (Identity Config
c) -> Config -> Either (ExitCode, String) Config
forall a b. b -> Either a b
Right Config
c
  Left String
err -> String -> Either (ExitCode, String) Config
forall b. String -> Either (ExitCode, String) b
failure String
err
  where
    failure :: String -> Either (ExitCode, String) b
failure String
err = (ExitCode, String) -> Either (ExitCode, String) b
forall a b. a -> Either a b
Left (Int -> ExitCode
ExitFailure Int
1, String
prog String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
message)
      where
        message :: String
message = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ case String -> [String]
lines String
err of
          [String
x] -> [String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
source]
          [String]
xs -> [String]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
source]

parse :: Monad m => [OptDescr (Result m -> Result m)] -> Config -> [String] -> Either String (m Config)
parse :: [OptDescr (Result m -> Result m)]
-> Config -> [String] -> Either String (m Config)
parse [OptDescr (Result m -> Result m)]
options Config
config [String]
args = case ArgOrder (Result m -> Result m)
-> [OptDescr (Result m -> Result m)]
-> [String]
-> ([Result m -> Result m], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder (Result m -> Result m)
forall a. ArgOrder a
Permute [OptDescr (Result m -> Result m)]
options [String]
args of
  ([Result m -> Result m]
opts, [], []) -> case (Result m -> (Result m -> Result m) -> Result m)
-> Result m -> [Result m -> Result m] -> Result m
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((Result m -> Result m) -> Result m -> Result m)
-> Result m -> (Result m -> Result m) -> Result m
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Result m -> Result m) -> Result m -> Result m
forall a. a -> a
id) (m Config -> Result m
forall a b. b -> Either a b
Right (m Config -> Result m) -> m Config -> Result m
forall a b. (a -> b) -> a -> b
$ Config -> m Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
config) [Result m -> Result m]
opts of
    Left (InvalidArgument String
name String
value) -> String -> Either String (m Config)
forall a b. a -> Either a b
Left (String
"invalid argument `" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
value String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' for `--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'")
    Right m Config
x -> m Config -> Either String (m Config)
forall a b. b -> Either a b
Right m Config
x
  ([Result m -> Result m]
_, [String]
_, String
err:[String]
_) -> String -> Either String (m Config)
forall a b. a -> Either a b
Left (ShowS
forall a. [a] -> [a]
init String
err)
  ([Result m -> Result m]
_, String
arg:[String]
_, [String]
_) -> String -> Either String (m Config)
forall a b. a -> Either a b
Left (String
"unexpected argument `" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
arg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'")

ignoreConfigFile :: Config -> [String] -> IO Bool
ignoreConfigFile :: Config -> [String] -> IO Bool
ignoreConfigFile Config
config [String]
args = do
  Maybe String
ignore <- String -> IO (Maybe String)
lookupEnv String
"IGNORE_DOT_HSPEC"
  case Maybe String
ignore of
    Just String
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Maybe String
Nothing -> case [OptDescr (Result Maybe -> Result Maybe)]
-> Config -> [String] -> Either String (Maybe Config)
forall (m :: * -> *).
Monad m =>
[OptDescr (Result m -> Result m)]
-> Config -> [String] -> Either String (m Config)
parse [OptDescr (Result Maybe -> Result Maybe)]
recognizedOptions Config
config [String]
args of
      Right (Just Config
c) -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Bool
configIgnoreConfigFile Config
c)
      Either String (Maybe Config)
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False