{-# LANGUAGE NoImplicitPrelude #-}

module Stack.Options.TestParser
  ( testOptsParser
  ) where

import           Options.Applicative
                   ( Parser, auto, flag', help, long, metavar, option )
import           Options.Applicative.Args ( argsOption )
import           Options.Applicative.Builder.Extra
                   ( firstBoolFlagsTrue, optionalFirst, optionalFirstFalse )
import           Stack.Options.Utils ( hideMods )
import           Stack.Prelude
import           Stack.Types.BuildOpts ( TestOptsMonoid (..) )

-- | Parser for test arguments.

-- FIXME hide args

testOptsParser :: Bool -> Parser TestOptsMonoid
testOptsParser :: Bool -> Parser TestOptsMonoid
testOptsParser Bool
hide0 = FirstTrue
-> [String]
-> FirstFalse
-> FirstFalse
-> First (Maybe Int)
-> FirstTrue
-> TestOptsMonoid
TestOptsMonoid
  (FirstTrue
 -> [String]
 -> FirstFalse
 -> FirstFalse
 -> First (Maybe Int)
 -> FirstTrue
 -> TestOptsMonoid)
-> Parser FirstTrue
-> Parser
     ([String]
      -> FirstFalse
      -> FirstFalse
      -> First (Maybe Int)
      -> FirstTrue
      -> TestOptsMonoid)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Mod FlagFields FirstTrue -> Parser FirstTrue
firstBoolFlagsTrue
        String
"rerun-tests"
        String
"running already successful tests."
        Mod FlagFields FirstTrue
forall {f :: * -> *} {a}. Mod f a
hide
  Parser
  ([String]
   -> FirstFalse
   -> FirstFalse
   -> First (Maybe Int)
   -> FirstTrue
   -> TestOptsMonoid)
-> Parser [String]
-> Parser
     (FirstFalse
      -> FirstFalse -> First (Maybe Int) -> FirstTrue -> TestOptsMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([[String]] -> [String]) -> Parser [[String]] -> Parser [String]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Parser [String] -> Parser [[String]]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields [String] -> Parser [String]
argsOption
        (  String -> Mod OptionFields [String]
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"test-arguments"
        Mod OptionFields [String]
-> Mod OptionFields [String] -> Mod OptionFields [String]
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields [String]
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ta"
        Mod OptionFields [String]
-> Mod OptionFields [String] -> Mod OptionFields [String]
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields [String]
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TEST_ARGS"
        Mod OptionFields [String]
-> Mod OptionFields [String] -> Mod OptionFields [String]
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields [String]
forall (f :: * -> *) a. String -> Mod f a
help String
"Arguments passed in to the test suite program."
        Mod OptionFields [String]
-> Mod OptionFields [String] -> Mod OptionFields [String]
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields [String]
forall {f :: * -> *} {a}. Mod f a
hide
        )))
  Parser
  (FirstFalse
   -> FirstFalse -> First (Maybe Int) -> FirstTrue -> TestOptsMonoid)
-> Parser FirstFalse
-> Parser
     (FirstFalse -> First (Maybe Int) -> FirstTrue -> TestOptsMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool -> Parser FirstFalse
forall (f :: * -> *). Alternative f => f Bool -> f FirstFalse
optionalFirstFalse (Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True
        (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"coverage"
        Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Generate a code coverage report."
        Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall {f :: * -> *} {a}. Mod f a
hide
        ))
  Parser
  (FirstFalse -> First (Maybe Int) -> FirstTrue -> TestOptsMonoid)
-> Parser FirstFalse
-> Parser (First (Maybe Int) -> FirstTrue -> TestOptsMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool -> Parser FirstFalse
forall (f :: * -> *). Alternative f => f Bool -> f FirstFalse
optionalFirstFalse (Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True
        (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-run-tests"
        Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Disable running of tests. (Tests will still be built.)"
        Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall {f :: * -> *} {a}. Mod f a
hide
        ))
  Parser (First (Maybe Int) -> FirstTrue -> TestOptsMonoid)
-> Parser (First (Maybe Int))
-> Parser (FirstTrue -> TestOptsMonoid)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Int) -> Parser (First (Maybe Int))
forall (f :: * -> *) a. Alternative f => f a -> f (First a)
optionalFirst (ReadM (Maybe Int)
-> Mod OptionFields (Maybe Int) -> Parser (Maybe Int)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((Int -> Maybe Int) -> ReadM Int -> ReadM (Maybe Int)
forall a b. (a -> b) -> ReadM a -> ReadM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Maybe Int
forall a. a -> Maybe a
Just ReadM Int
forall a. Read a => ReadM a
auto)
        (  String -> Mod OptionFields (Maybe Int)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"test-suite-timeout"
        Mod OptionFields (Maybe Int)
-> Mod OptionFields (Maybe Int) -> Mod OptionFields (Maybe Int)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Maybe Int)
forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum test suite run time in seconds."
        Mod OptionFields (Maybe Int)
-> Mod OptionFields (Maybe Int) -> Mod OptionFields (Maybe Int)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (Maybe Int)
forall {f :: * -> *} {a}. Mod f a
hide
        ))
  Parser (FirstTrue -> TestOptsMonoid)
-> Parser FirstTrue -> Parser TestOptsMonoid
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Mod FlagFields FirstTrue -> Parser FirstTrue
firstBoolFlagsTrue
        String
"tests-allow-stdin"
        String
"allow standard input in test executables."
        Mod FlagFields FirstTrue
forall {f :: * -> *} {a}. Mod f a
hide
 where
  hide :: Mod f a
hide = Bool -> Mod f a
forall (f :: * -> *) a. Bool -> Mod f a
hideMods Bool
hide0