{-# 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 (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 (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
  }