module Test.Tasty.CmdLine
( optionParser
, suiteOptions
, suiteOptionParser
, parseOptions
, defaultMainWithIngredients
) where
import Options.Applicative
import Data.Monoid ((<>))
import Data.Proxy
import Data.Foldable (foldMap)
import Prelude
import System.Exit
import System.IO
#if !MIN_VERSION_base(4,9,0)
import Data.Monoid
#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
optionParser :: [OptionDescription] -> Parser OptionSet
optionParser :: [OptionDescription] -> Parser OptionSet
optionParser = Ap Parser OptionSet -> Parser OptionSet
forall (f :: * -> *) a. Ap f a -> f a
getApp (Ap Parser OptionSet -> Parser OptionSet)
-> ([OptionDescription] -> Ap Parser OptionSet)
-> [OptionDescription]
-> Parser OptionSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OptionDescription -> Ap Parser OptionSet)
-> [OptionDescription] -> Ap Parser OptionSet
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap OptionDescription -> Ap Parser OptionSet
toSet where
toSet :: OptionDescription -> Ap Parser OptionSet
toSet :: OptionDescription -> Ap Parser OptionSet
toSet (Option (Proxy v
Proxy :: Proxy v)) = 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
forall v. IsOption v => Parser v
optionCLParser :: Parser v)) Parser OptionSet -> Parser OptionSet -> Parser OptionSet
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OptionSet -> Parser OptionSet
forall (f :: * -> *) a. Applicative f => a -> f a
pure OptionSet
forall a. Monoid a => a
mempty
suiteOptionParser :: [Ingredient] -> TestTree -> Parser OptionSet
suiteOptionParser :: [Ingredient] -> TestTree -> Parser OptionSet
suiteOptionParser ins :: [Ingredient]
ins tree :: TestTree
tree = [OptionDescription] -> Parser OptionSet
optionParser ([OptionDescription] -> Parser OptionSet)
-> [OptionDescription] -> Parser OptionSet
forall a b. (a -> b) -> a -> b
$ [Ingredient] -> TestTree -> [OptionDescription]
suiteOptions [Ingredient]
ins TestTree
tree
parseOptions :: [Ingredient] -> TestTree -> IO OptionSet
parseOptions :: [Ingredient] -> TestTree -> IO OptionSet
parseOptions ins :: [Ingredient]
ins tree :: TestTree
tree = do
OptionSet
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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Ingredient] -> TestTree -> Parser OptionSet
suiteOptionParser [Ingredient]
ins TestTree
tree)
( 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 "Mmm... tasty test suite"
)
OptionSet
envOpts <- [Ingredient] -> TestTree -> IO OptionSet
suiteEnvOptions [Ingredient]
ins TestTree
tree
OptionSet -> IO OptionSet
forall (m :: * -> *) a. Monad m => a -> m a
return (OptionSet -> IO OptionSet) -> OptionSet -> IO OptionSet
forall a b. (a -> b) -> a -> b
$ OptionSet
envOpts OptionSet -> OptionSet -> OptionSet
forall a. Semigroup a => a -> a -> a
<> OptionSet
cmdlineOpts
defaultMainWithIngredients :: [Ingredient] -> TestTree -> IO ()
defaultMainWithIngredients :: [Ingredient] -> TestTree -> IO ()
defaultMainWithIngredients ins :: [Ingredient]
ins testTree :: TestTree
testTree = do
IO ()
installSignalHandlers
OptionSet
opts <- [Ingredient] -> TestTree -> IO OptionSet
parseOptions [Ingredient]
ins TestTree
testTree
case [Ingredient] -> OptionSet -> TestTree -> Maybe (IO Bool)
tryIngredients [Ingredient]
ins OptionSet
opts TestTree
testTree of
Nothing -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr
"No ingredients agreed to run. Something is wrong either with your ingredient set or the options."
IO ()
forall a. IO a
exitFailure
Just act :: IO Bool
act -> do
Bool
ok <- IO Bool
act
if Bool
ok then IO ()
forall a. IO a
exitSuccess else IO ()
forall a. IO a
exitFailure