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

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

import           System.Exit
import           System.Console.GetOpt

import           Test.Hspec.Core.Format (Format, FormatConfig)
import qualified Test.Hspec.Core.Formatters.V1 as V1
import qualified Test.Hspec.Core.Formatters.V2 as V2
import           Test.Hspec.Core.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 -> Maybe Int
configPrintSlowItems :: Maybe Int
, 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 -> Maybe Int
configQuickCheckMaxShrinks :: Maybe Int
, Config -> Int
configSmallCheckDepth :: Int
, Config -> ColorMode
configColorMode :: ColorMode
, Config -> Bool
configDiff :: Bool
, Config -> Bool
configTimes :: Bool
, Config -> Maybe (FormatConfig -> IO Format)
configFormat :: Maybe (FormatConfig -> IO Format)
, Config -> Maybe Formatter
configFormatter :: Maybe V1.Formatter -- ^ deprecated, use `configFormat` instead
, Config -> Bool
configHtmlOutput :: Bool
, Config -> Maybe Int
configConcurrentJobs :: Maybe Int
}

defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Bool
-> Bool
-> Bool
-> Bool
-> Maybe Int
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Bool
-> Bool
-> Maybe (Path -> Bool)
-> Maybe (Path -> Bool)
-> Maybe Integer
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Int
-> ColorMode
-> Bool
-> Bool
-> Maybe (FormatConfig -> IO Format)
-> Maybe Formatter
-> Bool
-> Maybe Int
-> Config
Config {
  configIgnoreConfigFile :: Bool
configIgnoreConfigFile = Bool
False
, configDryRun :: Bool
configDryRun = Bool
False
, configFocusedOnly :: Bool
configFocusedOnly = Bool
False
, configFailOnFocused :: Bool
configFailOnFocused = Bool
False
, configPrintSlowItems :: Maybe Int
configPrintSlowItems = Maybe Int
forall a. Maybe a
Nothing
, configPrintCpuTime :: Bool
configPrintCpuTime = Bool
False
, 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
, configQuickCheckMaxShrinks :: Maybe Int
configQuickCheckMaxShrinks = 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
, configTimes :: Bool
configTimes = Bool
False
, 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
}

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}

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

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

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

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

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)

printSlowItemsOption :: Monad m => OptDescr (Result m -> Result m)
printSlowItemsOption :: OptDescr (Result m -> Result m)
printSlowItemsOption = String
-> [String]
-> ArgDescr (Result m -> Result m)
-> String
-> OptDescr (Result m -> Result m)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"p" [String
name] ((Maybe String -> Result m -> Result m)
-> String -> ArgDescr (Result m -> Result m)
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg Maybe String -> Result m -> Result m
arg String
"N") String
"print the N slowest spec items (default: 10)"
  where
    name :: String
name = String
"print-slow-items"
    setter :: Maybe Int -> Config -> Config
setter Maybe Int
v Config
c = Config
c {configPrintSlowItems :: Maybe Int
configPrintSlowItems = Maybe Int
v}
    arg :: Maybe String -> Result m -> Result m
arg = (Result m -> Result m)
-> (String -> Result m -> Result m)
-> Maybe String
-> Result m
-> Result m
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Config -> Config) -> Result m -> Result m
forall (m :: * -> *) a.
Monad m =>
(Config -> Config) -> Either a (m Config) -> Either a (m Config)
set (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 -> Result m -> Result m
forall (m :: * -> *).
Monad m =>
String
-> Either InvalidArgument (m Config)
-> Either InvalidArgument (m Config)
parseArg
    parseArg :: String
-> Either InvalidArgument (m Config)
-> Either InvalidArgument (m Config)
parseArg 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 Int
forall a. Read a => String -> Maybe a
readMaybe String
input of
      Just Int
0 -> m Config -> Either InvalidArgument (m Config)
forall a b. b -> Either a b
Right (Maybe Int -> Config -> Config
setter Maybe Int
forall a. Maybe a
Nothing (Config -> Config) -> m Config -> m Config
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m Config
c)
      Just Int
n -> m Config -> Either InvalidArgument (m Config)
forall a b. b -> Either a b
Right (Maybe Int -> Config -> Config
setter (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) (Config -> Config) -> m Config -> m Config
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m Config
c)
      Maybe Int
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 (FormatConfig -> IO Format)
-> 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 (FormatConfig -> IO Format))
-> ((FormatConfig -> IO Format) -> Config -> Config)
-> Arg (FormatConfig -> IO Format)
forall a.
String -> (String -> Maybe a) -> (a -> Config -> Config) -> Arg a
Arg String
"FORMATTER" String -> Maybe (FormatConfig -> IO Format)
readFormatter (FormatConfig -> IO Format) -> 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
-> (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
"times" Bool -> Config -> Config
setTimes String
"report times for individual spec items"
  , [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"]
  , [OptDescr (Result m -> Result m)
forall (m :: * -> *). Monad m => OptDescr (Result m -> Result m)
printSlowItemsOption]
  ]
  where
    formatters :: [(String, FormatConfig -> IO Format)]
    formatters :: [(String, FormatConfig -> IO Format)]
formatters = ((String, Formatter) -> (String, FormatConfig -> IO Format))
-> [(String, Formatter)] -> [(String, FormatConfig -> IO Format)]
forall a b. (a -> b) -> [a] -> [b]
map ((Formatter -> FormatConfig -> IO Format)
-> (String, Formatter) -> (String, FormatConfig -> IO Format)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Formatter -> FormatConfig -> IO Format
V2.formatterToFormat) [
        (String
"checks", Formatter
V2.checks)
      , (String
"specdoc", Formatter
V2.specdoc)
      , (String
"progress", Formatter
V2.progress)
      , (String
"failed-examples", Formatter
V2.failed_examples)
      , (String
"silent", Formatter
V2.silent)
      ]

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

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

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

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

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

    setTimes :: Bool -> Config -> Config
    setTimes :: Bool -> Config -> Config
setTimes Bool
v Config
config = Config
config {configTimes :: Bool
configTimes = 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-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 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-shrinks" (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
setMaxShrinks) String
"maximum number of shrinks to perform before giving up (a value of 0 turns shrinking off)"
  , 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"
  ]
  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}

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