{-|
Module      : Results
Description : Results representation for TLT
Copyright   : (c) John Maraist, 2022
License     : GPL3
Maintainer  : haskell-tlt@maraist.org
Stability   : experimental
Portability : POSIX

Results representation for the @TLT@ testing system.  See `Test.TLT`
for more information.

-}

module Test.TLT.Results where

-- * Results of tests

-- |Reasons why a test might fail.
data TestFail = Asserted String
                -- ^ A failure arising from an `Test.TLT.Assertion`
                -- which is not met.
              | Erred String
                -- ^ A failure associated with a call to a Haskell
                -- function triggering an error.

-- |Default conversion of a `TestFail` to a descriptive string.
formatFail :: TestFail -> String
formatFail :: TestFail -> String
formatFail (Asserted String
s) = String
s
formatFail (Erred String
s) = String
"Assertion raised exception: " forall a. [a] -> [a] -> [a]
++ String
s

-- |Hierarchical structure holding the result of running tests,
-- possibly grouped into tests.
data TestResult = Test String [TestFail]
                | Group String Int Int [TestResult]
                  -- ^ The `Int`s are respectively the total number of
                  -- tests executed, and total number of failures
                  -- detected.

-- |Return the number of failed tests reported in a `TestResult`.
failCount :: TestResult -> Int
failCount :: TestResult -> Int
failCount (Test String
_ []) = Int
0
failCount (Test String
_ [TestFail]
_) = Int
1
failCount (Group String
_ Int
_ Int
n [TestResult]
_) = Int
n

-- |Return the number of tests described by a `TestResult`.
testCount :: TestResult -> Int
testCount :: TestResult -> Int
testCount (Test String
_ [TestFail]
_) = Int
1
testCount (Group String
_ Int
n Int
_ [TestResult]
_) = Int
n

-- |Return the number of failed tests described in a list of
-- `TestResult`s.
totalFailCount :: [TestResult] -> Int
totalFailCount :: [TestResult] -> Int
totalFailCount = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Num a => a -> a -> a
(+) Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map TestResult -> Int
failCount

-- |Return the number of tests described in a list of `TestResult`s.
totalTestCount :: [TestResult] -> Int
totalTestCount :: [TestResult] -> Int
totalTestCount = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Num a => a -> a -> a
(+) Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map TestResult -> Int
testCount