-- | 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
newtype ListTests = ListTests Bool
  deriving (ListTests -> ListTests -> Bool
(ListTests -> ListTests -> Bool)
-> (ListTests -> ListTests -> Bool) -> Eq ListTests
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
Eq ListTests
-> (ListTests -> ListTests -> Ordering)
-> (ListTests -> ListTests -> Bool)
-> (ListTests -> ListTests -> Bool)
-> (ListTests -> ListTests -> Bool)
-> (ListTests -> ListTests -> Bool)
-> (ListTests -> ListTests -> ListTests)
-> (ListTests -> ListTests -> ListTests)
-> Ord 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 = (Bool -> ListTests) -> Maybe Bool -> Maybe ListTests
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> ListTests
ListTests (Maybe Bool -> Maybe ListTests)
-> (TestName -> Maybe Bool) -> TestName -> Maybe ListTests
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Maybe Bool
safeReadBool
  optionName :: Tagged ListTests TestName
optionName = TestName -> Tagged ListTests TestName
forall (m :: * -> *) a. Monad m => a -> m a
return TestName
"list-tests"
  optionHelp :: Tagged ListTests TestName
optionHelp = TestName -> Tagged ListTests TestName
forall (m :: * -> *) a. Monad m => a -> m a
return TestName
"Do not run the tests; just print their names"
  optionCLParser :: Parser ListTests
optionCLParser = Mod FlagFields ListTests -> ListTests -> Parser ListTests
forall v. IsOption v => Mod FlagFields v -> v -> Parser v
mkFlagCLParser (Char -> Mod FlagFields ListTests
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
testsNames :: OptionSet -> TestTree -> [TestName]
testsNames :: OptionSet -> TestTree -> [TestName]
testsNames {- opts -} {- tree -} =
  TreeFold [TestName] -> OptionSet -> TestTree -> [TestName]
forall b. Monoid b => TreeFold b -> OptionSet -> TestTree -> b
foldTestTree
    TreeFold [TestName]
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 -> (TestName -> TestName) -> [TestName] -> [TestName]
forall a b. (a -> b) -> [a] -> [b]
map ((TestName
groupName TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
".") TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++) [TestName]
names
      }

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