{-# LANGUAGE CPP #-}
module Test.Hspec.Core.Config (
  Config (..)
, ColorMode(..)
, UnicodeMode(..)
, defaultConfig
, readConfig
, configAddFilter
, configQuickCheckArgs

, readFailureReportOnRerun
, applyFailureReport
#ifdef TEST
, readConfigFiles
#endif
) where

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

import           GHC.IO.Exception (IOErrorType(UnsupportedOperation))
import           System.IO
import           System.IO.Error
import           System.Exit
import           System.FilePath
import           System.Directory
import           System.Environment (getProgName, getEnvironment)
import qualified Test.QuickCheck as QC

import           Test.Hspec.Core.Util
import           Test.Hspec.Core.Config.Options
import           Test.Hspec.Core.Config.Definition
import           Test.Hspec.Core.FailureReport
import           Test.Hspec.Core.QuickCheck.Util (mkGen)
import           Test.Hspec.Core.Example (Params(..), defaultParams)
import qualified Test.Hspec.Core.Formatters.V2 as V2

defaultConfig :: Config
defaultConfig :: Config
defaultConfig = [(String, FormatConfig -> IO Format)] -> Config
mkDefaultConfig ([(String, FormatConfig -> IO Format)] -> Config)
-> [(String, FormatConfig -> IO Format)] -> Config
forall a b. (a -> b) -> a -> b
$ ((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 a b. (a -> b) -> (String, a) -> (String, b)
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)
  ]

-- | Add a filter predicate to config.  If there is already a filter predicate,
-- then combine them with `||`.
configAddFilter :: (Path -> Bool) -> Config -> Config
configAddFilter :: (Path -> Bool) -> Config -> Config
configAddFilter Path -> Bool
p1 Config
c = Config
c {
    configFilterPredicate = Just p1 `filterOr` configFilterPredicate c
  }

applyFailureReport :: Maybe FailureReport -> Config -> Config
applyFailureReport :: Maybe FailureReport -> Config -> Config
applyFailureReport Maybe FailureReport
mFailureReport Config
config = Config
config {
    configFilterPredicate = matchFilter `filterOr` rerunFilter
  , configSeed = mSeed
  , configQuickCheckMaxSuccess = mMaxSuccess
  , configQuickCheckMaxDiscardRatio = mMaxDiscardRatio
  , configQuickCheckMaxSize = mMaxSize
  }
  where

    mSeed :: Maybe Integer
mSeed = Config -> Maybe Integer
configSeed Config
config Maybe Integer -> Maybe Integer -> Maybe Integer
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe Integer
deprecatedQuickCheckSeed Config
config Maybe Integer -> Maybe Integer -> Maybe Integer
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FailureReport -> Integer
failureReportSeed (FailureReport -> Integer) -> Maybe FailureReport -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FailureReport
mFailureReport)
    mMaxSuccess :: Maybe Int
mMaxSuccess = Config -> Maybe Int
configQuickCheckMaxSuccess Config
config Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FailureReport -> Int
failureReportMaxSuccess (FailureReport -> Int) -> Maybe FailureReport -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FailureReport
mFailureReport)
    mMaxSize :: Maybe Int
mMaxSize = Config -> Maybe Int
configQuickCheckMaxSize Config
config Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FailureReport -> Int
failureReportMaxSize (FailureReport -> Int) -> Maybe FailureReport -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FailureReport
mFailureReport)
    mMaxDiscardRatio :: Maybe Int
mMaxDiscardRatio = Config -> Maybe Int
configQuickCheckMaxDiscardRatio Config
config Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FailureReport -> Int
failureReportMaxDiscardRatio (FailureReport -> Int) -> Maybe FailureReport -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FailureReport
mFailureReport)

    matchFilter :: Maybe (Path -> Bool)
matchFilter = Config -> Maybe (Path -> Bool)
configFilterPredicate Config
config

    rerunFilter :: Maybe (Path -> Bool)
rerunFilter = case FailureReport -> [Path]
failureReportPaths (FailureReport -> [Path]) -> Maybe FailureReport -> Maybe [Path]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FailureReport
mFailureReport of
      Just [] -> Maybe (Path -> Bool)
forall a. Maybe a
Nothing
      Just [Path]
xs -> (Path -> Bool) -> Maybe (Path -> Bool)
forall a. a -> Maybe a
Just (Path -> [Path] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Path]
xs)
      Maybe [Path]
Nothing -> Maybe (Path -> Bool)
forall a. Maybe a
Nothing

configQuickCheckArgs :: Config -> QC.Args
configQuickCheckArgs :: Config -> Args
configQuickCheckArgs Config
c = Args
qcArgs
  where
    qcArgs :: Args
qcArgs = (
        (Args -> Args)
-> (Integer -> Args -> Args) -> Maybe Integer -> Args -> Args
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Args -> Args
forall a. a -> a
id Integer -> Args -> Args
setSeed (Config -> Maybe Integer
configSeed Config
c)
      (Args -> Args) -> (Args -> Args) -> Args -> Args
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Args -> Args)
-> (Int -> Args -> Args) -> Maybe Int -> Args -> Args
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Args -> Args
forall a. a -> a
id Int -> Args -> Args
setMaxShrinks (Config -> Maybe Int
configQuickCheckMaxShrinks Config
c)
      (Args -> Args) -> (Args -> Args) -> Args -> Args
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Args -> Args)
-> (Int -> Args -> Args) -> Maybe Int -> Args -> Args
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Args -> Args
forall a. a -> a
id Int -> Args -> Args
setMaxSize (Config -> Maybe Int
configQuickCheckMaxSize Config
c)
      (Args -> Args) -> (Args -> Args) -> Args -> Args
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Args -> Args)
-> (Int -> Args -> Args) -> Maybe Int -> Args -> Args
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Args -> Args
forall a. a -> a
id Int -> Args -> Args
setMaxDiscardRatio (Config -> Maybe Int
configQuickCheckMaxDiscardRatio Config
c)
      (Args -> Args) -> (Args -> Args) -> Args -> Args
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Args -> Args)
-> (Int -> Args -> Args) -> Maybe Int -> Args -> Args
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Args -> Args
forall a. a -> a
id Int -> Args -> Args
setMaxSuccess (Config -> Maybe Int
configQuickCheckMaxSuccess Config
c)) (Params -> Args
paramsQuickCheckArgs Params
defaultParams)

    setMaxSuccess :: Int -> QC.Args -> QC.Args
    setMaxSuccess :: Int -> Args -> Args
setMaxSuccess Int
n Args
args = Args
args {QC.maxSuccess = n}

    setMaxDiscardRatio :: Int -> QC.Args -> QC.Args
    setMaxDiscardRatio :: Int -> Args -> Args
setMaxDiscardRatio Int
n Args
args = Args
args {QC.maxDiscardRatio = n}

    setMaxSize :: Int -> QC.Args -> QC.Args
    setMaxSize :: Int -> Args -> Args
setMaxSize Int
n Args
args = Args
args {QC.maxSize = n}

    setMaxShrinks :: Int -> QC.Args -> QC.Args
    setMaxShrinks :: Int -> Args -> Args
setMaxShrinks Int
n Args
args = Args
args {QC.maxShrinks = n}

    setSeed :: Integer -> QC.Args -> QC.Args
    setSeed :: Integer -> Args -> Args
setSeed Integer
n Args
args = Args
args {QC.replay = Just (mkGen (fromIntegral n), 0)}

-- |
-- `readConfig` parses config options from several sources and constructs a
-- `Config` value.  It takes options from:
--
-- 1. @~/.hspec@ (a config file in the user's home directory)
-- 1. @.hspec@ (a config file in the current working directory)
-- 1. [environment variables starting with @HSPEC_@](https://hspec.github.io/options.html#specifying-options-through-environment-variables)
-- 1. the provided list of command-line options (the second argument to @readConfig@)
--
-- (precedence from low to high)
--
-- When parsing fails then @readConfig@ writes an error message to `stderr` and
-- exits with `exitFailure`.
--
-- When @--help@ is provided as a command-line option then @readConfig@ writes
-- a help message to `stdout` and exits with `exitSuccess`.
--
-- A common way to use @readConfig@ is:
--
-- @
-- `System.Environment.getArgs` >>= readConfig `defaultConfig`
-- @
readConfig :: Config -> [String] -> IO Config
readConfig :: Config -> [String] -> IO Config
readConfig Config
opts_ [String]
args = do
  String
prog <- IO String
getProgName
  [ConfigFile]
configFiles <- do
    Bool
ignore <- Config -> [String] -> IO Bool
ignoreConfigFile Config
opts_ [String]
args
    case Bool
ignore of
      Bool
True -> [ConfigFile] -> IO [ConfigFile]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      Bool
False -> IO [ConfigFile]
readConfigFiles
  [(String, String)]
env <- IO [(String, String)]
getEnvironment
  let envVar :: Maybe [String]
envVar = String -> [String]
words (String -> [String]) -> Maybe String -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
envVarName [(String, String)]
env
  case Config
-> String
-> [ConfigFile]
-> Maybe [String]
-> [(String, String)]
-> [String]
-> Either (ExitCode, String) ([String], Config)
parseOptions Config
opts_ String
prog [ConfigFile]
configFiles Maybe [String]
envVar [(String, String)]
env [String]
args of
    Left (ExitCode
err, String
msg) -> ExitCode -> String -> IO Config
forall a. ExitCode -> String -> IO a
exitWithMessage ExitCode
err String
msg
    Right ([String]
warnings, Config
opts) -> do
      (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
stderr) [String]
warnings
      Config -> IO Config
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Config
opts

readFailureReportOnRerun :: Config -> IO (Maybe FailureReport)
readFailureReportOnRerun :: Config -> IO (Maybe FailureReport)
readFailureReportOnRerun Config
config
  | Config -> Bool
configRerun Config
config = Config -> IO (Maybe FailureReport)
readFailureReport Config
config
  | Bool
otherwise = Maybe FailureReport -> IO (Maybe FailureReport)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FailureReport
forall a. Maybe a
Nothing

readConfigFiles :: IO [ConfigFile]
readConfigFiles :: IO [ConfigFile]
readConfigFiles = do
  Maybe ConfigFile
global <- IO (Maybe ConfigFile)
readGlobalConfigFile
  Maybe ConfigFile
local <- IO (Maybe ConfigFile)
readLocalConfigFile
  [ConfigFile] -> IO [ConfigFile]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ConfigFile] -> IO [ConfigFile])
-> [ConfigFile] -> IO [ConfigFile]
forall a b. (a -> b) -> a -> b
$ [Maybe ConfigFile] -> [ConfigFile]
forall a. [Maybe a] -> [a]
catMaybes [Maybe ConfigFile
global, Maybe ConfigFile
local]

readGlobalConfigFile :: IO (Maybe ConfigFile)
readGlobalConfigFile :: IO (Maybe ConfigFile)
readGlobalConfigFile = do
  Either () String
mHome <- (IOError -> Maybe ()) -> IO String -> IO (Either () String)
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isPotentialHomeDirError) IO String
getHomeDirectory
  case Either () String
mHome of
    Left ()
_ -> Maybe ConfigFile -> IO (Maybe ConfigFile)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConfigFile
forall a. Maybe a
Nothing
    Right String
home -> String -> IO (Maybe ConfigFile)
readConfigFile (String
home String -> String -> String
</> String
".hspec")
  where
    isPotentialHomeDirError :: IOError -> Bool
isPotentialHomeDirError IOError
e =
      IOError -> Bool
isDoesNotExistError IOError
e Bool -> Bool -> Bool
|| IOError -> IOErrorType
ioeGetErrorType IOError
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
UnsupportedOperation

readLocalConfigFile :: IO (Maybe ConfigFile)
readLocalConfigFile :: IO (Maybe ConfigFile)
readLocalConfigFile = do
  Either () String
mName <- (IOError -> Maybe ()) -> IO String -> IO (Either () String)
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError) (String -> IO String
canonicalizePath String
".hspec")
  case Either () String
mName of
    Left ()
_ -> Maybe ConfigFile -> IO (Maybe ConfigFile)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConfigFile
forall a. Maybe a
Nothing
    Right String
name -> String -> IO (Maybe ConfigFile)
readConfigFile String
name

readConfigFile :: FilePath -> IO (Maybe ConfigFile)
readConfigFile :: String -> IO (Maybe ConfigFile)
readConfigFile String
name = do
  Bool
exists <- String -> IO Bool
doesFileExist String
name
  if Bool
exists then ConfigFile -> Maybe ConfigFile
forall a. a -> Maybe a
Just (ConfigFile -> Maybe ConfigFile)
-> (String -> ConfigFile) -> String -> Maybe ConfigFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
name ([String] -> ConfigFile)
-> (String -> [String]) -> String -> ConfigFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
unescapeArgs (String -> Maybe ConfigFile) -> IO String -> IO (Maybe ConfigFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
name else Maybe ConfigFile -> IO (Maybe ConfigFile)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConfigFile
forall a. Maybe a
Nothing

exitWithMessage :: ExitCode -> String -> IO a
exitWithMessage :: forall a. ExitCode -> String -> IO a
exitWithMessage ExitCode
err String
msg = do
  Handle -> String -> IO ()
hPutStr Handle
h String
msg
  ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith ExitCode
err
  where
    h :: Handle
h = case ExitCode
err of
      ExitCode
ExitSuccess -> Handle
stdout
      ExitCode
_           -> Handle
stderr