{-# 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 (Config(..), ColorMode(..), UnicodeMode(..), mkDefaultConfig, filterOr)
import           Test.Hspec.Core.FailureReport
import           Test.Hspec.Core.QuickCheckUtil (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 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (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 :: Maybe (Path -> Bool)
configFilterPredicate = forall a. a -> Maybe a
Just Path -> Bool
p1 Maybe (Path -> Bool)
-> Maybe (Path -> Bool) -> Maybe (Path -> Bool)
`filterOr` Config -> Maybe (Path -> Bool)
configFilterPredicate Config
c
  }

applyFailureReport :: Maybe FailureReport -> Config -> Config
applyFailureReport :: Maybe FailureReport -> Config -> Config
applyFailureReport Maybe FailureReport
mFailureReport Config
opts = Config
opts {
    configFilterPredicate :: Maybe (Path -> Bool)
configFilterPredicate = Maybe (Path -> Bool)
matchFilter Maybe (Path -> Bool)
-> Maybe (Path -> Bool) -> Maybe (Path -> Bool)
`filterOr` Maybe (Path -> Bool)
rerunFilter
  , configQuickCheckSeed :: Maybe Integer
configQuickCheckSeed = Maybe Integer
mSeed
  , configQuickCheckMaxSuccess :: Maybe Int
configQuickCheckMaxSuccess = Maybe Int
mMaxSuccess
  , configQuickCheckMaxDiscardRatio :: Maybe Int
configQuickCheckMaxDiscardRatio = Maybe Int
mMaxDiscardRatio
  , configQuickCheckMaxSize :: Maybe Int
configQuickCheckMaxSize = Maybe Int
mMaxSize
  }
  where

    mSeed :: Maybe Integer
mSeed = Config -> Maybe Integer
configQuickCheckSeed Config
opts forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FailureReport -> Integer
failureReportSeed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FailureReport
mFailureReport)
    mMaxSuccess :: Maybe Int
mMaxSuccess = Config -> Maybe Int
configQuickCheckMaxSuccess Config
opts forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FailureReport -> Int
failureReportMaxSuccess forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FailureReport
mFailureReport)
    mMaxSize :: Maybe Int
mMaxSize = Config -> Maybe Int
configQuickCheckMaxSize Config
opts forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FailureReport -> Int
failureReportMaxSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FailureReport
mFailureReport)
    mMaxDiscardRatio :: Maybe Int
mMaxDiscardRatio = Config -> Maybe Int
configQuickCheckMaxDiscardRatio Config
opts forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FailureReport -> Int
failureReportMaxDiscardRatio 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
opts

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

configQuickCheckArgs :: Config -> QC.Args
configQuickCheckArgs :: Config -> Args
configQuickCheckArgs Config
c = Args
qcArgs
  where
    qcArgs :: Args
qcArgs = (
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Integer -> Args -> Args
setSeed (Config -> Maybe Integer
configQuickCheckSeed Config
c)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Int -> Args -> Args
setMaxShrinks (Config -> Maybe Int
configQuickCheckMaxShrinks Config
c)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Int -> Args -> Args
setMaxSize (Config -> Maybe Int
configQuickCheckMaxSize Config
c)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Int -> Args -> Args
setMaxDiscardRatio (Config -> Maybe Int
configQuickCheckMaxDiscardRatio Config
c)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe 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 {maxSuccess :: Int
QC.maxSuccess = Int
n}

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

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

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

    setSeed :: Integer -> QC.Args -> QC.Args
    setSeed :: Integer -> Args -> Args
setSeed Integer
n Args
args = Args
args {replay :: Maybe (QCGen, Int)
QC.replay = forall a. a -> Maybe a
Just (Int -> QCGen
mkGen (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n), Int
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 -> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) -> forall a. ExitCode -> String -> IO a
exitWithMessage ExitCode
err String
msg
    Right ([String]
warnings, Config
opts) -> do
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
stderr) [String]
warnings
      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 = forall (m :: * -> *) a. Monad m => a -> m a
return 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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 <- forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust (forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isPotentialHomeDirError) IO String
getHomeDirectory
  case Either () String
mHome of
    Left ()
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Eq a => a -> a -> Bool
== IOErrorType
UnsupportedOperation

readLocalConfigFile :: IO (Maybe ConfigFile)
readLocalConfigFile :: IO (Maybe ConfigFile)
readLocalConfigFile = do
  Either () String
mName <- forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust (forall (f :: * -> *). Alternative f => Bool -> f ()
guard 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 ()
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
unescapeArgs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
name else forall (m :: * -> *) a. Monad m => a -> m a
return 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
  forall a. ExitCode -> IO a
exitWith ExitCode
err
  where
    h :: Handle
h = case ExitCode
err of
      ExitCode
ExitSuccess -> Handle
stdout
      ExitCode
_           -> Handle
stderr