    -- | 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
    (ListTests -> ListTests -> Bool)
    -> (ListTests -> ListTests -> Bool) -> Eq ListTests
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ListTests -> ListTests -> Bool
    == :: ListTests -> ListTests -> Bool
    $c/= :: ListTests -> ListTests -> Bool
    /= :: 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
    $ccompare :: ListTests -> ListTests -> Ordering
    compare :: ListTests -> ListTests -> Ordering
    $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
    >= :: ListTests -> ListTests -> Bool
    $cmax :: ListTests -> ListTests -> ListTests
    max :: ListTests -> ListTests -> ListTests
    $cmin :: ListTests -> ListTests -> ListTests
    min :: ListTests -> ListTests -> ListTests
    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 a b. (a -> b) -> Maybe a -> Maybe b
    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 a. a -> Tagged ListTests a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestName
    "list-tests"
      optionHelp :: Tagged ListTests TestName
    optionHelp = TestName -> Tagged ListTests TestName
    forall a. a -> Tagged ListTests a
    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.
    --
    -- @since 0.4
    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 = \OptionSet
    _opts TestName
    name t
    _test -> [TestName
    name]
          , 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]] -> [TestName]
    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 [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 a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True