{-# LANGUAGE OverloadedStrings #-}moduleTest.Chell.TypeswhereimportqualifiedControl.ExceptionimportControl.Exception(SomeException)importqualifiedData.TextimportData.Text(Text)importSystem.Timeout(timeout)dataTest=TestText(TestOptions->IOTestResult)instanceShowTestwhereshow(Testname_)="<Test "++showname++">"dataTestOptions=TestOptions{testOptionSeed_::Int,testOptionTimeout_::MaybeInt}deriving(Show,Eq)-- | @testName (Test name _) = name@testName::Test->TexttestName(Testname_)=name-- | Run a test, wrapped in error handlers. This will return 'TestAborted' if-- the test throws an exception or times out.runTest::Test->TestOptions->IOTestResultrunTest(Test_io)options=handleJankyIOoptions(iooptions)(return[])handleJankyIO::TestOptions->IOTestResult->IO[(Text,Text)]->IOTestResulthandleJankyIOoptsgetResultgetNotes=doletwithTimeout=casetestOptionTimeout_optsofJusttime->timeout(time*1000)Nothing->fmapJustlethitTimeout=Data.Text.packstrwherestr="Test timed out after "++showtime++" milliseconds"Justtime=testOptionTimeout_optsleterrorExc::SomeException->TexterrorExcexc=Data.Text.pack("Test aborted due to exception: "++showexc)tried<-withTimeout(Control.Exception.trygetResult)casetriedofJust(Rightret)->returnretNothing->donotes<-getNotesreturn(TestAbortednoteshitTimeout)Just(Leftexc)->donotes<-getNotesreturn(TestAbortednotes(errorExcexc))dataTestResult=TestPassed[(Text,Text)]|TestSkipped|TestFailed[(Text,Text)][Failure]|TestAborted[(Text,Text)]Textderiving(Show,Eq)dataFailure=Failure(MaybeLocation)Textderiving(Show,Eq)dataLocation=Location{locationFile::Text,locationModule::Text,locationLine::Integer}deriving(Show,Eq)-- | A tree of 'Test's; use the 'test' and 'suite' helper functions to build-- up a 'Suite'.dataSuite=SuiteText[Suite]|SuiteTestTestinstanceShowSuitewhereshows="<Suite "++show(suiteNames)++">"test::Test->Suitetest=SuiteTestsuite::Text->[Suite]->Suitesuite=SuitesuiteName::Suite->TextsuiteName(Suitename_)=namesuiteName(SuiteTestt)=testNamet-- | The full list of 'Test's contained within this 'Suite'. Each 'Test'-- is returned with its name modified to include the name of its parent-- 'Suite's.suiteTests::Suite->[Test]suiteTests=loop""whereloopprefixs=letname=ifData.Text.nullprefixthensuiteNameselseData.Text.concat[prefix,".",suiteNames]incasesofSuite_suites->concatMap(loopname)suitesSuiteTest(Test_io)->[Testnameio]