    -- | Parsing options supplied on the command line
    module Test.Tasty.CmdLine
      ( optionParser
      , suiteOptions
      , suiteOptionParser
      , parseOptions
      , defaultMainWithIngredients
      ) where

    import Control.Arrow
    import Control.Monad
    import Data.Maybe
    import Data.Proxy
    import Data.Typeable (typeRep)
    import Options.Applicative
    import Options.Applicative.Common (evalParser)
    import qualified Options.Applicative.Types as Applicative (Option(..))
    import Options.Applicative.Types (Parser(..), OptProperties(..))
    import Prelude  -- Silence AMP and FTP import warnings
    import System.Exit
    import System.IO
    #if !MIN_VERSION_base(4,11,0)
    import Data.Monoid
    import Data.Foldable (foldMap)
    #endif

    import Test.Tasty.Core
    import Test.Tasty.Runners.Utils
    import Test.Tasty.Ingredients
    import Test.Tasty.Options
    import Test.Tasty.Options.Env
    import Test.Tasty.Runners.Reducers

    -- | Generate a command line parser from a list of option descriptions,
    -- alongside any related warning messages.
    --
    -- @since 1.3
    optionParser :: [OptionDescription] -> ([String], Parser OptionSet)
    optionParser :: [OptionDescription] -> ([String], Parser OptionSet)
    optionParser = (Ap Parser OptionSet -> Parser OptionSet)
    -> ([String], Ap Parser OptionSet) -> ([String], Parser OptionSet)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second Ap Parser OptionSet -> Parser OptionSet
    forall (f :: * -> *) a. Ap f a -> f a
    getApp (([String], Ap Parser OptionSet) -> ([String], Parser OptionSet))
    -> ([OptionDescription] -> ([String], Ap Parser OptionSet))
    -> [OptionDescription]
    -> ([String], Parser OptionSet)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (OptionDescription -> ([String], Ap Parser OptionSet))
    -> [OptionDescription] -> ([String], Ap Parser OptionSet)
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap OptionDescription -> ([String], Ap Parser OptionSet)
    toSet where
      toSet :: OptionDescription -> ([String], Ap Parser OptionSet)
      toSet :: OptionDescription -> ([String], Ap Parser OptionSet)
    toSet (Option Proxy v
    p) = (Parser v -> Ap Parser OptionSet)
    -> ([String], Parser v) -> ([String], Ap Parser OptionSet)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second
        (\Parser v
    parser -> Parser OptionSet -> Ap Parser OptionSet
    forall (f :: * -> *) a. f a -> Ap f a
    Ap (Parser OptionSet -> Ap Parser OptionSet)
    -> Parser OptionSet -> Ap Parser OptionSet
    forall a b. (a -> b) -> a -> b
    $ (v -> OptionSet
    forall v. IsOption v => v -> OptionSet
    singleOption (v -> OptionSet) -> Parser v -> Parser OptionSet
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser v
    parser) Parser OptionSet -> Parser OptionSet -> Parser OptionSet
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> OptionSet -> Parser OptionSet
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure OptionSet
    forall a. Monoid a => a
    mempty)
        (Proxy v -> Parser v -> ([String], Parser v)
    forall (proxy :: * -> *) v.
    IsOption v =>
    proxy v -> Parser v -> ([String], Parser v)
    finalizeCLParser Proxy v
    p Parser v
    forall v. IsOption v => Parser v
    optionCLParser)

    -- Do two things:
    --
    -- 1. Replace an `optionCLParser`'s 'propShowDefault' with 'showDefaultValue'
    --    from the 'IsOption' class.
    -- 2. Generate warning messages if the 'optionCLParser' does anything
    --    suspicious. Currently, the only suspicious things we check for are
    --    (a) if the 'Parser' defines multiple options and, (b) if the 'Parser'
    --    assigns a default value outside of 'defaultValue'.
    finalizeCLParser :: forall proxy v . IsOption v
                     => proxy v -> Parser v -> ([String], Parser v)
    finalizeCLParser :: forall (proxy :: * -> *) v.
    IsOption v =>
    proxy v -> Parser v -> ([String], Parser v)
    finalizeCLParser proxy v
    _ Parser v
    p = ([String]
    warnings, Maybe String -> Parser v -> Parser v
    forall a. Maybe String -> Parser a -> Parser a
    setCLParserShowDefaultValue Maybe String
    mbDef Parser v
    p)
      where
        mbDef :: Maybe String
        mbDef :: Maybe String
    mbDef = v -> Maybe String
    forall v. IsOption v => v -> Maybe String
    showDefaultValue (v
    forall v. IsOption v => v
    defaultValue :: v)

        warnings :: [String]
        warnings :: [String]
    warnings = [Maybe String] -> [String]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe String
    multipleOptPsWarning, Maybe String
    badDefaultWarning]

        -- Warn if a Parser defines multiple options, as this breaks an assumption
        -- that setCLParserShowDefaultValue relies on.
        multipleOptPsWarning :: Maybe String
        multipleOptPsWarning :: Maybe String
    multipleOptPsWarning
          | Parser v -> Int
    forall a. Parser a -> Int
    numOptPs Parser v
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1
          = String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines
            [ String
    prov
            , String
    "optionCLParser defines multiple options. Consider only defining"
            , String
    "a single option here, as defining multiple options does not play"
            , String
    "well with how tasty displays default values."
            ]
          | Bool
    otherwise
          = Maybe String
    forall a. Maybe a
    Nothing

        -- Warning if a Parser has a default value (outside of IsOption's
        -- defaultValue method, that is), as this interferes with tasty's ability
        -- to read arguments from environment variables. For more on this point,
        -- see the Haddocks for optionCLParser.
        badDefaultWarning :: Maybe String
        badDefaultWarning :: Maybe String
    badDefaultWarning
          -- evalParser will only return Just if has a default value declared with
          -- e.g. the Options.Applicative.value function.
          | Maybe v -> Bool
    forall a. Maybe a -> Bool
    isJust (Parser v -> Maybe v
    forall a. Parser a -> Maybe a
    evalParser Parser v
    p)
          = String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines
            [ String
    prov
            , String
    "Using default values (e.g., with Options.Applicative.value) in"
            , String
    "optionCLParser is prohibited, as it interferes with tasty's ability"
            , String
    "to read environment variable options properly. Moreover, assigning"
            , String
    "default values is unnecessary, as their functionality is subsumed"
            , String
    "by the defaultValue method of IsOption."
            ]
          | Bool
    otherwise
          = Maybe String
    forall a. Maybe a
    Nothing

        prov :: String
        prov :: String
    prov = String
    "WARNING (in the IsOption instance for "
                 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ TypeRep -> String
    forall a. Show a => a -> String
    show (Proxy v -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    typeRep (Proxy v
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy v)) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "):"

    -- Replace an `optionCLParser`'s 'propShowDefault' with 'showDefaultValue' from
    -- the 'IsOption' class. It's tempting to try doing this when constructing the
    -- 'Parser' itself using 'optionMod', but @optparse-applicative@'s 'mkParser'
    -- function always overrides the result of 'optionMod'. Ugh.
    setCLParserShowDefaultValue :: Maybe String -> Parser a -> Parser a
    setCLParserShowDefaultValue :: forall a. Maybe String -> Parser a -> Parser a
    setCLParserShowDefaultValue Maybe String
    mbDef = Parser a -> Parser a
    forall a. Parser a -> Parser a
    go
      where
        go :: Parser a -> Parser a
        -- Note that we /always/ replace the Option's optProps, regardless of
        -- what type it may have. This can produce unexpected results if an
        -- optionCLParser defines multiple options, which is why we emit a warning
        -- (in finalizeCLParser) if a Parser does this.
        go :: forall a. Parser a -> Parser a
    go (OptP Option a
    o)      = Option a -> Parser a
    forall a. Option a -> Parser a
    OptP Option a
    o{Applicative.optProps =
                                  modifyDefault (Applicative.optProps o)}
        go p :: Parser a
    p@NilP{}      = Parser a
    p
        go (MultP Parser (x -> a)
    p1 Parser x
    p2) = Parser (x -> a) -> Parser x -> Parser a
    forall a x. Parser (x -> a) -> Parser x -> Parser a
    MultP (Parser (x -> a) -> Parser (x -> a)
    forall a. Parser a -> Parser a
    go Parser (x -> a)
    p1) (Parser x -> Parser x
    forall a. Parser a -> Parser a
    go Parser x
    p2)
        go (AltP  Parser a
    p1 Parser a
    p2) = Parser a -> Parser a -> Parser a
    forall a. Parser a -> Parser a -> Parser a
    AltP  (Parser a -> Parser a
    forall a. Parser a -> Parser a
    go Parser a
    p1) (Parser a -> Parser a
    forall a. Parser a -> Parser a
    go Parser a
    p2)
        go (BindP Parser x
    p1 x -> Parser a
    p2) = Parser x -> (x -> Parser a) -> Parser a
    forall a x. Parser x -> (x -> Parser a) -> Parser a
    BindP (Parser x -> Parser x
    forall a. Parser a -> Parser a
    go Parser x
    p1) ((Parser a -> Parser a) -> (x -> Parser a) -> x -> Parser a
    forall a b. (a -> b) -> (x -> a) -> x -> b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Parser a -> Parser a
    forall a. Parser a -> Parser a
    go x -> Parser a
    p2)

        modifyDefault :: OptProperties -> OptProperties
        modifyDefault :: OptProperties -> OptProperties
    modifyDefault OptProperties
    op = OptProperties
    op{propShowDefault = mbDef}

    -- Note: this is a conservative estimate, since we cannot count the number
    -- of OptPs in the continuation argument of BindP. But BindP is really only
    -- used for ParserM purposes, and since ParserM is an internal
    -- optparse-applicative definition, most optionCLParser instances are
    -- unlikely to use it in practice.
    numOptPs :: Parser a -> Int
    numOptPs :: forall a. Parser a -> Int
    numOptPs OptP{} = Int
    1
    numOptPs NilP{} = Int
    0
    numOptPs (MultP Parser (x -> a)
    p1  Parser x
    p2) = Parser (x -> a) -> Int
    forall a. Parser a -> Int
    numOptPs Parser (x -> a)
    p1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Parser x -> Int
    forall a. Parser a -> Int
    numOptPs Parser x
    p2
    numOptPs (AltP  Parser a
    p1  Parser a
    p2) = Parser a -> Int
    forall a. Parser a -> Int
    numOptPs Parser a
    p1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Parser a -> Int
    forall a. Parser a -> Int
    numOptPs Parser a
    p2
    numOptPs (BindP Parser x
    p1 x -> Parser a
    _p2) = Parser x -> Int
    forall a. Parser a -> Int
    numOptPs Parser x
    p1

    -- | The command line parser for the test suite, alongside any related
    -- warnings.
    --
    -- @since 1.3
    suiteOptionParser :: [Ingredient] -> TestTree -> ([String], Parser OptionSet)
    suiteOptionParser :: [Ingredient] -> TestTree -> ([String], Parser OptionSet)
    suiteOptionParser [Ingredient]
    ins TestTree
    tree = [OptionDescription] -> ([String], Parser OptionSet)
    optionParser ([OptionDescription] -> ([String], Parser OptionSet))
    -> [OptionDescription] -> ([String], Parser OptionSet)
    forall a b. (a -> b) -> a -> b
    $ [Ingredient] -> TestTree -> [OptionDescription]
    suiteOptions [Ingredient]
    ins TestTree
    tree

    -- | Parse the command-line and environment options passed to tasty.
    --
    -- Useful if you need to get the options before 'Test.Tasty.defaultMain' is called.
    --
    -- Once within the test tree, 'Test.Tasty.askOption' should be used instead.
    --
    -- The arguments to this function should be the same as for
    -- 'defaultMainWithIngredients'. If you don't use any custom ingredients,
    -- pass 'Test.Tasty.defaultIngredients'.
    --
    -- @since 1.2.2
    parseOptions :: [Ingredient] -> TestTree -> IO OptionSet
    parseOptions :: [Ingredient] -> TestTree -> IO OptionSet
    parseOptions [Ingredient]
    ins TestTree
    tree = do
      let ([String]
    warnings, Parser OptionSet
    parser) = [Ingredient] -> TestTree -> ([String], Parser OptionSet)
    suiteOptionParser [Ingredient]
    ins TestTree
    tree
      (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
      cmdlineOpts <- ParserInfo OptionSet -> IO OptionSet
    forall a. ParserInfo a -> IO a
    execParser (ParserInfo OptionSet -> IO OptionSet)
    -> ParserInfo OptionSet -> IO OptionSet
    forall a b. (a -> b) -> a -> b
    $
        Parser OptionSet -> InfoMod OptionSet -> ParserInfo OptionSet
    forall a. Parser a -> InfoMod a -> ParserInfo a
    info (Parser (OptionSet -> OptionSet)
    forall a. Parser (a -> a)
    helper Parser (OptionSet -> OptionSet)
    -> Parser OptionSet -> Parser OptionSet
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser OptionSet
    parser)
        ( InfoMod OptionSet
    forall a. InfoMod a
    fullDesc InfoMod OptionSet -> InfoMod OptionSet -> InfoMod OptionSet
    forall a. Semigroup a => a -> a -> a
    <>
          String -> InfoMod OptionSet
    forall a. String -> InfoMod a
    header String
    "Mmm... tasty test suite"
        )
      envOpts <- suiteEnvOptions ins tree
      return $ envOpts <> cmdlineOpts

    -- | Parse the command line arguments and run the tests using the provided
    -- ingredient list.
    --
    -- When the tests finish, this function calls 'System.Exit.exitWith' with the exit code
    -- that indicates whether any tests have failed. See 'Test.Tasty.defaultMain' for
    -- details.
    --
    -- @since 0.4
    defaultMainWithIngredients :: [Ingredient] -> TestTree -> IO ()
    defaultMainWithIngredients :: [Ingredient] -> TestTree -> IO ()
    defaultMainWithIngredients [Ingredient]
    ins TestTree
    testTree = do
      IO ()
    installSignalHandlers
      opts <- [Ingredient] -> TestTree -> IO OptionSet
    parseOptions [Ingredient]
    ins TestTree
    testTree

      case tryIngredients ins opts testTree of
        Maybe (IO Bool)
    Nothing -> do
          Handle -> String -> IO ()
    hPutStrLn Handle
    stderr
            String
    "No ingredients agreed to run. Something is wrong either with your ingredient set or the options."
          IO ()
    forall a. IO a
    exitFailure
        Just IO Bool
    act -> do
          ok <- IO Bool
    act
          if ok then exitSuccess else exitFailure