module Test.Tasty.ExpectedFailure (expectFail, ignoreTest, wrapTest) where
import Test.Tasty.Options
import Test.Tasty.Runners
import Test.Tasty.Providers
import Data.Typeable
import Data.Tagged
data WrappedTest t = WrappedTest (IO Result -> IO Result) t
deriving Typeable
instance forall t. IsTest t => IsTest (WrappedTest t) where
run opts (WrappedTest wrap t) prog = wrap (run opts t prog)
testOptions = retag (testOptions :: Tagged t [OptionDescription])
wrapTest :: (IO Result -> IO Result) -> TestTree -> TestTree
wrapTest wrap = go
where
go (SingleTest n t) = SingleTest n (WrappedTest wrap t)
go (TestGroup name tests) = TestGroup name (map go tests)
go (PlusTestOptions plus tree) = PlusTestOptions plus (go tree)
go (WithResource spec gentree) = WithResource spec (go . gentree)
go (AskOptions f) = AskOptions (go . f)
expectFail :: TestTree -> TestTree
expectFail = wrapTest (fmap change)
where
change r
| resultSuccessful r
= r { resultOutcome = Failure TestFailed
, resultDescription = resultDescription r `append` "(unexpected success)"
, resultShortDescription = "PASS (unexpected)"
}
| otherwise
= r { resultOutcome = Success
, resultDescription = resultDescription r `append` "(expected failure)"
, resultShortDescription = "FAIL (expected)"
}
"" `append` s = s
t `append` s | last t == '\n' = t ++ s ++ "\n"
| otherwise = t ++ "\n" ++ s
ignoreTest :: TestTree -> TestTree
ignoreTest = wrapTest $ const $ return $
(testPassed "") { resultShortDescription = "IGNORED" }