-- | Allows HUnit test cases to be used with the test-framework package.---- For an example of how to use test-framework, please see <http://github.com/batterseapower/test-framework/raw/master/example/Test/Framework/Example.lhs>moduleTest.Framework.Providers.HUnit(testCase,hUnitTestToTests,)whereimportTest.Framework.Providers.APIimportqualifiedTest.HUnit.BaseimportTest.HUnit.Lang-- | Create a 'Test' for a HUnit 'Assertion'testCase::TestName->Assertion->TesttestCasename=Testname.TestCase-- | Adapt an existing HUnit test into a list of test-framework tests.-- This is useful when migrating your existing HUnit test suite to test-framework.hUnitTestToTests::Test.HUnit.Base.Test->[Test]hUnitTestToTests=go""wheregodesc(Test.HUnit.Base.TestCasea)=[testCasedesca]godesc(Test.HUnit.Base.TestLabelst)=go(desc++":"++s)tgodesc(Test.HUnit.Base.TestListts)-- If the list occurs at the top level (with no description above it),-- just return that list straightforwardly|nulldesc=concatMap(godesc)ts-- If the list occurs with a description, turn that into a honest-to-god-- test group. This is heuristic, but likely to give good results|otherwise=[testGroupdesc(concatMap(go"")ts)]instanceTestResultlikeTestCaseRunningTestCaseResultwheretestSucceeded=testCaseSucceededdataTestCaseRunning=TestCaseRunninginstanceShowTestCaseRunningwhereshowTestCaseRunning="Running"dataTestCaseResult=TestCasePassed|TestCaseFailedString|TestCaseErrorStringinstanceShowTestCaseResultwhereshowresult=caseresultofTestCasePassed->"OK"TestCaseFailedmessage->messageTestCaseErrormessage->"ERROR: "++messagetestCaseSucceeded::TestCaseResult->BooltestCaseSucceededTestCasePassed=TruetestCaseSucceeded_=FalsenewtypeTestCase=TestCaseAssertioninstanceTestlikeTestCaseRunningTestCaseResultTestCasewhererunTesttopts(TestCaseassertion)=runTestCasetoptsassertiontestTypeName_="Test Cases"runTestCase::CompleteTestOptions->Assertion->IO(TestCaseRunning:~>TestCaseResult,IO())runTestCasetoptsassertion=runImprovingIO$doyieldImprovementTestCaseRunningmb_result<-maybeTimeoutImprovingIO(unK$topt_timeouttopts)$liftIO(myPerformTestCaseassertion)return(mb_result`orElse`TestCaseError"Timed out")myPerformTestCase::Assertion->IOTestCaseResultmyPerformTestCaseassertion=doresult<-performTestCaseassertionreturn$caseresultofNothing->TestCasePassedJust(True,message)->TestCaseFailedmessageJust(False,message)->TestCaseErrormessage