module Test.Framework.Runners.Statistics (
TestCount, testCountTestTypes, testCountForType, adjustTestCount, testCountTotal,
TestStatistics(..), ts_pending_tests, ts_no_failures,
initialTestStatistics, updateTestStatistics,
totalRunTestsList, gatherStatistics
) where
import Test.Framework.Core (TestTypeName)
import Test.Framework.Runners.Core
import Data.Map (Map)
import qualified Data.Map as Map
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
#endif
import Data.Semigroup as Sem
newtype TestCount = TestCount { unTestCount :: Map TestTypeName Int }
testCountTestTypes :: TestCount -> [TestTypeName]
testCountTestTypes = Map.keys . unTestCount
testCountForType :: String -> TestCount -> Int
testCountForType test_type = Map.findWithDefault 0 test_type . unTestCount
adjustTestCount :: String -> Int -> TestCount -> TestCount
adjustTestCount test_type amount = TestCount . Map.insertWith (+) test_type amount . unTestCount
testCountTotal :: TestCount -> Int
testCountTotal = sum . Map.elems . unTestCount
instance Semigroup TestCount where
TestCount tcm1 <> TestCount tcm2 = TestCount $ Map.unionWith (+) tcm1 tcm2
instance Monoid TestCount where
mempty = TestCount $ Map.empty
mappend = (Sem.<>)
minusTestCount :: TestCount -> TestCount -> TestCount
minusTestCount (TestCount tcm1) (TestCount tcm2) = TestCount $ Map.unionWith () tcm1 tcm2
data TestStatistics = TestStatistics {
ts_total_tests :: TestCount,
ts_run_tests :: TestCount,
ts_passed_tests :: TestCount,
ts_failed_tests :: TestCount
}
instance Semigroup TestStatistics where
TestStatistics tot1 run1 pas1 fai1 <> TestStatistics tot2 run2 pas2 fai2 = TestStatistics (tot1 Sem.<> tot2) (run1 Sem.<> run2) (pas1 Sem.<> pas2) (fai1 Sem.<> fai2)
instance Monoid TestStatistics where
mempty = TestStatistics mempty mempty mempty mempty
mappend = (Sem.<>)
ts_pending_tests :: TestStatistics -> TestCount
ts_pending_tests ts = ts_total_tests ts `minusTestCount` ts_run_tests ts
ts_no_failures :: TestStatistics -> Bool
ts_no_failures ts = testCountTotal (ts_failed_tests ts) <= 0
initialTestStatistics :: TestCount -> TestStatistics
initialTestStatistics total_tests = TestStatistics {
ts_total_tests = total_tests,
ts_run_tests = mempty,
ts_passed_tests = mempty,
ts_failed_tests = mempty
}
updateTestStatistics :: (Int -> TestCount) -> Bool -> TestStatistics -> TestStatistics
updateTestStatistics count_constructor test_suceeded test_statistics = test_statistics {
ts_run_tests = ts_run_tests test_statistics `mappend` (count_constructor 1),
ts_failed_tests = ts_failed_tests test_statistics `mappend` (count_constructor (if test_suceeded then 0 else 1)),
ts_passed_tests = ts_passed_tests test_statistics `mappend` (count_constructor (if test_suceeded then 1 else 0))
}
totalRunTests :: RunTest a -> TestCount
totalRunTests (RunTest _ test_type _) = adjustTestCount test_type 1 mempty
totalRunTests (RunTestGroup _ tests) = totalRunTestsList tests
totalRunTestsList :: [RunTest a] -> TestCount
totalRunTestsList = mconcat . map totalRunTests
gatherStatistics :: [FinishedTest] -> TestStatistics
gatherStatistics = mconcat . map f
where
f (RunTest _ test_type (_, success)) = singleTestStatistics test_type success
f (RunTestGroup _ tests) = gatherStatistics tests
singleTestStatistics :: String -> Bool -> TestStatistics
singleTestStatistics test_type success = TestStatistics {
ts_total_tests = one,
ts_run_tests = one,
ts_passed_tests = if success then one else mempty,
ts_failed_tests = if success then mempty else one
}
where one = adjustTestCount test_type 1 mempty