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 "ColorMode" ColorMode
ColorModeAuto String -> Either String ColorMode
parseMode ColorMode -> String
showMode
  where
    parseMode :: String -> Either String ColorMode
parseMode s :: String
s =
        case String
s of
            "always" -> ColorMode -> Either String ColorMode
forall a b. b -> Either a b
Right ColorMode
ColorModeAlways
            "never" -> ColorMode -> Either String ColorMode
forall a b. b -> Either a b
Right ColorMode
ColorModeNever
            "auto" -> ColorMode -> Either String ColorMode
forall a b. b -> Either a b
Right ColorMode
ColorModeAuto
            _ -> 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]
++ " is not in {\"always\", \"never\", \"auto\"}.")
    showMode :: ColorMode -> String
showMode mode :: ColorMode
mode =
        case ColorMode
mode of
            ColorModeAlways -> "always"
            ColorModeNever -> "never"
            ColorModeAuto -> "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
              (\o :: Option Bool
o -> Option Bool
o
                  { optionShortFlags :: String
optionShortFlags = ['v']
                  , optionLongFlags :: [String]
optionLongFlags = ["verbose"]
                  , optionDefault :: Bool
optionDefault = Bool
False
                  , optionDescription :: String
optionDescription = "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 "xml-report" ""
                "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 "json-report" ""
                "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 "text-report" ""
                "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 "seed" Maybe Int
forall a. Maybe a
Nothing
                "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 "timeout" Maybe Int
forall a. Maybe a
Nothing
                "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
              (\o :: Option ColorMode
o -> Option ColorMode
o
                  { optionLongFlags :: [String]
optionLongFlags = ["color"]
                  , optionDefault :: ColorMode
optionDefault = ColorMode
ColorModeAuto
                  , optionDescription :: String
optionDescription = "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 suites :: [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
$ \opts :: MainOptions
opts args :: [String]
args ->
  do
    -- validate/sanitize test options
    Int
seed <-
        case MainOptions -> Maybe Int
optSeed MainOptions
opts of
            Just s :: Int
s -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
s
            Nothing -> IO Int
forall a. Random a => IO a
randomIO
    Maybe Int
timeout <-
        case MainOptions -> Maybe Int
optTimeout MainOptions
opts of
            Nothing -> Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
            Just t :: Int
t -> if Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 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 "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
            ColorModeNever -> Output -> IO Output
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Output
plainOutput (MainOptions -> Bool
optVerbose MainOptions
opts))
            ColorModeAlways -> Output -> IO Output
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Output
colorOutput (MainOptions -> Bool
optVerbose MainOptions
opts))
            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
$ \t :: 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
$ \(path :: String
path, fmt :: String
fmt, toText :: 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
$ \h :: 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 ("Writing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fmt String -> String -> String
forall a. [a] -> [a] -> [a]
++ " 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
        (_, _, failed :: Integer
failed, aborted :: 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
== 0 Bool -> Bool -> Bool
&& Integer
aborted Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0
        then IO ()
forall a. IO a
exitSuccess
        else IO ()
forall a. IO a
exitFailure

matchesFilter :: [String] -> Test -> Bool
matchesFilter :: [String] -> Test -> Bool
matchesFilter filters :: [String]
filters = Test -> Bool
check
  where
    check :: Test -> Bool
check t :: 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 name :: String
name f :: 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
name

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

getReports :: MainOptions -> [(String, String, Report)]
getReports :: MainOptions -> [(String, String, Report)]
getReports opts :: 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
        "" -> []
        path :: String
path -> [(String
path, "XML", Report
xmlReport)]
    json :: [(String, String, Report)]
json = case MainOptions -> String
optJsonReport MainOptions
opts of
        "" -> []
        path :: String
path -> [(String
path, "JSON", Report
jsonReport)]
    text :: [(String, String, Report)]
text = case MainOptions -> String
optTextReport MainOptions
opts of
        "" -> []
        path :: String
path -> [(String
path, "text", Report
textReport)]

jsonReport :: [(Test, TestResult)] -> String
jsonReport :: Report
jsonReport results :: [(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 "{\"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 "]}"

    tellResult :: (Test, TestResult) -> Writer String ()
tellResult (t :: Test
t, result :: TestResult
result) =
        case TestResult
result of
            TestPassed notes :: [(String, String)]
notes ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "{\"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 "\", \"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 "}"
            TestSkipped ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "{\"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 "\", \"result\": \"skipped\"}"
            TestFailed notes :: [(String, String)]
notes fs :: [Failure]
fs ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "{\"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 "\", \"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
$ \f :: Failure
f ->
                  do
                    String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "{\"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 "\""
                    case Failure -> Maybe Location
failureLocation Failure
f of
                      Just loc :: Location
loc ->
                        do
                          String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell ", \"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 "\", \"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 line :: Integer
line ->
                                do
                                  String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\", \"line\": "
                                  String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Integer -> String
forall a. Show a => a -> String
show Integer
line)
                              Nothing -> String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\""
                          String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "}"
                      Nothing -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "}"
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "]"
                [(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 "}"
            TestAborted notes :: [(String, String)]
notes msg :: String
msg ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "{\"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 "\", \"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)] -> 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 "}"
            _ -> () -> 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
            (\c :: Char
c ->
                case Char
c of
                    '"' -> "\\\""
                    '\\' -> "\\\\"
                    _ | Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x1F -> String -> Int -> String
forall r. PrintfType r => String -> r
printf "\\u%04X" (Char -> Int
ord Char
c)
                    _ -> [Char
c]
            )

    tellNotes :: t (String, String) -> Writer String ()
tellNotes notes :: t (String, String)
notes =
      do
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell ", \"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
$ \(key :: String
key, value :: String
value) ->
          do
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "{\"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 "\", \"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 -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "]"

    commas :: t t -> (t -> WriterT String m b) -> WriterT String m ()
commas xs :: t t
xs block :: 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 xs :: t t
xs block :: 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
$ \x :: 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' "\n, "
            else String -> StateT Bool (WriterT String m) ()
tell' "\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 results :: [(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 "<?xml version=\"1.0\" encoding=\"utf8\"?>\n"
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "<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 "</report>"

    tellResult :: (Test, TestResult) -> Writer String ()
tellResult (t :: Test
t, result :: TestResult
result) =
      case TestResult
result of
        TestPassed notes :: [(String, String)]
notes ->
          do
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\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 "' 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 "\t</test-run>\n"
        TestSkipped ->
          do
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\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 "' result='skipped'/>\n"
        TestFailed notes :: [(String, String)]
notes fs :: [Failure]
fs ->
          do
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\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 "' 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
$ \f :: Failure
f ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\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 loc :: Location
loc ->
                      do
                        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "'>\n"
                        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\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 "' 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 line :: Integer
line ->
                              do
                                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "' line='"
                                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Integer -> String
forall a. Show a => a -> String
show Integer
line)
                            Nothing -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "'/>\n"
                        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\t\t</failure>\n"
                    Nothing -> String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "'/>\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 "\t</test-run>\n"
        TestAborted notes :: [(String, String)]
notes msg :: String
msg ->
          do
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\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 "' result='aborted'>\n"
            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\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 "'/>\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 "\t</test-run>\n"
        _ -> () -> 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
            (\c :: Char
c ->
                case Char
c of
                    '&' -> "&amp;"
                    '<' -> "&lt;"
                    '>' -> "&gt;"
                    '"' -> "&quot;"
                    '\'' -> "&apos;"
                    _ -> [Char
c]
            )

    tellNotes :: t (String, String) -> Writer String ()
tellNotes notes :: 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
$ \(key :: String
key, value :: String
value) ->
      do
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\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 "\" 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 "\"/>\n"

textReport :: [(Test, TestResult)] -> String
textReport :: Report
textReport results :: [(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 (t :: Test
t, result :: TestResult
result) =
        case TestResult
result of
            TestPassed notes :: [(String, String)]
notes ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate 70 '=')
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "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 "\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 "\n\n"
            TestSkipped ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate 70 '=')
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "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 "\n\n"
            TestFailed notes :: [(String, String)]
notes fs :: [Failure]
fs ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate 70 '=')
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "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 "\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 70 '-')
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\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
$ \f :: Failure
f ->
                  do
                    case Failure -> Maybe Location
failureLocation Failure
f of
                        Just loc :: 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 line :: Integer
line ->
                                  do
                                    String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell ":"
                                    String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Integer -> String
forall a. Show a => a -> String
show Integer
line)
                                Nothing -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
                        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 "\n\n"
            TestAborted notes :: [(String, String)]
notes msg :: String
msg ->
              do
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell (Int -> Char -> String
forall a. Int -> a -> [a]
replicate 70 '=')
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "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 "\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 70 '-')
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
msg
                String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n\n"
            _ -> () -> Writer String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    tellNotes :: t (String, String) -> Writer String ()
tellNotes notes :: 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
$ \(key :: String
key, value :: 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 -> Writer String ()
forall w. w -> WriterT w Identity ()
tell String
value
        String -> Writer String ()
forall w. w -> WriterT w Identity ()
tell "\n"

formatResultStatistics :: (Integer, Integer, Integer, Integer) -> String
formatResultStatistics :: (Integer, Integer, Integer, Integer) -> String
formatResultStatistics stats :: (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
          (passed :: Integer
passed, skipped :: Integer
skipped, failed :: Integer
failed, aborted :: Integer
aborted) = (Integer, Integer, Integer, Integer)
stats

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

      let
          putNum :: String -> a -> String -> WriterT String m ()
putNum comma :: String
comma n :: a
n what :: 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
== 1
                  then String
comma String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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]
++ " 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 "" Integer
total "run"
      (String -> Integer -> String -> Writer String ()
forall (m :: * -> *) a.
(Monad m, Eq a, Num a, Show a) =>
String -> a -> String -> WriterT String m ()
putNum ", " Integer
passed "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
> 0) (String -> Integer -> String -> Writer String ()
forall (m :: * -> *) a.
(Monad m, Eq a, Num a, Show a) =>
String -> a -> String -> WriterT String m ()
putNum ", " Integer
skipped "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
> 0) (String -> Integer -> String -> Writer String ()
forall (m :: * -> *) a.
(Monad m, Eq a, Num a, Show a) =>
String -> a -> String -> WriterT String m ()
putNum ", " Integer
failed "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
> 0) (String -> Integer -> String -> Writer String ()
forall (m :: * -> *) a.
(Monad m, Eq a, Num a, Show a) =>
String -> a -> String -> WriterT String m ()
putNum ", " Integer
aborted "aborted")

resultStatistics :: [(Test, TestResult)] -> (Integer, Integer, Integer, Integer)
resultStatistics :: [(Test, TestResult)] -> (Integer, Integer, Integer, Integer)
resultStatistics results :: [(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 (0, 0, 0, 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
$ \(_, result :: 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 (\(p :: Integer
p, s :: Integer
s, f :: Integer
f, a :: Integer
a) -> (Integer
pInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+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 (\(p :: Integer
p, s :: Integer
s, f :: Integer
f, a :: Integer
a) -> (Integer
p, Integer
sInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+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 (\(p :: Integer
p, s :: Integer
s, f :: Integer
f, a :: Integer
a) -> (Integer
p, Integer
s, Integer
fInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+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 (\(p :: Integer
p, s :: Integer
s, f :: Integer
f, a :: Integer
a) -> (Integer
p, Integer
s, Integer
f, Integer
aInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1))
        _ -> () -> State (Integer, Integer, Integer, Integer) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()