module Test.Hspec.Options (
  Options (..)
, ColorMode (..)
, defaultOptions
, parseOptions

-- exported to silence warnings
, Arg (..)
) where

import           Data.List
import           System.Exit
import           System.Console.GetOpt

import           Test.Hspec.Formatters
import           Test.Hspec.Compat
import           Test.Hspec.Util

data Options = Options {
  optionsDryRun       :: Bool
, optionsPrintCpuTime :: Bool
, optionsRerun        :: Bool
, optionsFastFail     :: Bool
, optionsMatch        :: [String]
, optionsMaxSuccess   :: Maybe Int
, optionsDepth        :: Maybe Int
, optionsSeed         :: Maybe Integer
, optionsMaxSize      :: Maybe Int
, optionsMaxDiscardRatio :: Maybe Int
, optionsColorMode    :: ColorMode
, optionsFormatter    :: Formatter
, optionsHtmlOutput   :: Bool
, optionsOutputFile   :: Maybe FilePath
}

addMatch :: String -> Options -> Options
addMatch s c = c {optionsMatch = s : optionsMatch c}

setDepth :: Int -> Options -> Options
setDepth n c = c {optionsDepth = Just n}

setMaxSuccess :: Int -> Options -> Options
setMaxSuccess n c = c {optionsMaxSuccess = Just n}

setMaxSize :: Int -> Options -> Options
setMaxSize n c = c {optionsMaxSize = Just n}

setMaxDiscardRatio :: Int -> Options -> Options
setMaxDiscardRatio n c = c {optionsMaxDiscardRatio = Just n}

setSeed :: Integer -> Options -> Options
setSeed n c = c {optionsSeed = Just n}

data ColorMode = ColorAuto | ColorNever | ColorAlways
  deriving (Eq, Show)

defaultOptions :: Options
defaultOptions = Options False False False False [] Nothing Nothing Nothing Nothing Nothing ColorAuto specdoc False Nothing

formatters :: [(String, Formatter)]
formatters = [
    ("specdoc", specdoc)
  , ("progress", progress)
  , ("failed-examples", failed_examples)
  , ("silent", silent)
  ]

formatHelp :: String
formatHelp = unlines (addLineBreaks "use a custom formatter; this can be one of:" ++ map (("   " ++) . fst) formatters)

type Result = Either NoConfig Options

data NoConfig = Help | InvalidArgument String String

data Arg a = Arg {
  argumentName   :: String
, argumentParser :: String -> Maybe a
, argumentSetter :: a -> Options -> Options
}

mkOption :: [Char] -> String -> Arg a -> String -> OptDescr (Result -> Result)
mkOption shortcut name (Arg argName parser setter) help = Option shortcut [name] (ReqArg arg argName) help
  where
    arg :: String -> Result -> Result
    arg input x = x >>= \c -> case parser input of
      Just n -> Right (setter n c)
      Nothing -> Left (InvalidArgument name input)

addLineBreaks :: String -> [String]
addLineBreaks = lineBreaksAt 44

options :: [OptDescr (Result -> Result)]
options = [
    Option   []  ["help"]             (NoArg (const $ Left Help))         (h "display this help and exit")
  , mkOption "m"  "match"             (Arg "PATTERN" return addMatch)     (h "only run examples that match given PATTERN")
  , Option   []  ["color"]            (NoArg setColor)                    (h "colorize the output")
  , Option   []  ["no-color"]         (NoArg setNoColor)                  (h "do not colorize the output")
  , mkOption "f"  "format"            (Arg "FORMATTER" readFormatter setFormatter) formatHelp
  , mkOption "o"  "out"               (Arg "FILE" return setOutputFile)   (h "write output to a file instead of STDOUT")
  , mkOption []   "depth"             (Arg "N" readMaybe setDepth)        (h "maximum depth of generated test values for SmallCheck properties")
  , mkOption "a"  "qc-max-success"    (Arg "N" readMaybe setMaxSuccess)   (h "maximum number of successful tests before a QuickCheck property succeeds")
  , mkOption ""   "qc-max-size"       (Arg "N" readMaybe setMaxSize)      (h "size to use for the biggest test cases")
  , mkOption ""   "qc-max-discard"    (Arg "N" readMaybe setMaxDiscardRatio) (h "maximum number of discarded tests per successful test before giving up")
  , mkOption []   "seed"              (Arg "N" readMaybe setSeed)         (h "used seed for QuickCheck properties")
  , Option   []  ["print-cpu-time"]   (NoArg setPrintCpuTime)             (h "include used CPU time in summary")
  , Option   []  ["dry-run"]          (NoArg setDryRun)                   (h "pretend that everything passed; don't verify anything")
  , Option   []  ["fail-fast"]        (NoArg setFastFail)                 (h "abort on first failure")
  , Option   "r" ["rerun"]            (NoArg  setRerun)                   (h "rerun all examples that failed in the previously test run (only works in GHCi)")
  ]
  where
    h = unlines . addLineBreaks

    readFormatter :: String -> Maybe Formatter
    readFormatter = (`lookup` formatters)

    setFormatter :: Formatter -> Options -> Options
    setFormatter f c = c {optionsFormatter = f}

    setOutputFile :: String -> Options -> Options
    setOutputFile file c = c {optionsOutputFile = Just file}

    setPrintCpuTime x = x >>= \c -> return c {optionsPrintCpuTime = True}
    setDryRun       x = x >>= \c -> return c {optionsDryRun       = True}
    setFastFail     x = x >>= \c -> return c {optionsFastFail     = True}
    setRerun        x = x >>= \c -> return c {optionsRerun = True}
    setNoColor      x = x >>= \c -> return c {optionsColorMode = ColorNever}
    setColor        x = x >>= \c -> return c {optionsColorMode = ColorAlways}

undocumentedOptions :: [OptDescr (Result -> Result)]
undocumentedOptions = [
    -- for compatibility with test-framework
    mkOption [] "maximum-generated-tests" (Arg "NUMBER" readMaybe setMaxSuccess) "how many automated tests something like QuickCheck should try, by default"

    -- undocumented for now, as we probably want to change this to produce a
    -- standalone HTML report in the future
  , Option []  ["html"]                    (NoArg setHtml)                    "produce HTML output"

    -- now a noop
  , Option "v" ["verbose"]                 (NoArg id)                         "do not suppress output to stdout when evaluating examples"
  ]
  where
    setHtml :: Result -> Result
    setHtml x = x >>= \c -> return c {optionsHtmlOutput = True}

parseOptions :: Options -> String -> [String] -> Either (ExitCode, String) Options
parseOptions c prog args = case getOpt Permute (options ++ undocumentedOptions) args of
    (opts, [], []) -> case foldl' (flip id) (Right c) opts of
        Left Help                         -> Left (ExitSuccess, usageInfo ("Usage: " ++ prog ++ " [OPTION]...\n\nOPTIONS") options)
        Left (InvalidArgument flag value) -> tryHelp ("invalid argument `" ++ value ++ "' for `--" ++ flag ++ "'\n")
        Right x -> Right x
    (_, _, err:_)  -> tryHelp err
    (_, arg:_, _)  -> tryHelp ("unexpected argument `" ++ arg ++ "'\n")
  where
    tryHelp msg = Left (ExitFailure 1, prog ++ ": " ++ msg ++ "Try `" ++ prog ++ " --help' for more information.\n")