{-|
This module defines functions for notifying all test reporters registered about
particular events in the lifecycle of a test run.
Further, it defines the standard test reporters for HTF's various output formats.
-}moduleTest.Framework.TestReporter(reportAllTests,reportGlobalStart,reportTestStart,reportTestResult,reportGlobalResults,defaultTestReporters)whereimportTest.Framework.TestTypesimportTest.Framework.LocationimportTest.Framework.ColorsimportTest.Framework.UtilsimportTest.Framework.JsonOutputimportSystem.IOimportControl.Monad.RWSimportText.PrettyPrintimportqualifiedData.ByteStringasBSimportqualifiedData.ByteString.LazyasBSL-- | Invokes 'tr_reportAllTests' on all test reporters registered.reportAllTests::ReportAllTestsreportAllTeststests=doreps<-askstc_reportersmapM_(\r->tr_reportAllTestsrtests)reps-- | Invokes 'tr_reportGlobalStart' on all test reporters registered.reportGlobalStart::ReportGlobalStartreportGlobalStarttests=doreps<-askstc_reportersmapM_(\r->tr_reportGlobalStartrtests)reps-- | Invokes 'tr_reportTestStart' on all test reporters registered.reportTestStart::ReportTestStartreportTestStartt=doreps<-askstc_reportersmapM_(\r->tr_reportTestStartrt)reps-- | Invokes 'tr_reportTestResult' on all test reporters registered.reportTestResult::ReportTestResultreportTestResultt=doreps<-askstc_reportersmapM_(\r->tr_reportTestResultrt)reps-- | Invokes 'tr_reportGlobalResults' on all test reporters registered.reportGlobalResults::ReportGlobalResultsreportGlobalResultstl1l2l3l4=doreps<-askstc_reportersmapM_(\r->tr_reportGlobalResultsrtl1l2l3l4)reps-- | The default test reporters for HTF.defaultTestReporters::Bool-- ^ 'True' if tests are run in parallel->Bool-- ^ 'True' if machine output should be produced->[TestReporter]defaultTestReportersinParallelforMachine=case(inParallel,forMachine)of(False,False)->[TestReporter{tr_id="rep_seq_human",tr_reportAllTests=reportAllTestsH,tr_reportGlobalStart=reportGlobalStartHS,tr_reportTestStart=reportTestStartHS,tr_reportTestResult=reportTestResultHS,tr_reportGlobalResults=reportGlobalResultsH}](True,False)->[TestReporter{tr_id="rep_par_human",tr_reportAllTests=reportAllTestsH,tr_reportGlobalStart=reportGlobalStartHP,tr_reportTestStart=reportTestStartHP,tr_reportTestResult=reportTestResultHP,tr_reportGlobalResults=reportGlobalResultsH}](False,True)->[TestReporter{tr_id="rep_seq_machine",tr_reportAllTests=reportAllTestsM,tr_reportGlobalStart=reportGlobalStartMS,tr_reportTestStart=reportTestStartMS,tr_reportTestResult=reportTestResultMS,tr_reportGlobalResults=reportGlobalResultsM}](True,True)->[TestReporter{tr_id="rep_par_machine",tr_reportAllTests=reportAllTestsM,tr_reportGlobalStart=reportGlobalStartMP,tr_reportTestStart=reportTestStartMP,tr_reportTestResult=reportTestResultMP,tr_reportGlobalResults=reportGlobalResultsM}]---- output for humans--humanTestName::GenFlatTesta->StringhumanTestNameft=flatName(ft_pathft)++caseft_locationftofNothing->""Justloc->" ("++showLocloc++")"reportHumanTestStartMessage::ReportLevel->GenFlatTesta->TR()reportHumanTestStartMessagelevelft=dot<-liftIO$colorizetestStartColor"[TEST] "reportTRlevel(t++(humanTestNameft))-- sequentialreportGlobalStartHS::ReportGlobalStartreportGlobalStartHS_=return()reportTestStartHS::ReportTestStartreportTestStartHSft=reportHumanTestStartMessageDebugftreportTestResultHS::ReportTestResultreportTestResultHSftr=letres=rr_result(ft_payloadftr)msg=attachCallStack(rr_message(ft_payloadftr))(rr_callers(ft_payloadftr))incaseresofPass->dosuf<-okSuffixreportMessageDebugmsgsufPending->doreportHumanTestStartMessageIfNeededsuf<-pendingSuffixreportMessageInfomsgsufFail->doreportHumanTestStartMessageIfNeededsuf<-failureSuffixreportMessageInfomsgsufError->doreportHumanTestStartMessageIfNeededsuf<-errorSuffixreportMessageInfomsgsufwhereattachCallStackmsgcallStack=casereversecallStackof[]->msgl->ensureNewlinemsg++unlines(mapformatCallStackEleml)formatCallStackElem(mMsg,loc)=" called from "++showLocloc++(casemMsgofNothing->""Justs->" ("++s++")")reportHumanTestStartMessageIfNeeded=dotc<-askwhen(tc_quiettc)(reportHumanTestStartMessageInfoftr)reportMessagelevelmsgsuffix=reportTRlevel(ensureNewlinemsg++suffix++timeStr)timeStr=" ("++show(rr_wallTimeMs(ft_payloadftr))++"ms)\n"failureSuffix=liftIO$colorizewarningColor"*** Failed!"errorSuffix=liftIO$colorizewarningColor"@@@ Error!"pendingSuffix=liftIO$colorizependingColor"^^^ Pending!"okSuffix=liftIO$colorizetestOkColor"+++ OK"-- parallelreportGlobalStartHP::ReportGlobalStartreportGlobalStartHP_=return()reportTestStartHP::ReportTestStartreportTestStartHPft=doreportTRDebug("Starting "++(humanTestNameft))reportTestResultHP::ReportTestResultreportTestResultHPftr=doreportHumanTestStartMessageDebugftrreportTestResultHSftr-- results and all testsreportAllTestsH::ReportAllTestsreportAllTestsHl=reportDocInfo(renderTestNamesl)reportGlobalResultsH::ReportGlobalResultsreportGlobalResultsHtpassedLpendingLfailedLerrorL=doletpassed=lengthpassedLpending=lengthpendingLfailed=lengthfailedLerror=lengtherrorLtotal=passed+failed+error+pendingpendings<-liftIO$colorizependingColor"* Pending:"failures<-liftIO$colorizewarningColor"* Failures:"errors<-liftIO$colorizewarningColor"* Errors:"reportTRInfo("* Tests: "++showtotal++"\n"++"* Passed: "++showpassed++"\n"++pendings++" "++showpending++"\n"++failures++" "++showfailed++"\n"++errors++" "++showerror)when(pending>0)$reportDocInfo(text('\n':pendings)$$renderTestNames'(reversependingL))when(failed>0)$reportDocInfo(text('\n':failures)$$renderTestNames'(reversefailedL))when(error>0)$reportDocInfo(text('\n':errors)$$renderTestNames'(reverseerrorL))reportTRInfo("\nTotal execution time: "++showt++"ms")whererenderTestNames'rrs=nest2$renderTestNamesrrsrenderTestNames::[GenFlatTesta]->DocrenderTestNamesl=vcat(map(\ft->text"*"<+>text(humanTestNameft))l)---- output for machines---- sequentialreportGlobalStartMS::ReportGlobalStartreportGlobalStartMS_=return()reportTestStartMS::ReportTestStartreportTestStartMSft=letjson=mkTestStartEventObjft(flatName(ft_pathft))inreportJsonTRjsonreportTestResultMS::ReportTestResultreportTestResultMSftr=letjson=mkTestEndEventObjftr(flatName(ft_pathftr))inreportJsonTRjson-- parallelreportGlobalStartMP::ReportGlobalStartreportGlobalStartMP_=return()reportTestStartMP::ReportTestStartreportTestStartMP=reportTestStartMSreportTestResultMP::ReportTestResultreportTestResultMP=reportTestResultMS-- results and all testsreportAllTestsM::ReportAllTestsreportAllTestsMl=letjson=mkTestListObj(map(\ft->(ft,flatName(ft_pathft)))l)inreportJsonTRjsonreportGlobalResultsM::ReportGlobalResultsreportGlobalResultsMtpasspendingfailederrors=letjson=mkTestResultsObjt(lengthpass)(lengthpending)(lengthfailed)(lengtherrors)inreportJsonTRjson---- General reporting routines--reportDoc::ReportLevel->Doc->TR()reportDocleveldoc=reportTRlevel(renderdoc)reportTR::ReportLevel->String->TR()reportTRlevelmsg=dotc<-askreportGentclevel(\h->hPutStrLnhmsg)reportBytesTR::ReportLevel->BS.ByteString->TR()reportBytesTRlevelmsg=dotc<-askreportGentclevel(\h->BS.hPuthmsg)reportLazyBytesTR::ReportLevel->BSL.ByteString->TR()reportLazyBytesTRlevelmsg=dotc<-askreportGentclevel(\h->BSL.hPuthmsg)reportJsonTR::HTFJsonObja=>a->TR()reportJsonTRx=reportLazyBytesTRInfo(decodeObjx)dataReportLevel=Debug|Infoderiving(Eq,Ord)reportGen::TestConfig->ReportLevel->(Handle->IO())->TR()reportGentclevelfun=unless(tc_quiettc&&level<Info)$casetc_outputtcofTestOutputHandleh_->liftIO(funh)TestOutputSplittedfp->do-- split mode: one file for each result to avoid locking on windowsix<-getsts_indexletrealFp=fp++(showix)-- just append the index at the end of the file given as output parametermodify(\x->x{ts_index=ts_indexx+1})liftIO$withFilerealFpWriteModefun