{-# LANGUAGE CPP #-}
module Test.Hspec.Core.Config.Options (
  ConfigFile
, envVarName
, ignoreConfigFile
, parseOptions
) where

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

import           System.Exit

import           Test.Hspec.Core.Format (Format, FormatConfig)
import           Test.Hspec.Core.Config.Definition
import qualified GetOpt.Declarative as Declarative
import           GetOpt.Declarative.Interpret (parse, interpretOptions, ParseResult(..))

type ConfigFile = (FilePath, [String])
type EnvVar = [String]

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

commandLineOptions :: [(String, FormatConfig -> IO Format)] -> [(String, [Declarative.Option Config])]
commandLineOptions :: [(String, FormatConfig -> IO Format)]
-> [(String, [Option Config])]
commandLineOptions [(String, FormatConfig -> IO Format)]
formatters =
    (String
"OPTIONS", [Option Config]
commandLineOnlyOptions)
  forall a. a -> [a] -> [a]
: [(String, FormatConfig -> IO Format)]
-> [(String, [Option Config])]
otherOptions [(String, FormatConfig -> IO Format)]
formatters

otherOptions :: [(String, FormatConfig -> IO Format)] -> [(String, [Declarative.Option Config])]
otherOptions :: [(String, FormatConfig -> IO Format)]
-> [(String, [Option Config])]
otherOptions [(String, FormatConfig -> IO Format)]
formatters = [
    (String
"RUNNER OPTIONS", [Option Config]
runnerOptions)
  , (String
"FORMATTER OPTIONS", [(String, FormatConfig -> IO Format)] -> [Option Config]
formatterOptions [(String, FormatConfig -> IO Format)]
formatters)
  , (String
"OPTIONS FOR QUICKCHECK", [Option Config]
quickCheckOptions)
  , (String
"OPTIONS FOR SMALLCHECK", [Option Config]
smallCheckOptions)
  ]

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
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Maybe String
Nothing -> case String -> [String] -> Config -> Either (ExitCode, String) Config
parseCommandLineOptions String
"" [String]
args Config
config of
      Right Config
c -> forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Bool
configIgnoreConfigFile Config
c)
      Either (ExitCode, String) Config
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

parseOptions :: Config -> String -> [ConfigFile] -> Maybe EnvVar -> [(String, String)] -> [String] -> Either (ExitCode, String) ([String], Config)
parseOptions :: Config
-> String
-> [ConfigFile]
-> Maybe [String]
-> [(String, String)]
-> [String]
-> Either (ExitCode, String) ([String], Config)
parseOptions Config
config String
prog [ConfigFile]
configFiles Maybe [String]
envVar [(String, String)]
env [String]
args = do
      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
  forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String] -> Config -> Either (ExitCode, String) Config
parseEnvVarOptions String
prog) Maybe [String]
envVar
  forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(String, String)]
-> Config -> Either (ExitCode, String) ([String], Config)
parseEnvironmentOptions [(String, String)]
env
  forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a b c.
Applicative f =>
(a -> f b) -> (c, a) -> f (c, b)
traverseTuple (String -> [String] -> Config -> Either (ExitCode, String) Config
parseCommandLineOptions String
prog [String]
args)

traverseTuple :: Applicative f => (a -> f b) -> (c, a) -> f (c, b)
#if MIN_VERSION_base(4,7,0)
traverseTuple :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> f b) -> (c, a) -> f (c, b)
traverseTuple = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
#else
traverseTuple f (c, a) = (,) c <$> f a
#endif

parseCommandLineOptions :: String -> [String] -> Config -> Either (ExitCode, String) Config
parseCommandLineOptions :: String -> [String] -> Config -> Either (ExitCode, String) Config
parseCommandLineOptions String
prog [String]
args Config
config = case forall config.
[(String, [Option config])]
-> String -> [String] -> config -> ParseResult config
Declarative.parseCommandLineOptions ([(String, FormatConfig -> IO Format)]
-> [(String, [Option Config])]
commandLineOptions [(String, FormatConfig -> IO Format)]
formatters) String
prog [String]
args Config
config of
  Success Config
c -> forall a b. b -> Either a b
Right Config
c
  Help String
message -> forall a b. a -> Either a b
Left (ExitCode
ExitSuccess, String
message)
  Failure String
message -> forall a b. a -> Either a b
Left (Int -> ExitCode
ExitFailure Int
1, String
message)
  where
    formatters :: [(String, FormatConfig -> IO Format)]
formatters = Config -> [(String, FormatConfig -> IO Format)]
configAvailableFormatters Config
config

parseEnvironmentOptions :: [(String, String)] -> Config -> Either (ExitCode, String) ([String], Config)
parseEnvironmentOptions :: [(String, String)]
-> Config -> Either (ExitCode, String) ([String], Config)
parseEnvironmentOptions [(String, String)]
env Config
config = case forall config.
String
-> [(String, String)]
-> config
-> [Option config]
-> ([InvalidValue], config)
Declarative.parseEnvironmentOptions String
"HSPEC" [(String, String)]
env Config
config (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ [(String, FormatConfig -> IO Format)]
-> [(String, [Option Config])]
commandLineOptions [(String, FormatConfig -> IO Format)]
formatters) of
  ([InvalidValue]
warnings, Config
c) -> forall a b. b -> Either a b
Right (forall a b. (a -> b) -> [a] -> [b]
map InvalidValue -> String
formatWarning [InvalidValue]
warnings, Config
c)
  where
    formatters :: [(String, FormatConfig -> IO Format)]
formatters = Config -> [(String, FormatConfig -> IO Format)]
configAvailableFormatters Config
config
    formatWarning :: InvalidValue -> String
formatWarning (Declarative.InvalidValue String
name String
value) = String
"invalid value `" forall a. [a] -> [a] -> [a]
++ String
value forall a. [a] -> [a] -> [a]
++ String
"' for environment variable " forall a. [a] -> [a] -> [a]
++ String
name

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 " forall a. [a] -> [a] -> [a]
++ String
name) [String]
args Config
config

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

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 forall config.
[OptDescr (config -> Either InvalidArgument config)]
-> config -> [String] -> Either String config
parse (forall config.
[Option config]
-> [OptDescr (config -> Either InvalidArgument config)]
interpretOptions [Option Config]
options) Config
config [String]
args of
  Right Config
c -> forall a b. b -> Either a b
Right Config
c
  Left String
err -> forall {b}. String -> Either (ExitCode, String) b
failure String
err
  where
    options :: [Declarative.Option Config]
    options :: [Option Config]
options = forall a. (a -> Bool) -> [a] -> [a]
filter forall config. Option config -> Bool
Declarative.optionDocumented forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd ([(String, FormatConfig -> IO Format)]
-> [(String, [Option Config])]
otherOptions [(String, FormatConfig -> IO Format)]
formatters)

    formatters :: [(String, FormatConfig -> IO Format)]
formatters = Config -> [(String, FormatConfig -> IO Format)]
configAvailableFormatters Config
config

    failure :: String -> Either (ExitCode, String) b
failure String
err = forall a b. a -> Either a b
Left (Int -> ExitCode
ExitFailure Int
1, String
prog forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
message)
      where
        message :: String
message = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ case String -> [String]
lines String
err of
          [String
x] -> [String
x forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
source]
          [String]
xs -> [String]
xs forall a. [a] -> [a] -> [a]
++ [String
source]