module Test.Tasty.KAT
(
testKatDetailed
, testKatGrouped
, testKatLoad
, Resource(..)
, katLoaderSimple
, mapTestUnits
) where
import Control.Applicative
import Control.Exception
import Data.Typeable
import Test.Tasty (testGroup)
import Test.Tasty.Providers
import Test.Tasty.KAT.FileLoader
newtype Resource a = Resource [(String, [a])]
data TestKatSingle = TestKatSingle (IO Bool)
deriving Typeable
data TestKatGroup = TestKatGroup [(Int, IO Bool)]
deriving Typeable
data KatResult = KatFailed String | KatSuccess
deriving (Show,Eq)
tryResult :: IO Bool -> IO KatResult
tryResult f = do
er <- try f
case er of
Left (e :: SomeException)
| show e == "<<timeout>>" -> throwIO e
| otherwise -> return $ KatFailed (show e)
Right r -> return $ if r then KatSuccess else KatFailed "test failed"
instance IsTest TestKatSingle where
run _ (TestKatSingle tst) _ = do
r <- tryResult tst
case r of
KatSuccess -> return $ testPassed ""
KatFailed s -> return $ testFailed s
testOptions = return []
instance IsTest TestKatGroup where
run _ (TestKatGroup groupTests) _ = do
(success, failed) <- summarize <$> mapM runGroup groupTests
return $
(if failed == 0 then testPassed else testFailed)
(if failed > 0 then (show failed) ++ " tests failed on " ++ show (failed + success)
else (show success) ++ " tests succeed")
where summarize :: [KatResult] -> (Int, Int)
summarize = foldl (\(s,f) k -> if k == KatSuccess then (s+1,f) else (s,f+1)) (0,0)
runGroup :: (Int, IO Bool) -> IO KatResult
runGroup (_, tst) = tryResult tst
testOptions = return []
testKatDetailed :: TestName
-> Resource a
-> (String -> a -> IO Bool)
-> TestTree
testKatDetailed name (Resource groups) test =
testGroup name $ map groupToTests groups
where groupToTests (groupName, vectors) =
testGroup groupName $ map (\(i, v) -> singleTest (show (i :: Int)) (TestKatSingle $ test groupName v)) (zip [1..] vectors)
testKatGrouped :: TestName
-> Resource a
-> (String -> a -> IO Bool)
-> TestTree
testKatGrouped name (Resource groups) test =
testGroup name $ map groupToTests groups
where groupToTests (groupName, vectors) =
singleTest groupName $ TestKatGroup $ map (\(i, v) -> (i, test groupName v)) (zip [1..] vectors)
testKatLoad :: FilePath
-> ([String] -> [(String, [a])])
-> IO (Resource a)
testKatLoad filepath transform = Resource . transform . lines <$> readFile filepath