module Test.Chell.Main
  ( defaultMain
  ) where

import           Control.Applicative
import           Control.Monad (forM, forM_, when)
import           Control.Monad.Trans.Class (lift)
import qualified Control.Monad.Trans.State as State
import qualified Control.Monad.Trans.Writer as Writer
import           Data.Char (ord)
import           Data.List (isPrefixOf)
import           System.Exit (exitSuccess, exitFailure)
import           System.IO (hPutStr, hPutStrLn, hIsTerminalDevice, stderr, stdout, withBinaryFile, IOMode(..))
import           System.Random (randomIO)
import           Text.Printf (printf)

import           Options

import           Test.Chell.Output
import           Test.Chell.Types

data MainOptions =
  MainOptions
    { MainOptions -> Bool
optVerbose :: Bool
    , MainOptions -> String
optXmlReport :: String
    , MainOptions -> String
optJsonReport :: String
    , MainOptions -> String
optTextReport :: String
    , MainOptions -> Maybe Int
optSeed :: Maybe Int
    , MainOptions -> Maybe Int
optTimeout :: Maybe Int
    , MainOptions -> ColorMode
optColor :: ColorMode
    }

optionType_ColorMode :: OptionType ColorMode
optionType_ColorMode :: OptionType ColorMode
optionType_ColorMode = String
-> ColorMode
-> (String -> Either String ColorMode)
-> (ColorMode -> String)
-> OptionType ColorMode
forall val.
String
-> val
-> (String -> Either String val)
-> (val -> String)
-> OptionType val
optionType String
"ColorMode" ColorMode
ColorModeAuto String -> Either String ColorMode
parseMode ColorMode -> String
showMode
  where
    parseMode :: String -> Either String ColorMode
parseMode String
s =
        case String
s of
            String
"always" -> ColorMode -> Either String ColorMode
forall a b. b -> Either a b
Right ColorMode
ColorModeAlways
            String
"never" -> ColorMode -> Either String ColorMode
forall a b. b -> Either a b
Right ColorMode
ColorModeNever
            String
"auto" -> ColorMode -> Either String ColorMode
forall a b. b -> Either a b
Right ColorMode
ColorModeAuto
            String
_ -> String -> Either String ColorMode
forall a b. a -> Either a b
Left (String -> String
forall a. Show a => a -> String
show String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not in {\"always\", \"never\", \"auto\"}.")
    showMode :: ColorMode -> String
showMode ColorMode
mode =
        case ColorMode
mode of
            ColorMode
ColorModeAlways -> String
"always"
            ColorMode
ColorModeNever -> String
"never"
            ColorMode
ColorModeAuto -> String
"auto"

instance Options MainOptions
  where
    defineOptions :: DefineOptions MainOptions
defineOptions = (Bool
 -> String
 -> String
 -> String
 -> Maybe Int
 -> Maybe Int
 -> ColorMode
 -> MainOptions)
-> DefineOptions
     (Bool
      -> String
      -> String
      -> String
      -> Maybe Int
      -> Maybe Int
      -> ColorMode
      -> MainOptions)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
-> String
-> String
-> String
-> Maybe Int
-> Maybe Int
-> ColorMode
-> MainOptions
MainOptions
        DefineOptions
  (Bool
   -> String
   -> String
   -> String
   -> Maybe Int
   -> Maybe Int
   -> ColorMode
   -> MainOptions)
-> DefineOptions Bool
-> DefineOptions
     (String
      -> String
      -> String
      -> Maybe Int
      -> Maybe Int
      -> ColorMode
      -> MainOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OptionType Bool
-> (Option Bool -> Option Bool) -> DefineOptions Bool
forall a. OptionType a -> (Option a -> Option a) -> DefineOptions a
defineOption OptionType Bool
optionType_bool
              (\Option Bool
o -> Option Bool
o
                  { optionShortFlags :: String
optionShortFlags = [Char
'v']
                  , optionLongFlags :: [String]
optionLongFlags = [String
"verbose"]
                  , optionDefault :: Bool
optionDefault = Bool
False
                  , optionDescription :: String
optionDescription = String
"Print more output."
                  }
              )

        DefineOptions
  (String
   -> String
   -> String
   -> Maybe Int
   -> Maybe Int
   -> ColorMode
   -> MainOptions)
-> DefineOptions String
-> DefineOptions
     (String
      -> String -> Maybe Int -> Maybe Int -> ColorMode -> MainOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> DefineOptions String
forall a.
SimpleOptionType a =>
String -> a -> String -> DefineOptions a
simpleOption String
"xml-report" String
""
                String
"Write a parsable report to a given path, in XML."
        DefineOptions
  (String
   -> String -> Maybe Int -> Maybe Int -> ColorMode -> MainOptions)
-> DefineOptions String
-> DefineOptions
     (String -> Maybe Int -> Maybe Int -> ColorMode -> MainOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> DefineOptions String
forall a.
SimpleOptionType a =>
String -> a -> String -> DefineOptions a
simpleOption String
"json-report" String
""
                String
"Write a parsable report to a given path, in JSON."
        DefineOptions
  (String -> Maybe Int -> Maybe Int -> ColorMode -> MainOptions)
-> DefineOptions String
-> DefineOptions
     (Maybe Int -> Maybe Int -> ColorMode -> MainOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> DefineOptions String
forall a.
SimpleOptionType a =>
String -> a -> String -> DefineOptions a
simpleOption String
"text-report" String
""
                String
"Write a human-readable report to a given path."

        DefineOptions (Maybe Int -> Maybe Int -> ColorMode -> MainOptions)
-> DefineOptions (Maybe Int)
-> DefineOptions (Maybe Int -> ColorMode -> MainOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int -> String -> DefineOptions (Maybe Int)
forall a.
SimpleOptionType a =>
String -> a -> String -> DefineOptions a
simpleOption String
"seed" Maybe Int
forall a. Maybe a
Nothing
                String
"The seed used for random numbers in (for example) quickcheck."

        DefineOptions (Maybe Int -> ColorMode -> MainOptions)
-> DefineOptions (Maybe Int)
-> DefineOptions (ColorMode -> MainOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int -> String -> DefineOptions (Maybe Int)
forall a.
SimpleOptionType a =>
String -> a -> String -> DefineOptions a
simpleOption String
"timeout" Maybe Int
forall a. Maybe a
Nothing
                String
"The maximum duration of a test, in milliseconds."

        DefineOptions (ColorMode -> MainOptions)
-> DefineOptions ColorMode -> DefineOptions MainOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OptionType ColorMode
-> (Option ColorMode -> Option ColorMode)
-> DefineOptions ColorMode
forall a. OptionType a -> (Option a -> Option a) -> DefineOptions a
defineOption OptionType ColorMode
optionType_ColorMode
              (\Option ColorMode
o -> Option ColorMode
o
                  { optionLongFlags :: [String]
optionLongFlags = [String
"color"]
                  , optionDefault :: ColorMode
optionDefault = ColorMode
ColorModeAuto
                  , optionDescription :: String
optionDescription = String
"Whether to enable color ('always', 'auto', or 'never')."
                  }
              )

-- | A simple default main function, which runs a list of tests and logs
-- statistics to stdout.
defaultMain :: [Suite] -> IO ()
defaultMain :: [Suite] -> IO ()
defaultMain [Suite]
suites = (MainOptions -> [String] -> IO ()) -> IO ()
forall (m :: * -> *) opts a.
(MonadIO m, Options opts) =>
(opts -> [String] -> m a) -> m a
runCommand ((MainOptions -> [String] -> IO ()) -> IO ())
-> (MainOptions -> [String] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \MainOptions
opts [String]
args ->
  do
    -- validate/sanitize test options
    Int
seed <-
        case MainOptions -> Maybe Int
optSeed MainOptions
opts of
            Just Int
s -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
s
            Maybe Int
Nothing -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
    Maybe Int
timeout <-
        case MainOptions -> Maybe Int
optTimeout MainOptions
opts of
            Maybe Int
Nothing -> Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
            Just Int
t -> if Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int)
                then
                  do
                    Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Test.Chell.defaultMain: Ignoring --timeout because it is too large."
                    Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
                else
                    Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
t)
    let
        testOptions :: TestOptions
testOptions = TestOptions
defaultTestOptions
            { testOptionSeed :: Int
testOptionSeed = Int
seed
            , testOptionTimeout :: Maybe Int
testOptionTimeout = Maybe Int
timeout
            }

    -- find which tests to run
    let
        allTests :: [Test]
allTests = (Suite -> [Test]) -> [Suite] -> [Test]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Suite -> [Test]
suiteTests [Suite]
suites
        tests :: [Test]
tests =
            if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args
                then [Test]
allTests
                else (Test -> Bool) -> [Test] -> [Test]
forall a. (a -> Bool) -> [a] -> [a]
filter ([String] -> Test -> Bool
matchesFilter [String]
args) [Test]
allTests

    -- output mode
    Output
output <-
        case MainOptions -> ColorMode
optColor MainOptions
opts of
            ColorMode
ColorModeNever -> Output -> IO Output
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Output
plainOutput (MainOptions -> Bool
optVerbose MainOptions
opts))
            ColorMode
ColorModeAlways -> Output -> IO Output
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Output
colorOutput (MainOptions -> Bool
optVerbose MainOptions
opts))
            ColorMode
ColorModeAuto ->
              do
                Bool
isTerm <- Handle -> IO Bool
hIsTerminalDevice Handle
stdout
                Output -> IO Output
forall (m :: * -> *) a. Monad m => a -> m a
return (Output -> IO Output) -> Output -> IO Output
forall a b. (a -> b) -> a -> b
$
                    if Bool
isTerm
                        then Bool -> Output
colorOutput (MainOptions -> Bool
optVerbose MainOptions
opts)
                        else Bool -> Output
plainOutput (MainOptions -> Bool
optVerbose MainOptions
opts)

    -- run tests
    [(Test, TestResult)]
results <- [Test]
-> (Test -> IO (Test, TestResult)) -> IO [(Test, TestResult)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Test]
tests ((Test -> IO (Test, TestResult)) -> IO [(Test, TestResult)])
-> (Test -> IO (Test, TestResult)) -> IO [(Test, TestResult)]
forall a b. (a -> b) -> a -> b
$ \Test
t ->
      do
        Output -> Test -> IO ()
outputStart Output
output Test
t
        TestResult
result <- Test -> TestOptions -> IO TestResult
runTest Test
t TestOptions
testOptions
        Output -> Test -> TestResult -> IO ()
outputResult Output
output Test
t TestResult
result
        (Test, TestResult) -> IO (Test, TestResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Test
t, TestResult
result)

    -- generate reports
    let
        reports :: [(String, String, Report)]
reports = MainOptions -> [(String, String, Report)]
getReports MainOptions
opts

    [(String, String, Report)]
-> ((String, String, Report) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String, Report)]
reports (((String, String, Report) -> IO ()) -> IO ())
-> ((String, String, Report) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
path, String
fmt, Report
toText) ->
        String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
path IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
          do
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MainOptions -> Bool
optVerbose MainOptions
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                String -> IO ()
putStrLn (String
"Writing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fmt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" report to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
path)
            Handle -> String -> IO ()
hPutStr Handle
h (Report
toText [(Test, TestResult)]
results)

    let
        stats :: (Integer, Integer, Integer, Integer)
stats = [(Test, TestResult)] -> (Integer, Integer, Integer, Integer)
resultStatistics [(Test, TestResult)]
results
        (Integer
_, Integer
_, Integer
failed, Integer
aborted) = (Integer, Integer, Integer, Integer)
stats
    String -> IO ()
putStrLn ((Integer, Integer, Integer, Integer) -> String
formatResultStatistics (Integer, Integer, Integer, Integer)
stats)

    if Integer
failed Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
&& Integer
aborted Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
        then IO ()
forall a. IO a
exitSuccess
        else IO ()
forall a. IO a
exitFailure

matchesFilter :: [String] -> Test -> Bool
matchesFilter :: [String] -> Test -> Bool
matchesFilter [String]
filters = Test -> Bool
check
  where
    check :: Test -> Bool
check Test
t = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
matchName (Test -> String
testName Test
t)) [String]
filters
    matchName :: String -> String -> Bool
matchName String
name String
f = String
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name Bool -> Bool -> Bool
|| String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".") String
name

type Report = [(Test, TestResult)] -> String

getReports :: MainOptions -> [(String, String, Report)]
getReports :: MainOptions -> [(String, String, Report)]
getReports MainOptions
opts = [[(String, String, Report)]] -> [(String, String, Report)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(String, String, Report)]
xml, [(String, String, Report)]
json, [(String, String, Report)]
text]
  where
    xml :: [(String, String, Report)]
xml = case MainOptions -> String
optXmlReport MainOptions
opts of
        String
"" -> []
        String
path -> [(String
path, String
"XML", Report
xmlReport)]
    json :: [(String, String, Report)]
json = case MainOptions -> String
optJsonReport MainOptions
opts of
        String
"" -> []
        String
path -> [(String
path, String
"JSON", Report
jsonReport)]
    text :: [(String, String, Report)]
text = case MainOptions -> String
optTextReport MainOptions
opts of
        String
"" -> []
        String
path -> [(String
path, String
"text", Report
textReport)]

jsonReport :: [(Test, TestResult)] -> String
jsonReport :: Report
jsonReport [(Test, TestResult)]
results = Writer String () -> String
forall w a. Writer w a -> w
Writer.execWriter Writer String ()
writer
  where
    tell :: w -> WriterT w Identity ()
tell = w -> WriterT w Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell

    writer :: Writer String ()
writer =
      do
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"{\"test-runs\": ["
        [(Test, TestResult)]
-> ((Test, TestResult) -> Writer String ()) -> Writer String ()
forall (m :: * -> *) (t :: * -> *) t b.
(Monad m, Foldable t) =>
t t -> (t -> WriterT String m b) -> WriterT String m ()
commas [(Test, TestResult)]
results (Test, TestResult) -> Writer String ()
tellResult
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"]}"

    tellResult :: (Test, TestResult) -> Writer String ()
tellResult (Test
t, TestResult
result) =
        case TestResult
result of
            TestPassed [(String, String)]
notes ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"{\"test\": \""
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON (Test -> String
testName Test
t))
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\", \"result\": \"passed\""
                [(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"}"
            TestResult
TestSkipped ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"{\"test\": \""
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON (Test -> String
testName Test
t))
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\", \"result\": \"skipped\"}"
            TestFailed [(String, String)]
notes [Failure]
fs ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"{\"test\": \""
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON (Test -> String
testName Test
t))
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\", \"result\": \"failed\", \"failures\": ["
                [Failure] -> (Failure -> Writer String ()) -> Writer String ()
forall (m :: * -> *) (t :: * -> *) t b.
(Monad m, Foldable t) =>
t t -> (t -> WriterT String m b) -> WriterT String m ()
commas [Failure]
fs ((Failure -> Writer String ()) -> Writer String ())
-> (Failure -> Writer String ()) -> Writer String ()
forall a b. (a -> b) -> a -> b
$ \Failure
f ->
                  do
                    String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"{\"message\": \""
                    String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON (Failure -> String
failureMessage Failure
f))
                    String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\""
                    case Failure -> Maybe Location
failureLocation Failure
f of
                      Just Location
loc ->
                        do
                          String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
", \"location\": {\"module\": \""
                          String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON (Location -> String
locationModule Location
loc))
                          String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\", \"file\": \""
                          String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON (Location -> String
locationFile Location
loc))
                          case Location -> Maybe Integer
locationLine Location
loc of
                              Just Integer
line ->
                                do
                                  String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\", \"line\": "
                                  String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Integer -> String
forall a. Show a => a -> String
show Integer
line)
                              Maybe Integer
Nothing -> String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\""
                          String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"}"
                      Maybe Location
Nothing -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"}"
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"]"
                [(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"}"
            TestAborted [(String, String)]
notes String
msg ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"{\"test\": \""
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON (Test -> String
testName Test
t))
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\", \"result\": \"aborted\", \"abortion\": {\"message\": \""
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON String
msg)
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\"}"
                [(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"}"
            TestResult
_ -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    escapeJSON :: String -> String
escapeJSON =
        (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
            (\Char
c ->
                case Char
c of
                    Char
'"' -> String
"\\\""
                    Char
'\\' -> String
"\\\\"
                    Char
_ | Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x1F -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"\\u%04X" (Char -> Int
ord Char
c)
                    Char
_ -> [Char
c]
            )

    tellNotes :: t (String, String) -> Writer String ()
tellNotes t (String, String)
notes =
      do
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
", \"notes\": ["
        t (String, String)
-> ((String, String) -> Writer String ()) -> Writer String ()
forall (m :: * -> *) (t :: * -> *) t b.
(Monad m, Foldable t) =>
t t -> (t -> WriterT String m b) -> WriterT String m ()
commas t (String, String)
notes (((String, String) -> Writer String ()) -> Writer String ())
-> ((String, String) -> Writer String ()) -> Writer String ()
forall a b. (a -> b) -> a -> b
$ \(String
key, String
value) ->
          do
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"{\"key\": \""
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON String
key)
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\", \"value\": \""
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeJSON String
value)
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\"}"
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"]"

    commas :: t t -> (t -> WriterT String m b) -> WriterT String m ()
commas t t
xs t -> WriterT String m b
block = StateT Bool (WriterT String m) () -> Bool -> WriterT String m ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT (t t
-> (t -> WriterT String m b) -> StateT Bool (WriterT String m) ()
forall (t :: * -> *) (m :: * -> *) t b.
(Foldable t, Monad m) =>
t t
-> (t -> WriterT String m b) -> StateT Bool (WriterT String m) ()
commaState t t
xs t -> WriterT String m b
block) Bool
False
    commaState :: t t
-> (t -> WriterT String m b) -> StateT Bool (WriterT String m) ()
commaState t t
xs t -> WriterT String m b
block = t t
-> (t -> StateT Bool (WriterT String m) b)
-> StateT Bool (WriterT String m) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t t
xs ((t -> StateT Bool (WriterT String m) b)
 -> StateT Bool (WriterT String m) ())
-> (t -> StateT Bool (WriterT String m) b)
-> StateT Bool (WriterT String m) ()
forall a b. (a -> b) -> a -> b
$ \t
x ->
      do
        let
            tell' :: String -> StateT Bool (WriterT String m) ()
tell' = WriterT String m () -> StateT Bool (WriterT String m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT String m () -> StateT Bool (WriterT String m) ())
-> (String -> WriterT String m ())
-> String
-> StateT Bool (WriterT String m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> WriterT String m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell
        Bool
needComma <- StateT Bool (WriterT String m) Bool
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
        if Bool
needComma
            then String -> StateT Bool (WriterT String m) ()
tell' String
"\n, "
            else String -> StateT Bool (WriterT String m) ()
tell' String
"\n  "
        Bool -> StateT Bool (WriterT String m) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put Bool
True
        WriterT String m b -> StateT Bool (WriterT String m) b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (t -> WriterT String m b
block t
x)

xmlReport :: [(Test, TestResult)] -> String
xmlReport :: Report
xmlReport [(Test, TestResult)]
results = Writer String () -> String
forall w a. Writer w a -> w
Writer.execWriter Writer String ()
writer
  where
    tell :: w -> WriterT w Identity ()
tell = w -> WriterT w Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell

    writer :: Writer String ()
writer =
      do
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"<?xml version=\"1.0\" encoding=\"utf8\"?>\n"
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"<report xmlns='urn:john-millikin:chell:report:1'>\n"
        ((Test, TestResult) -> Writer String ())
-> [(Test, TestResult)] -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Test, TestResult) -> Writer String ()
tellResult [(Test, TestResult)]
results
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"</report>"

    tellResult :: (Test, TestResult) -> Writer String ()
tellResult (Test
t, TestResult
result) =
      case TestResult
result of
        TestPassed [(String, String)]
notes ->
          do
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\t<test-run test='"
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML (Test -> String
testName Test
t))
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"' result='passed'>\n"
            [(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\t</test-run>\n"
        TestResult
TestSkipped ->
          do
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\t<test-run test='"
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML (Test -> String
testName Test
t))
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"' result='skipped'/>\n"
        TestFailed [(String, String)]
notes [Failure]
fs ->
          do
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\t<test-run test='"
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML (Test -> String
testName Test
t))
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"' result='failed'>\n"
            [Failure] -> (Failure -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Failure]
fs ((Failure -> Writer String ()) -> Writer String ())
-> (Failure -> Writer String ()) -> Writer String ()
forall a b. (a -> b) -> a -> b
$ \Failure
f ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\t\t<failure message='"
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML (Failure -> String
failureMessage Failure
f))
                case Failure -> Maybe Location
failureLocation Failure
f of
                    Just Location
loc ->
                      do
                        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"'>\n"
                        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\t\t\t<location module='"
                        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML (Location -> String
locationModule Location
loc))
                        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"' file='"
                        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML (Location -> String
locationFile Location
loc))
                        case Location -> Maybe Integer
locationLine Location
loc of
                            Just Integer
line ->
                              do
                                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"' line='"
                                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Integer -> String
forall a. Show a => a -> String
show Integer
line)
                            Maybe Integer
Nothing -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"'/>\n"
                        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\t\t</failure>\n"
                    Maybe Location
Nothing -> String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"'/>\n"
            [(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\t</test-run>\n"
        TestAborted [(String, String)]
notes String
msg ->
          do
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\t<test-run test='"
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML (Test -> String
testName Test
t))
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"' result='aborted'>\n"
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\t\t<abortion message='"
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML String
msg)
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"'/>\n"
            [(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\t</test-run>\n"
        TestResult
_ -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    escapeXML :: String -> String
escapeXML =
        (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
            (\Char
c ->
                case Char
c of
                    Char
'&' -> String
"&amp;"
                    Char
'<' -> String
"&lt;"
                    Char
'>' -> String
"&gt;"
                    Char
'"' -> String
"&quot;"
                    Char
'\'' -> String
"&apos;"
                    Char
_ -> [Char
c]
            )

    tellNotes :: t (String, String) -> Writer String ()
tellNotes t (String, String)
notes = t (String, String)
-> ((String, String) -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t (String, String)
notes (((String, String) -> Writer String ()) -> Writer String ())
-> ((String, String) -> Writer String ()) -> Writer String ()
forall a b. (a -> b) -> a -> b
$ \(String
key, String
value) ->
      do
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\t\t<note key=\""
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML String
key)
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\" value=\""
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (String -> String
escapeXML String
value)
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\"/>\n"

textReport :: [(Test, TestResult)] -> String
textReport :: Report
textReport [(Test, TestResult)]
results = Writer String () -> String
forall w a. Writer w a -> w
Writer.execWriter Writer String ()
writer
  where
    tell :: w -> WriterT w Identity ()
tell = w -> WriterT w Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell

    writer :: Writer String ()
writer =
      do
        [(Test, TestResult)]
-> ((Test, TestResult) -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Test, TestResult)]
results (Test, TestResult) -> Writer String ()
tellResult
        let stats :: (Integer, Integer, Integer, Integer)
stats = [(Test, TestResult)] -> (Integer, Integer, Integer, Integer)
resultStatistics [(Test, TestResult)]
results
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell ((Integer, Integer, Integer, Integer) -> String
formatResultStatistics (Integer, Integer, Integer, Integer)
stats)

    tellResult :: (Test, TestResult) -> Writer String ()
tellResult (Test
t, TestResult
result) =
        case TestResult
result of
            TestPassed [(String, String)]
notes ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
70 Char
'=')
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\n"
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"PASSED: "
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Test -> String
testName Test
t)
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\n"
                [(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\n\n"
            TestResult
TestSkipped ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
70 Char
'=')
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\n"
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"SKIPPED: "
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Test -> String
testName Test
t)
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\n\n"
            TestFailed [(String, String)]
notes [Failure]
fs ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
70 Char
'=')
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\n"
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"FAILED: "
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Test -> String
testName Test
t)
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\n"
                [(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
70 Char
'-')
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\n"
                [Failure] -> (Failure -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Failure]
fs ((Failure -> Writer String ()) -> Writer String ())
-> (Failure -> Writer String ()) -> Writer String ()
forall a b. (a -> b) -> a -> b
$ \Failure
f ->
                  do
                    case Failure -> Maybe Location
failureLocation Failure
f of
                        Just Location
loc ->
                          do
                            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Location -> String
locationFile Location
loc)
                            case Location -> Maybe Integer
locationLine Location
loc of
                                Just Integer
line ->
                                  do
                                    String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
":"
                                    String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Integer -> String
forall a. Show a => a -> String
show Integer
line)
                                Maybe Integer
Nothing -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\n"
                        Maybe Location
Nothing -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Failure -> String
failureMessage Failure
f)
                    String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\n\n"
            TestAborted [(String, String)]
notes String
msg ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
70 Char
'=')
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\n"
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"ABORTED: "
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Test -> String
testName Test
t)
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\n"
                [(String, String)] -> Writer String ()
forall (t :: * -> *).
Foldable t =>
t (String, String) -> Writer String ()
tellNotes [(String, String)]
notes
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
70 Char
'-')
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\n"
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
msg
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\n\n"
            TestResult
_ -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    tellNotes :: t (String, String) -> Writer String ()
tellNotes t (String, String)
notes = t (String, String)
-> ((String, String) -> Writer String ()) -> Writer String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t (String, String)
notes (((String, String) -> Writer String ()) -> Writer String ())
-> ((String, String) -> Writer String ()) -> Writer String ()
forall a b. (a -> b) -> a -> b
$ \(String
key, String
value) ->
      do
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
key
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"="
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
value
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
"\n"

formatResultStatistics :: (Integer, Integer, Integer, Integer) -> String
formatResultStatistics :: (Integer, Integer, Integer, Integer) -> String
formatResultStatistics (Integer, Integer, Integer, Integer)
stats = Writer String () -> String
forall w a. Writer w a -> w
Writer.execWriter Writer String ()
writer where
  writer :: Writer String ()
writer =
    do
      let
          (Integer
passed, Integer
skipped, Integer
failed, Integer
aborted) = (Integer, Integer, Integer, Integer)
stats

      if Integer
failed Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
&& Integer
aborted Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
          then String -> Writer String ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell String
"PASS: "
          else String -> Writer String ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell String
"FAIL: "

      let
          putNum :: String -> a -> String -> WriterT String m ()
putNum String
comma a
n String
what = String -> WriterT String m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell (String -> WriterT String m ()) -> String -> WriterT String m ()
forall a b. (a -> b) -> a -> b
$
              if a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1
                  then String
comma String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"1 test " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
what
                  else String
comma String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" tests " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
what

      let
          total :: Integer
total = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Integer
passed, Integer
skipped, Integer
failed, Integer
aborted]

      String -> Integer -> String -> Writer String ()
forall (m :: * -> *) a.
(Monad m, Eq a, Num a, Show a) =>
String -> a -> String -> WriterT String m ()
putNum String
"" Integer
total String
"run"
      (String -> Integer -> String -> Writer String ()
forall (m :: * -> *) a.
(Monad m, Eq a, Num a, Show a) =>
String -> a -> String -> WriterT String m ()
putNum String
", " Integer
passed String
"passed")
      Bool -> Writer String () -> Writer String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
skipped Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) (String -> Integer -> String -> Writer String ()
forall (m :: * -> *) a.
(Monad m, Eq a, Num a, Show a) =>
String -> a -> String -> WriterT String m ()
putNum String
", " Integer
skipped String
"skipped")
      Bool -> Writer String () -> Writer String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
failed Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) (String -> Integer -> String -> Writer String ()
forall (m :: * -> *) a.
(Monad m, Eq a, Num a, Show a) =>
String -> a -> String -> WriterT String m ()
putNum String
", " Integer
failed String
"failed")
      Bool -> Writer String () -> Writer String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
aborted Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) (String -> Integer -> String -> Writer String ()
forall (m :: * -> *) a.
(Monad m, Eq a, Num a, Show a) =>
String -> a -> String -> WriterT String m ()
putNum String
", " Integer
aborted String
"aborted")

resultStatistics :: [(Test, TestResult)] -> (Integer, Integer, Integer, Integer)
resultStatistics :: [(Test, TestResult)] -> (Integer, Integer, Integer, Integer)
resultStatistics [(Test, TestResult)]
results = State (Integer, Integer, Integer, Integer) ()
-> (Integer, Integer, Integer, Integer)
-> (Integer, Integer, Integer, Integer)
forall s a. State s a -> s -> s
State.execState State (Integer, Integer, Integer, Integer) ()
state (Integer
0, Integer
0, Integer
0, Integer
0)
  where
    state :: State (Integer, Integer, Integer, Integer) ()
state = [(Test, TestResult)]
-> ((Test, TestResult)
    -> State (Integer, Integer, Integer, Integer) ())
-> State (Integer, Integer, Integer, Integer) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Test, TestResult)]
results (((Test, TestResult)
  -> State (Integer, Integer, Integer, Integer) ())
 -> State (Integer, Integer, Integer, Integer) ())
-> ((Test, TestResult)
    -> State (Integer, Integer, Integer, Integer) ())
-> State (Integer, Integer, Integer, Integer) ()
forall a b. (a -> b) -> a -> b
$ \(Test
_, TestResult
result) -> case TestResult
result of
        TestPassed{} ->  ((Integer, Integer, Integer, Integer)
 -> (Integer, Integer, Integer, Integer))
-> State (Integer, Integer, Integer, Integer) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify (\(Integer
p, Integer
s, Integer
f, Integer
a) -> (Integer
pInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1, Integer
s, Integer
f, Integer
a))
        TestSkipped{} -> ((Integer, Integer, Integer, Integer)
 -> (Integer, Integer, Integer, Integer))
-> State (Integer, Integer, Integer, Integer) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify (\(Integer
p, Integer
s, Integer
f, Integer
a) -> (Integer
p, Integer
sInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1, Integer
f, Integer
a))
        TestFailed{} ->  ((Integer, Integer, Integer, Integer)
 -> (Integer, Integer, Integer, Integer))
-> State (Integer, Integer, Integer, Integer) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify (\(Integer
p, Integer
s, Integer
f, Integer
a) -> (Integer
p, Integer
s, Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1, Integer
a))
        TestAborted{} -> ((Integer, Integer, Integer, Integer)
 -> (Integer, Integer, Integer, Integer))
-> State (Integer, Integer, Integer, Integer) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify (\(Integer
p, Integer
s, Integer
f, Integer
a) -> (Integer
p, Integer
s, Integer
f, Integer
aInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1))
        TestResult
_ -> () -> State (Integer, Integer, Integer, Integer) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()