-- | Ingredient for listing test names
{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
module Test.Tasty.Ingredients.ListTests
  ( ListTests(..)
  , testsNames
  , listingTests
  ) where

import Data.Proxy
import Data.Typeable
import Options.Applicative

import Test.Tasty.Core
import Test.Tasty.Options
import Test.Tasty.Ingredients

-- | This option, when set to 'True', specifies that we should run in the
-- «list tests» mode.
--
-- @since 0.4
newtype ListTests = ListTests Bool
  deriving (ListTests -> ListTests -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTests -> ListTests -> Bool
$c/= :: ListTests -> ListTests -> Bool
== :: ListTests -> ListTests -> Bool
$c== :: ListTests -> ListTests -> Bool
Eq, Eq ListTests
ListTests -> ListTests -> Bool
ListTests -> ListTests -> Ordering
ListTests -> ListTests -> ListTests
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ListTests -> ListTests -> ListTests
$cmin :: ListTests -> ListTests -> ListTests
max :: ListTests -> ListTests -> ListTests
$cmax :: ListTests -> ListTests -> ListTests
>= :: ListTests -> ListTests -> Bool
$c>= :: ListTests -> ListTests -> Bool
> :: ListTests -> ListTests -> Bool
$c> :: ListTests -> ListTests -> Bool
<= :: ListTests -> ListTests -> Bool
$c<= :: ListTests -> ListTests -> Bool
< :: ListTests -> ListTests -> Bool
$c< :: ListTests -> ListTests -> Bool
compare :: ListTests -> ListTests -> Ordering
$ccompare :: ListTests -> ListTests -> Ordering
Ord, Typeable)
instance IsOption ListTests where
  defaultValue :: ListTests
defaultValue = Bool -> ListTests
ListTests Bool
False
  parseValue :: TestName -> Maybe ListTests
parseValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> ListTests
ListTests forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Maybe Bool
safeReadBool
  optionName :: Tagged ListTests TestName
optionName = forall (m :: * -> *) a. Monad m => a -> m a
return TestName
"list-tests"
  optionHelp :: Tagged ListTests TestName
optionHelp = forall (m :: * -> *) a. Monad m => a -> m a
return TestName
"Do not run the tests; just print their names"
  optionCLParser :: Parser ListTests
optionCLParser = forall v. IsOption v => Mod FlagFields v -> v -> Parser v
mkFlagCLParser (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l') (Bool -> ListTests
ListTests Bool
True)

-- | Obtain the list of all tests in the suite.
--
-- @since 0.4
testsNames :: OptionSet -> TestTree -> [TestName]
testsNames :: OptionSet -> TestTree -> [TestName]
testsNames {- opts -} {- tree -} =
  forall b. Monoid b => TreeFold b -> OptionSet -> TestTree -> b
foldTestTree
    forall b. Monoid b => TreeFold b
trivialFold
      { foldSingle :: forall t. IsTest t => OptionSet -> TestName -> t -> [TestName]
foldSingle = \OptionSet
_opts TestName
name t
_test -> [TestName
name]
      , foldGroup :: OptionSet -> TestName -> [[TestName]] -> [TestName]
foldGroup = \OptionSet
_opts TestName
groupName [[TestName]]
names -> forall a b. (a -> b) -> [a] -> [b]
map ((TestName
groupName forall a. [a] -> [a] -> [a]
++ TestName
".") forall a. [a] -> [a] -> [a]
++) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[TestName]]
names)
      }

-- | The ingredient that provides the test listing functionality.
--
-- @since 0.4
listingTests :: Ingredient
listingTests :: Ingredient
listingTests = [OptionDescription]
-> (OptionSet -> TestTree -> Maybe (IO Bool)) -> Ingredient
TestManager [forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy ListTests)] forall a b. (a -> b) -> a -> b
$
  \OptionSet
opts TestTree
tree ->
    case forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts of
      ListTests Bool
False -> forall a. Maybe a
Nothing
      ListTests Bool
True -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TestName -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ OptionSet -> TestTree -> [TestName]
testsNames OptionSet
opts TestTree
tree
        forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True