    {-# LANGUAGE FlexibleInstances #-}

    module Test.Tasty.Discover
      ( Tasty(..)
      , TastyInfo
      , name
      , description
      , nameOf
      , descriptionOf
      ) where

    import Data.Maybe
    import Data.Monoid
    import Test.Tasty.Discover.TastyInfo (TastyInfo)

    import qualified Test.Tasty as TT
    import qualified Test.Tasty.Discover.TastyInfo as TI

    class Tasty a where
      tasty :: TastyInfo -> a -> IO TT.TestTree

    instance Tasty TT.TestTree where
      tasty :: TastyInfo -> TestTree -> IO TestTree
    tasty TastyInfo
    _ TestTree
    a = TestTree -> IO TestTree
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TestTree
    a

    instance Tasty [TT.TestTree] where
      tasty :: TastyInfo -> [TestTree] -> IO TestTree
    tasty TastyInfo
    info [TestTree]
    a = TestTree -> IO TestTree
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (TestTree -> IO TestTree) -> TestTree -> IO TestTree
    forall a b. (a -> b) -> a -> b
    $ TestName -> [TestTree] -> TestTree
    TT.testGroup (TastyInfo -> TestName
    descriptionOf TastyInfo
    info) [TestTree]
    a

    instance Tasty (IO TT.TestTree) where
      tasty :: TastyInfo -> IO TestTree -> IO TestTree
    tasty TastyInfo
    _ IO TestTree
    a = IO TestTree
    a

    instance Tasty (IO [TT.TestTree]) where
      tasty :: TastyInfo -> IO [TestTree] -> IO TestTree
    tasty TastyInfo
    info IO [TestTree]
    a = TestName -> [TestTree] -> TestTree
    TT.testGroup (TastyInfo -> TestName
    descriptionOf TastyInfo
    info) ([TestTree] -> TestTree) -> IO [TestTree] -> IO TestTree
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO [TestTree]
    a

    nameOf :: TastyInfo -> String
    nameOf :: TastyInfo -> TestName
    nameOf TastyInfo
    info = (TestName -> Maybe TestName -> TestName
    forall a. a -> Maybe a -> a
    fromMaybe TestName
    "<unnamed>" (Last TestName -> Maybe TestName
    forall a. Last a -> Maybe a
    getLast (TastyInfo -> Last TestName
    TI.name TastyInfo
    info)))

    descriptionOf :: TastyInfo -> String
    descriptionOf :: TastyInfo -> TestName
    descriptionOf TastyInfo
    info = (TestName -> Maybe TestName -> TestName
    forall a. a -> Maybe a -> a
    fromMaybe TestName
    "<undescribed>" (Last TestName -> Maybe TestName
    forall a. Last a -> Maybe a
    getLast (TastyInfo -> Last TestName
    TI.description TastyInfo
    info)))

    name :: String -> TastyInfo
    name :: TestName -> TastyInfo
    name TestName
    n = TastyInfo
    forall a. Monoid a => a
    mempty
      { name :: Last TestName
    TI.name = Maybe TestName -> Last TestName
    forall a. Maybe a -> Last a
    Last (Maybe TestName -> Last TestName)
    -> Maybe TestName -> Last TestName
    forall a b. (a -> b) -> a -> b
    $ TestName -> Maybe TestName
    forall a. a -> Maybe a
    Just TestName
    n
      }

    description :: String -> TastyInfo
    description :: TestName -> TastyInfo
    description TestName
    n = TastyInfo
    forall a. Monoid a => a
    mempty
      { description :: Last TestName
    TI.description = Maybe TestName -> Last TestName
    forall a. Maybe a -> Last a
    Last (Maybe TestName -> Last TestName)
    -> Maybe TestName -> Last TestName
    forall a b. (a -> b) -> a -> b
    $ TestName -> Maybe TestName
    forall a. a -> Maybe a
    Just TestName
    n
      }