module Test.Framework.Runners.Console.Statistics (
        showFinalTestStatistics
    ) where

import Test.Framework.Runners.Statistics
import Test.Framework.Runners.Console.Colors
import Test.Framework.Runners.Console.Table

import Text.PrettyPrint.ANSI.Leijen ( empty, text, Doc )

import Data.List ( sort )


-- | Displays statistics as a string something like this:
--
-- @
--        Properties Total
-- Passed 9          9
-- Failed 1          1
-- Total  10         10
-- @
showFinalTestStatistics :: TestStatistics -> Doc
showFinalTestStatistics :: TestStatistics -> Doc
showFinalTestStatistics TestStatistics
ts = [Column] -> Doc
renderTable ([Column] -> Doc) -> [Column] -> Doc
forall a b. (a -> b) -> a -> b
$ [[Cell] -> Column
Column [Cell]
label_column] [Column] -> [Column] -> [Column]
forall a. [a] -> [a] -> [a]
++ (([Cell] -> Column) -> [[Cell]] -> [Column]
forall a b. (a -> b) -> [a] -> [b]
map [Cell] -> Column
Column [[Cell]]
test_type_columns) [Column] -> [Column] -> [Column]
forall a. [a] -> [a] -> [a]
++ [[Cell] -> Column
Column [Cell]
total_column]
  where
    test_types :: [TestTypeName]
test_types = [TestTypeName] -> [TestTypeName]
forall a. Ord a => [a] -> [a]
sort ([TestTypeName] -> [TestTypeName])
-> [TestTypeName] -> [TestTypeName]
forall a b. (a -> b) -> a -> b
$ TestCount -> [TestTypeName]
testCountTestTypes (TestStatistics -> TestCount
ts_total_tests TestStatistics
ts)

    label_column :: [Cell]
label_column      = [Doc -> Cell
TextCell Doc
empty,              Doc -> Cell
TextCell (TestTypeName -> Doc
text TestTypeName
"Passed"),                        Doc -> Cell
TextCell (TestTypeName -> Doc
text TestTypeName
"Failed"),                  Doc -> Cell
TextCell (TestTypeName -> Doc
text TestTypeName
"Total")]
    total_column :: [Cell]
total_column      = [Doc -> Cell
TextCell (TestTypeName -> Doc
text TestTypeName
"Total"),     (Doc -> Doc) -> (TestStatistics -> TestCount) -> Cell
testStatusTotal Doc -> Doc
colorPass TestStatistics -> TestCount
ts_passed_tests,       (Doc -> Doc) -> (TestStatistics -> TestCount) -> Cell
testStatusTotal Doc -> Doc
colorFail TestStatistics -> TestCount
ts_failed_tests, (Doc -> Doc) -> (TestStatistics -> TestCount) -> Cell
testStatusTotal (Bool -> Doc -> Doc
colorPassOrFail (TestStatistics -> Bool
ts_no_failures TestStatistics
ts)) TestStatistics -> TestCount
ts_total_tests]
    test_type_columns :: [[Cell]]
test_type_columns = [ [Doc -> Cell
TextCell (TestTypeName -> Doc
text TestTypeName
test_type), (Doc -> Doc) -> Int -> Cell
testStat Doc -> Doc
colorPass ((TestStatistics -> TestCount) -> Int
countTests TestStatistics -> TestCount
ts_passed_tests), (Doc -> Doc) -> Int -> Cell
testStat Doc -> Doc
colorFail Int
failures,               (Doc -> Doc) -> Int -> Cell
testStat (Bool -> Doc -> Doc
colorPassOrFail (Int
failures Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0)) ((TestStatistics -> TestCount) -> Int
countTests TestStatistics -> TestCount
ts_total_tests)]
                        | TestTypeName
test_type <- [TestTypeName]
test_types
                        , let countTests :: (TestStatistics -> TestCount) -> Int
countTests = TestTypeName -> TestCount -> Int
testCountForType TestTypeName
test_type (TestCount -> Int)
-> ((TestStatistics -> TestCount) -> TestCount)
-> (TestStatistics -> TestCount)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TestStatistics -> TestCount) -> TestStatistics -> TestCount
forall a b. (a -> b) -> a -> b
$ TestStatistics
ts)
                              failures :: Int
failures   = (TestStatistics -> TestCount) -> Int
countTests TestStatistics -> TestCount
ts_failed_tests ]

    testStatusTotal :: (Doc -> Doc) -> (TestStatistics -> TestCount) -> Cell
testStatusTotal Doc -> Doc
color TestStatistics -> TestCount
status_accessor = Doc -> Cell
TextCell ((Doc -> Doc) -> Int -> Doc
coloredNumber Doc -> Doc
color (TestCount -> Int
testCountTotal (TestStatistics -> TestCount
status_accessor TestStatistics
ts)))
    testStat :: (Doc -> Doc) -> Int -> Cell
testStat Doc -> Doc
color Int
number = Doc -> Cell
TextCell ((Doc -> Doc) -> Int -> Doc
coloredNumber Doc -> Doc
color Int
number)

coloredNumber :: (Doc -> Doc) -> Int -> Doc
coloredNumber :: (Doc -> Doc) -> Int -> Doc
coloredNumber Doc -> Doc
color Int
number
  | Int
number Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Doc
number_doc
  | Bool
otherwise   = Doc -> Doc
color Doc
number_doc
  where
    number_doc :: Doc
number_doc = TestTypeName -> Doc
text (Int -> TestTypeName
forall a. Show a => a -> TestTypeName
show Int
number)