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
import Data.Semigroup as Sem


-- | Records a count of the various kinds of test that have been run
newtype TestCount = TestCount { TestCount -> Map TestTypeName Int
unTestCount :: Map TestTypeName Int }

testCountTestTypes :: TestCount -> [TestTypeName]
testCountTestTypes :: TestCount -> [TestTypeName]
testCountTestTypes = Map TestTypeName Int -> [TestTypeName]
forall k a. Map k a -> [k]
Map.keys (Map TestTypeName Int -> [TestTypeName])
-> (TestCount -> Map TestTypeName Int)
-> TestCount
-> [TestTypeName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestCount -> Map TestTypeName Int
unTestCount

testCountForType :: String -> TestCount -> Int
testCountForType :: TestTypeName -> TestCount -> Int
testCountForType TestTypeName
test_type = Int -> TestTypeName -> Map TestTypeName Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Int
0 TestTypeName
test_type (Map TestTypeName Int -> Int)
-> (TestCount -> Map TestTypeName Int) -> TestCount -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestCount -> Map TestTypeName Int
unTestCount

adjustTestCount :: String -> Int -> TestCount -> TestCount
adjustTestCount :: TestTypeName -> Int -> TestCount -> TestCount
adjustTestCount TestTypeName
test_type Int
amount = Map TestTypeName Int -> TestCount
TestCount (Map TestTypeName Int -> TestCount)
-> (TestCount -> Map TestTypeName Int) -> TestCount -> TestCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int)
-> TestTypeName
-> Int
-> Map TestTypeName Int
-> Map TestTypeName Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) TestTypeName
test_type Int
amount (Map TestTypeName Int -> Map TestTypeName Int)
-> (TestCount -> Map TestTypeName Int)
-> TestCount
-> Map TestTypeName Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestCount -> Map TestTypeName Int
unTestCount


-- | The number of tests of all kinds recorded in the given 'TestCount'
testCountTotal :: TestCount -> Int
testCountTotal :: TestCount -> Int
testCountTotal = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (TestCount -> [Int]) -> TestCount -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TestTypeName Int -> [Int]
forall k a. Map k a -> [a]
Map.elems (Map TestTypeName Int -> [Int])
-> (TestCount -> Map TestTypeName Int) -> TestCount -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestCount -> Map TestTypeName Int
unTestCount

instance Semigroup TestCount where
    TestCount Map TestTypeName Int
tcm1 <> :: TestCount -> TestCount -> TestCount
<> TestCount Map TestTypeName Int
tcm2 = Map TestTypeName Int -> TestCount
TestCount (Map TestTypeName Int -> TestCount)
-> Map TestTypeName Int -> TestCount
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int)
-> Map TestTypeName Int
-> Map TestTypeName Int
-> Map TestTypeName Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Map TestTypeName Int
tcm1 Map TestTypeName Int
tcm2

instance Monoid TestCount where
    mempty :: TestCount
mempty = Map TestTypeName Int -> TestCount
TestCount (Map TestTypeName Int -> TestCount)
-> Map TestTypeName Int -> TestCount
forall a b. (a -> b) -> a -> b
$ Map TestTypeName Int
forall k a. Map k a
Map.empty
    mappend :: TestCount -> TestCount -> TestCount
mappend = TestCount -> TestCount -> TestCount
forall a. Semigroup a => a -> a -> a
(Sem.<>)

minusTestCount :: TestCount -> TestCount -> TestCount
minusTestCount :: TestCount -> TestCount -> TestCount
minusTestCount (TestCount Map TestTypeName Int
tcm1) (TestCount Map TestTypeName Int
tcm2) = Map TestTypeName Int -> TestCount
TestCount (Map TestTypeName Int -> TestCount)
-> Map TestTypeName Int -> TestCount
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int)
-> Map TestTypeName Int
-> Map TestTypeName Int
-> Map TestTypeName Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (-) Map TestTypeName Int
tcm1 Map TestTypeName Int
tcm2


-- | Records information about the run of a number of tests, such
-- as how many tests have been run, how many are pending and how
-- many have passed or failed.
data TestStatistics = TestStatistics {
        TestStatistics -> TestCount
ts_total_tests :: TestCount,
        TestStatistics -> TestCount
ts_run_tests :: TestCount,
        TestStatistics -> TestCount
ts_passed_tests :: TestCount,
        TestStatistics -> TestCount
ts_failed_tests :: TestCount
    }

instance Semigroup TestStatistics where
    TestStatistics TestCount
tot1 TestCount
run1 TestCount
pas1 TestCount
fai1 <> :: TestStatistics -> TestStatistics -> TestStatistics
<> TestStatistics TestCount
tot2 TestCount
run2 TestCount
pas2 TestCount
fai2 = TestCount -> TestCount -> TestCount -> TestCount -> TestStatistics
TestStatistics (TestCount
tot1 TestCount -> TestCount -> TestCount
forall a. Semigroup a => a -> a -> a
Sem.<> TestCount
tot2) (TestCount
run1 TestCount -> TestCount -> TestCount
forall a. Semigroup a => a -> a -> a
Sem.<> TestCount
run2) (TestCount
pas1 TestCount -> TestCount -> TestCount
forall a. Semigroup a => a -> a -> a
Sem.<> TestCount
pas2) (TestCount
fai1 TestCount -> TestCount -> TestCount
forall a. Semigroup a => a -> a -> a
Sem.<> TestCount
fai2)

instance Monoid TestStatistics where
    mempty :: TestStatistics
mempty = TestCount -> TestCount -> TestCount -> TestCount -> TestStatistics
TestStatistics TestCount
forall a. Monoid a => a
mempty TestCount
forall a. Monoid a => a
mempty TestCount
forall a. Monoid a => a
mempty TestCount
forall a. Monoid a => a
mempty
    mappend :: TestStatistics -> TestStatistics -> TestStatistics
mappend = TestStatistics -> TestStatistics -> TestStatistics
forall a. Semigroup a => a -> a -> a
(Sem.<>)

ts_pending_tests :: TestStatistics -> TestCount
ts_pending_tests :: TestStatistics -> TestCount
ts_pending_tests TestStatistics
ts = TestStatistics -> TestCount
ts_total_tests TestStatistics
ts TestCount -> TestCount -> TestCount
`minusTestCount` TestStatistics -> TestCount
ts_run_tests TestStatistics
ts

ts_no_failures :: TestStatistics -> Bool
ts_no_failures :: TestStatistics -> Bool
ts_no_failures TestStatistics
ts = TestCount -> Int
testCountTotal (TestStatistics -> TestCount
ts_failed_tests TestStatistics
ts) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0

-- | Create some test statistics that simply records the total number of
-- tests to be run, ready to be updated by the actual test runs.
initialTestStatistics :: TestCount -> TestStatistics
initialTestStatistics :: TestCount -> TestStatistics
initialTestStatistics TestCount
total_tests = TestStatistics {
        ts_total_tests :: TestCount
ts_total_tests = TestCount
total_tests,
        ts_run_tests :: TestCount
ts_run_tests = TestCount
forall a. Monoid a => a
mempty,
        ts_passed_tests :: TestCount
ts_passed_tests = TestCount
forall a. Monoid a => a
mempty,
        ts_failed_tests :: TestCount
ts_failed_tests = TestCount
forall a. Monoid a => a
mempty
    }

updateTestStatistics :: (Int -> TestCount) -> Bool -> TestStatistics -> TestStatistics
updateTestStatistics :: (Int -> TestCount) -> Bool -> TestStatistics -> TestStatistics
updateTestStatistics Int -> TestCount
count_constructor Bool
test_suceeded TestStatistics
test_statistics = TestStatistics
test_statistics {
        ts_run_tests :: TestCount
ts_run_tests    = TestStatistics -> TestCount
ts_run_tests TestStatistics
test_statistics    TestCount -> TestCount -> TestCount
forall a. Monoid a => a -> a -> a
`mappend` (Int -> TestCount
count_constructor Int
1),
        ts_failed_tests :: TestCount
ts_failed_tests = TestStatistics -> TestCount
ts_failed_tests TestStatistics
test_statistics TestCount -> TestCount -> TestCount
forall a. Monoid a => a -> a -> a
`mappend` (Int -> TestCount
count_constructor (if Bool
test_suceeded then Int
0 else Int
1)),
        ts_passed_tests :: TestCount
ts_passed_tests = TestStatistics -> TestCount
ts_passed_tests TestStatistics
test_statistics TestCount -> TestCount -> TestCount
forall a. Monoid a => a -> a -> a
`mappend` (Int -> TestCount
count_constructor (if Bool
test_suceeded then Int
1 else Int
0))
    }


totalRunTests :: RunTest a -> TestCount
totalRunTests :: forall a. RunTest a -> TestCount
totalRunTests (RunTest TestTypeName
_ TestTypeName
test_type a
_) = TestTypeName -> Int -> TestCount -> TestCount
adjustTestCount TestTypeName
test_type Int
1 TestCount
forall a. Monoid a => a
mempty
totalRunTests (RunTestGroup TestTypeName
_ [RunTest a]
tests)  = [RunTest a] -> TestCount
forall a. [RunTest a] -> TestCount
totalRunTestsList [RunTest a]
tests

totalRunTestsList :: [RunTest a] -> TestCount
totalRunTestsList :: forall a. [RunTest a] -> TestCount
totalRunTestsList = [TestCount] -> TestCount
forall a. Monoid a => [a] -> a
mconcat ([TestCount] -> TestCount)
-> ([RunTest a] -> [TestCount]) -> [RunTest a] -> TestCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RunTest a -> TestCount) -> [RunTest a] -> [TestCount]
forall a b. (a -> b) -> [a] -> [b]
map RunTest a -> TestCount
forall a. RunTest a -> TestCount
totalRunTests

gatherStatistics :: [FinishedTest] -> TestStatistics
gatherStatistics :: [FinishedTest] -> TestStatistics
gatherStatistics = [TestStatistics] -> TestStatistics
forall a. Monoid a => [a] -> a
mconcat ([TestStatistics] -> TestStatistics)
-> ([FinishedTest] -> [TestStatistics])
-> [FinishedTest]
-> TestStatistics
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinishedTest -> TestStatistics)
-> [FinishedTest] -> [TestStatistics]
forall a b. (a -> b) -> [a] -> [b]
map FinishedTest -> TestStatistics
f
  where
    f :: FinishedTest -> TestStatistics
f (RunTest TestTypeName
_ TestTypeName
test_type (TestTypeName
_, Bool
success)) = TestTypeName -> Bool -> TestStatistics
singleTestStatistics TestTypeName
test_type Bool
success
    f (RunTestGroup TestTypeName
_ [FinishedTest]
tests)             = [FinishedTest] -> TestStatistics
gatherStatistics [FinishedTest]
tests

    singleTestStatistics :: String -> Bool -> TestStatistics
    singleTestStatistics :: TestTypeName -> Bool -> TestStatistics
singleTestStatistics TestTypeName
test_type Bool
success = TestStatistics {
            ts_total_tests :: TestCount
ts_total_tests = TestCount
one,
            ts_run_tests :: TestCount
ts_run_tests = TestCount
one,
            ts_passed_tests :: TestCount
ts_passed_tests = if Bool
success then TestCount
one else TestCount
forall a. Monoid a => a
mempty,
            ts_failed_tests :: TestCount
ts_failed_tests = if Bool
success then TestCount
forall a. Monoid a => a
mempty else TestCount
one
        }
      where one :: TestCount
one = TestTypeName -> Int -> TestCount -> TestCount
adjustTestCount TestTypeName
test_type Int
1 TestCount
forall a. Monoid a => a
mempty