module Test.Hspec.Config (
  Config (..)
, defaultConfig
, getConfig
, configAddFilter
, configSetSeed
) where

import           Control.Applicative
import           Data.List
import           Data.Maybe
import           System.IO
import           System.Exit
import qualified Test.QuickCheck as QC
import           Test.Hspec.Formatters

import           Test.Hspec.Util

-- for Monad (Either e) when base < 4.3
import           Control.Monad.Trans.Error ()

import           Test.Hspec.Options
import           Test.Hspec.FailureReport

data Config = Config {
  configDryRun          :: Bool
, configPrintCpuTime    :: Bool
, configFastFail        :: Bool

-- |
-- A predicate that is used to filter the spec before it is run.  Only examples
-- that satisfy the predicate are run.
, configFilterPredicate :: Maybe (Path -> Bool)
, configQuickCheckArgs  :: QC.Args
, configSmallCheckDepth :: Int
, configColorMode       :: ColorMode
, configFormatter       :: Formatter
, configHtmlOutput      :: Bool
, configHandle          :: Either Handle FilePath
}

defaultConfig :: Config
defaultConfig = Config False False False Nothing QC.stdArgs 5 ColorAuto specdoc False (Left stdout)

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

filterOr :: Maybe (Path -> Bool) -> Maybe (Path -> Bool) -> Maybe (Path -> Bool)
filterOr p1_ p2_ = case (p1_, p2_) of
  (Just p1, Just p2) -> Just $ \path -> p1 path || p2 path
  _ -> p1_ <|> p2_

configSetSeed :: Integer -> Config -> Config
configSetSeed n c = c {configQuickCheckArgs = (configQuickCheckArgs c) {QC.replay = Just (stdGenFromInteger n, 0)}}

mkConfig :: Maybe FailureReport -> Options -> Config
mkConfig mFailureReport opts = Config {
    configDryRun          = optionsDryRun opts
  , configPrintCpuTime    = optionsPrintCpuTime opts
  , configFastFail        = optionsFastFail opts
  , configFilterPredicate = matchFilter `filterOr` rerunFilter
  , configQuickCheckArgs  = qcArgs
  , configSmallCheckDepth = fromMaybe (configSmallCheckDepth defaultConfig) (optionsDepth opts)
  , configColorMode       = optionsColorMode opts
  , configFormatter       = optionsFormatter opts
  , configHtmlOutput      = optionsHtmlOutput opts
  , configHandle          = maybe (configHandle defaultConfig) Right (optionsOutputFile opts)
  }
  where
    qcArgs = (
        maybe id setSeed mSeed
      . maybe id setMaxDiscardRatio mMaxDiscardRatio
      . maybe id setMaxSize mMaxSize
      . maybe id setMaxSuccess mMaxSuccess) QC.stdArgs

    mSeed = optionsSeed opts <|> (failureReportSeed <$> mFailureReport)
    mMaxSuccess = optionsMaxSuccess opts <|> (failureReportMaxSuccess <$> mFailureReport)
    mMaxSize = optionsMaxSize opts <|> (failureReportMaxSize <$> mFailureReport)
    mMaxDiscardRatio = optionsMaxDiscardRatio opts <|> (failureReportMaxDiscardRatio <$> mFailureReport)

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

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

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

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

    matchFilter = case optionsMatch opts of
      [] -> Nothing
      xs -> Just $ foldl1' (\p0 p1 path -> p0 path || p1 path) (map filterPredicate xs)

    rerunFilter = flip elem . failureReportPaths <$> mFailureReport

getConfig :: Options -> String -> [String] -> IO Config
getConfig opts_ prog args = do
  case parseOptions opts_ prog args of
    Left (err, msg) -> exitWithMessage err msg
    Right opts -> do
      r <- if optionsRerun opts then readFailureReport else return Nothing
      return (mkConfig r opts)

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