{-# 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)
  (String, [Option Config])
-> [(String, [Option Config])] -> [(String, [Option Config])]
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
_ -> Bool -> IO Bool
forall a. a -> IO a
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 -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Bool
configIgnoreConfigFile Config
c)
      Either (ExitCode, String) Config
_ -> Bool -> IO Bool
forall a. a -> IO a
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
      (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 a b.
Either (ExitCode, String) a
-> (a -> Either (ExitCode, String) b)
-> Either (ExitCode, String) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Config -> Either (ExitCode, String) Config)
-> ([String] -> Config -> Either (ExitCode, String) Config)
-> Maybe [String]
-> Config
-> Either (ExitCode, String) Config
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Config -> Either (ExitCode, String) Config
forall a. a -> Either (ExitCode, String) a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String] -> Config -> Either (ExitCode, String) Config
parseEnvVarOptions String
prog) Maybe [String]
envVar
  Either (ExitCode, String) Config
-> (Config -> Either (ExitCode, String) ([String], Config))
-> Either (ExitCode, String) ([String], Config)
forall a b.
Either (ExitCode, String) a
-> (a -> Either (ExitCode, String) b)
-> Either (ExitCode, String) b
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
  Either (ExitCode, String) ([String], Config)
-> (([String], Config)
    -> Either (ExitCode, String) ([String], Config))
-> Either (ExitCode, String) ([String], Config)
forall a b.
Either (ExitCode, String) a
-> (a -> Either (ExitCode, String) b)
-> Either (ExitCode, String) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Config -> Either (ExitCode, String) Config)
-> ([String], Config)
-> Either (ExitCode, String) ([String], Config)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ([String], a) -> f ([String], b)
traverse (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 [(String, [Option Config])]
-> String -> [String] -> Config -> ParseResult Config
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 -> Config -> Either (ExitCode, String) Config
forall a b. b -> Either a b
Right Config
c
  Help String
message -> (ExitCode, String) -> Either (ExitCode, String) Config
forall a b. a -> Either a b
Left (ExitCode
ExitSuccess, String
message)
  Failure String
message -> (ExitCode, String) -> Either (ExitCode, String) Config
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 String
-> [(String, String)]
-> Config
-> [Option Config]
-> ([InvalidValue], Config)
forall config.
String
-> [(String, String)]
-> config
-> [Option config]
-> ([InvalidValue], config)
Declarative.parseEnvironmentOptions String
"HSPEC" [(String, String)]
env Config
config (((String, [Option Config]) -> [Option Config])
-> [(String, [Option Config])] -> [Option Config]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [Option Config]) -> [Option Config]
forall a b. (a, b) -> b
snd ([(String, [Option Config])] -> [Option Config])
-> [(String, [Option Config])] -> [Option Config]
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) -> ([String], Config) -> Either (ExitCode, String) ([String], Config)
forall a b. b -> Either a b
Right ((InvalidValue -> String) -> [InvalidValue] -> [String]
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 `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
value String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' for environment variable " String -> String -> String
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 " String -> String -> String
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 " String -> String -> String
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 [OptDescr (Config -> Either InvalidArgument Config)]
-> Config -> [String] -> Either String Config
forall config.
[OptDescr (config -> Either InvalidArgument config)]
-> config -> [String] -> Either String config
parse ([Option Config]
-> [OptDescr (Config -> Either InvalidArgument Config)]
forall config.
[Option config]
-> [OptDescr (config -> Either InvalidArgument config)]
interpretOptions [Option Config]
options) Config
config [String]
args of
  Right 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
    options :: [Declarative.Option Config]
    options :: [Option Config]
options = (Option Config -> Bool) -> [Option Config] -> [Option Config]
forall a. (a -> Bool) -> [a] -> [a]
filter Option Config -> Bool
forall config. Option config -> Bool
Declarative.optionDocumented ([Option Config] -> [Option Config])
-> [Option Config] -> [Option Config]
forall a b. (a -> b) -> a -> b
$ ((String, [Option Config]) -> [Option Config])
-> [(String, [Option Config])] -> [Option Config]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [Option Config]) -> [Option Config]
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 = (ExitCode, String) -> Either (ExitCode, String) b
forall a b. a -> Either a b
Left (Int -> ExitCode
ExitFailure Int
1, String
prog String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
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 -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
source]
          [String]
xs -> [String]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
source]