{-# LANGUAGE OverloadedStrings #-} module Tests.Test.HUnitPlus.Reporting(tests) where import Data.List import Distribution.TestSuite(Test(..), TestInstance(..), Progress(Finished), Result(Pass, Fail), testGroup) import Test.HUnitPlus.Reporting import Tests.Test.HUnitPlus.ReporterUtils(ReportEvent(..)) import qualified Tests.Test.HUnitPlus.ReporterUtils as Utils type ReporterState = [ReportEvent] type CombinedReporterState = (ReporterState, ReporterState) type ReporterOp = Utils.ReporterOp ReporterState type CombinedReporterOp = Utils.ReporterOp CombinedReporterState type DefaultReporterOp = Utils.ReporterOp Int loggingReporter = Utils.loggingReporter combinedLoggingReporter :: Reporter CombinedReporterState combinedLoggingReporter = combinedReporter loggingReporter loggingReporter reportSystemErr = Utils.reportSystemErr combinedLoggingReporter reportSystemOut = Utils.reportSystemOut combinedLoggingReporter reportFailure = Utils.reportFailure combinedLoggingReporter reportError = Utils.reportError combinedLoggingReporter reportSkip = Utils.reportSkip combinedLoggingReporter reportProgress = Utils.reportProgress combinedLoggingReporter reportStartCase = Utils.reportStartCase combinedLoggingReporter reportEndCase = Utils.reportEndCase combinedLoggingReporter runReporterTest = Utils.runReporterTest combinedLoggingReporter reportStartSuite = Utils.reportStartSuite combinedLoggingReporter reportEndSuite = Utils.reportEndSuite combinedLoggingReporter reportEnd = Utils.reportEnd combinedLoggingReporter reporterActions :: [(String, CombinedReporterOp, ReporterState)] reporterActions = [ ("systemErr", reportSystemErr "Error Message", [SystemErr "Error Message"]), ("systemOut", reportSystemOut "Output Message", [SystemOut "Output Message"]), ("failure", reportFailure "Failure Message", [Failure "Failure Message"]), ("error", reportError "Error Message", [Error "Error Message"]), ("progress", reportProgress "Progress Message", [Progress "Progress Message"]), ("skip", reportSkip, [Skip]), ("startCase", reportStartCase, [StartCase]), ("endCase", reportEndCase 1.0, [EndCase 1.0]), ("startSuite", reportStartSuite, [StartSuite]), ("endSuite", reportEndSuite 2.0, [EndSuite 2.0]), ("end", reportEnd 3.0, [End 3.0]) ] defaultReporterCases :: [(String, State -> Int -> IO Int, Int)] defaultReporterCases = [ ("systemErr", (reporterSystemErr defaultReporter) "Error Message", 1), ("systemOut", (reporterSystemOut defaultReporter) "Output Message", 2), ("failure", (reporterFailure defaultReporter) "Failure Message", 3), ("error", (reporterError defaultReporter) "Error Message", 4), ("progress", (reporterCaseProgress defaultReporter) "Progress Message", 5), ("skip", reporterSkipCase defaultReporter, 6), ("startCase", reporterStartCase defaultReporter, 7), ("endCase", (reporterEndCase defaultReporter) 1.0, 8), ("startSuite", reporterStartSuite defaultReporter, 9), ("endSuite", (reporterEndSuite defaultReporter) 2.0, 10), ("end", (reporterEnd defaultReporter) 3.0 . stCounts, 11) ] reporterCases :: [[(String, CombinedReporterOp, ReporterState)]] reporterCases = map (: []) reporterActions ++ foldr (\a accum -> foldr (\b accum -> [a, b] : accum) accum reporterActions) [] reporterActions genCombinedReporterTest :: [(String, CombinedReporterOp, ReporterState)] -> Test genCombinedReporterTest testactions = let name = intercalate "_" (map (\(a, _, _) -> a) testactions) ops = map (\(_, a, _) -> a) testactions log = concat (map (\(_, _, a) -> a) testactions) expected = (log, log) out = TestInstance { name = "combinedReporter_" ++ name, tags = [], options = [], setOption = (\_ _ -> Right out), run = runReporterTest ops expected show >>= return . Finished } in Test out genDefaultReporterTest :: (String, State -> Int -> IO Int, Int) -> Test genDefaultReporterTest (name, reporterAction, reporterState) = let runTest = do result <- reporterAction Utils.initState reporterState if result == reporterState then return (Finished Pass) else return (Finished (Fail "defaultReporter altered state!")) out = TestInstance { name = "defaultReporter_" ++ name, tags = [], options = [], run = runTest, setOption = (\_ _ -> Right out) } in Test out tests :: Test tests = testGroup "Reporting" (map genCombinedReporterTest reporterCases ++ map genDefaultReporterTest defaultReporterCases)