{-# LANGUAGE TypeApplications #-}
module Test.Tasty.Ext.Todo (
testTreeTodo,
) where
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable)
import Test.Tasty.Options (
IsOption (..),
OptionDescription (..),
flagCLParser,
lookupOption,
safeReadBool,
)
import Test.Tasty.Providers (
IsTest (..),
TestName,
testFailed,
testPassed,
)
import Test.Tasty.Runners (Result (..), TestTree (..))
data TodoTest = TodoTest
deriving (Typeable)
instance IsTest TodoTest where
run :: OptionSet -> TodoTest -> (Progress -> IO ()) -> IO Result
run OptionSet
opts TodoTest
_ Progress -> IO ()
_ = Result -> IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
testResult{resultShortDescription :: String
resultShortDescription = String
"TODO"}
where
FailTodos Bool
shouldFail = OptionSet -> FailTodos
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
testResult :: Result
testResult =
if Bool
shouldFail
then String -> Result
testFailed String
"Failing because --fail-todos was set"
else String -> Result
testPassed String
""
testOptions :: Tagged TodoTest [OptionDescription]
testOptions = [OptionDescription] -> Tagged TodoTest [OptionDescription]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Proxy FailTodos -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy FailTodos
forall k (t :: k). Proxy t
Proxy @FailTodos)]
newtype FailTodos = FailTodos Bool
deriving (Typeable)
instance IsOption FailTodos where
defaultValue :: FailTodos
defaultValue = Bool -> FailTodos
FailTodos Bool
False
parseValue :: String -> Maybe FailTodos
parseValue = (Bool -> FailTodos) -> Maybe Bool -> Maybe FailTodos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> FailTodos
FailTodos (Maybe Bool -> Maybe FailTodos)
-> (String -> Maybe Bool) -> String -> Maybe FailTodos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Bool
safeReadBool
optionName :: Tagged FailTodos String
optionName = String -> Tagged FailTodos String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"fail-todos"
optionHelp :: Tagged FailTodos String
optionHelp = String -> Tagged FailTodos String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"Make TODO tests fail instead of succeeding"
optionCLParser :: Parser FailTodos
optionCLParser = Maybe Char -> FailTodos -> Parser FailTodos
forall v. IsOption v => Maybe Char -> v -> Parser v
flagCLParser Maybe Char
forall a. Maybe a
Nothing (Bool -> FailTodos
FailTodos Bool
True)
testTreeTodo :: TestName -> TestTree
testTreeTodo :: String -> TestTree
testTreeTodo String
name = String -> TodoTest -> TestTree
forall t. IsTest t => String -> t -> TestTree
SingleTest String
name TodoTest
TodoTest