    {-# 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           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
    getSeed 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
      prog <- IO String
    getProgName
      configFiles <- do
        ignore <- ignoreConfigFile opts_ args
        case 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
      env <- getEnvironment
      let 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 parseOptions opts_ prog configFiles envVar env 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
      global <- IO (Maybe ConfigFile)
    readGlobalConfigFile
      local <- readLocalConfigFile
      return $ catMaybes [global, local]

    readGlobalConfigFile :: IO (Maybe ConfigFile)
    readGlobalConfigFile :: IO (Maybe ConfigFile)
    readGlobalConfigFile = do
      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
    unavailable) IO String
    getHomeDirectory
      case 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
        unavailable :: IOError -> Bool
        unavailable :: IOError -> Bool
    unavailable IOError
    e = IOError -> Bool
    isDoesNotExistError IOError
    e Bool -> Bool -> Bool
    || IOError -> Bool
    isUnsupportedOperation IOError
    e

    readLocalConfigFile :: IO (Maybe ConfigFile)
    readLocalConfigFile :: IO (Maybe ConfigFile)
    readLocalConfigFile = do
      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 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
      exists <- String -> IO Bool
    doesFileExist String
    name
      if exists then Just . (,) name . unescapeArgs <$> readFile name else return 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