{-# LANGUAGE OverloadedStrings #-}{-# LANGUAGE TemplateHaskell #-}{-# LANGUAGE TypeSynonymInstances #-}{-# LANGUAGE FlexibleInstances #-}moduleTest.Chell(-- * MaindefaultMain-- * Test suites,Suite,suite,suiteName,suiteTests,test,skipIf,skipWhen-- * Basic testing library-- $doc-basic-testing,Assertion(..),AssertionResult(..),IsAssertion,Assertions,assertions,assert,expect,Test.Chell.fail,trace,note-- ** Assertions,equal,notEqual,equalWithin,just,nothing,left,right,throws,throwsEq,greater,greaterEqual,lesser,lesserEqual,sameItems,equalItems,IsText,equalLines-- * Constructing tests,Test(..),testName,runTest,TestOptions,testOptionSeed,testOptionTimeout,TestResult(..),Failure(..),Location(..))whereimportqualifiedControl.ApplicativeimportqualifiedControl.ExceptionimportControl.Exception(Exception)importControl.Monad(ap,liftM,when)importControl.Monad.IO.Class(MonadIO,liftIO)importqualifiedData.Algorithm.PatienceasPatienceimportqualifiedData.ByteString.Char8importqualifiedData.ByteString.Lazy.Char8importData.Foldable(Foldable,foldMap)importData.List(foldl',intercalate,sort)importData.Maybe(isJust,isNothing)importData.IORef(IORef,newIORef,readIORef,modifyIORef)importqualifiedData.TextimportData.Text(Text)importqualifiedData.Text.LazyimportqualifiedData.Text.IOimportqualifiedLanguage.Haskell.THasTHimportTest.Chell.Main(defaultMain)importTest.Chell.Types-- | Get the RNG seed for this test run. The seed is generated once, in-- 'defaultMain', and used for all tests. It is also logged to reports using-- a note.---- Users may specify a seed using the @--seed@ command-line option.testOptionSeed::TestOptions->InttestOptionSeed=testOptionSeed_-- | An optional timeout, in millseconds. Tests which run longer than this-- timeout will be aborted.---- Users may specify a timeout using the @--timeout@ command-line option.testOptionTimeout::TestOptions->MaybeInttestOptionTimeout=testOptionTimeout_-- | Conditionally skip tests. Use this to avoid commenting out tests-- which are currently broken, or do not work on the current platform.---- @--tests = 'suite' \"tests\"-- [ 'skipIf' builtOnUnix test_WindowsSpecific-- ]-- @--skipIf::Bool->Suite->SuiteskipIfskip=ifskipthenstepelseidwherestep(SuiteTest(Testname_))=SuiteTest(Testname(\_->returnTestSkipped))step(Suitenamesuites)=Suitename(mapstepsuites)-- | Conditionally skip tests, depending on the result of a runtime check. The-- predicate is checked before each test is started.---- @--tests = 'suite' \"tests\"-- [ 'skipWhen' noNetwork test_PingGoogle-- ]-- @skipWhen::IOBool->Suite->SuiteskipWhenp=stepwherestep(SuiteTest(Testnameio))=SuiteTest(Testname(\opts->doskip<-pifskipthenreturnTestSkippedelseioopts))step(Suitenamesuites)=Suitename(mapstepsuites)-- $doc-basic-testing---- This library includes a few basic JUnit-style assertions, for use in-- simple test suites where depending on a separate test framework is too-- much trouble.newtypeAssertion=Assertion(IOAssertionResult)dataAssertionResult=AssertionPassed|AssertionFailedTextclassIsAssertionawheretoAssertion::a->AssertioninstanceIsAssertionAssertionwheretoAssertion=idinstanceIsAssertionBoolwheretoAssertionx=Assertion(return(ifxthenAssertionPassedelseAssertionFailed"$assert: boolean assertion failed"))typeTestState=(IORef[(Text,Text)],[Failure])newtypeAssertionsa=Assertions{unAssertions::TestState->IO(Maybea,TestState)}instanceFunctorAssertionswherefmap=liftMinstanceControl.Applicative.ApplicativeAssertionswherepure=return(<*>)=apinstanceMonadAssertionswherereturnx=Assertions(\s->return(Justx,s))m>>=f=Assertions(\s->do(maybe_a,s')<-unAssertionsmscasemaybe_aofNothing->return(Nothing,s')Justa->unAssertions(fa)s')instanceMonadIOAssertionswhereliftIOio=Assertions(\s->dox<-ioreturn(Justx,s))-- | Convert a sequence of pass/fail assertions into a runnable test.---- @-- test_Equality :: Suite-- test_Equality = assertions \"equality\" $ do-- $assert (1 == 1)-- $assert (equal 1 1)-- @assertions::Text->Assertionsa->Suiteassertionsnametestm=test(Testnameio)whereioopts=donoteRef<-newIORef[]letgetNotes=fmapreverse(readIORefnoteRef)letgetResult=dores<-unAssertionstestm(noteRef,[])caseresof(_,(_,[]))->donotes<-getNotesreturn(TestPassednotes)(_,(_,fs))->donotes<-getNotesreturn(TestFailednotes(reversefs))handleJankyIOoptsgetResultgetNotesaddFailure::MaybeTH.Loc->Text->Assertions()addFailuremaybe_locmsg=Assertions$\(notes,fs)->doletloc=doth_loc<-maybe_locreturn$Location{locationFile=Data.Text.pack(TH.loc_filenameth_loc),locationModule=Data.Text.pack(TH.loc_moduleth_loc),locationLine=toInteger(fst(TH.loc_startth_loc))}return(Just(),(notes,Failurelocmsg:fs))die::Assertionsadie=Assertions(\s->return(Nothing,s))-- | Cause a test to immediately fail, with a message.---- 'Test.Chell.fail' is a Template Haskell macro, to retain the source-file-- location from which it was used. Its effective type is:---- @-- $fail :: 'Text' -> 'Assertions' a-- @fail::TH.QTH.Exp-- :: Text -> Assertions afail=doloc<-TH.locationletqloc=liftLocloc[|\msg->addFailure(Just$qloc)msg>>die|]-- | Print a message from within a test. This is just a helper for debugging,-- so you don't have to import @Debug.Trace@.trace::Text->Assertions()tracemsg=liftIO(Data.Text.IO.putStrLnmsg)-- | Attach metadata to a test run. This will be included in reports.note::Text->Text->Assertions()notekeyvalue=Assertions(\(notes,fs)->domodifyIORefnotes((key,value):)return(Just(),(notes,fs)))liftLoc::TH.Loc->TH.QTH.ExpliftLocloc=[|TH.Locfilenamepackagemodule_startend|]wherefilename=TH.loc_filenamelocpackage=TH.loc_packagelocmodule_=TH.loc_modulelocstart=TH.loc_startlocend=TH.loc_endlocassertAt::IsAssertionassertion=>TH.Loc->Bool->assertion->Assertions()assertAtlocfatalassertion=doletAssertionio=toAssertionassertionresult<-liftIOiocaseresultofAssertionPassed->return()AssertionFailederr->doaddFailure(Justloc)errwhenfataldie-- | Run an 'Assertion'. If the assertion fails, the test will immediately-- fail.---- 'assert' is a Template Haskell macro, to retain the source-file location-- from which it was used. Its effective type is:---- @-- $assert :: 'IsAssertion' assertion => assertion -> 'Assertions' ()-- @assert::TH.QTH.Exp-- :: IsAssertion assertion => assertion -> Assertions ()assert=doloc<-TH.locationletqloc=liftLocloc[|assertAt$qlocTrue|]-- | Run an 'Assertion'. If the assertion fails, the test will continue to-- run until it finishes (or until an 'assert' fails).---- 'expect' is a Template Haskell macro, to retain the source-file location-- from which it was used. Its effective type is:---- @-- $expect :: 'IsAssertion' assertion => assertion -> 'Assertions' ()-- @expect::TH.QTH.Exp-- :: IsAssertion assertion => assertion -> Assertions ()expect=doloc<-TH.locationletqloc=liftLocloc[|assertAt$qlocFalse|]pure::Bool->String->AssertionpureTrue_=Assertion(returnAssertionPassed)pureFalseerr=Assertion(return(AssertionFailed(Data.Text.packerr)))-- | Assert that two values are equal.equal::(Showa,Eqa)=>a->a->Assertionequalxy=pure(x==y)("equal: "++showx++" is not equal to "++showy)-- | Assert that two values are not equal.notEqual::(Eqa,Showa)=>a->a->AssertionnotEqualxy=pure(x/=y)("notEqual: "++showx++" is equal to "++showy)-- | Assert that two values are within some delta of each other.equalWithin::(Reala,Showa)=>a->a->a-- ^ delta->AssertionequalWithinxydelta=pure((x-delta<=y)&&(x+delta>=y))("equalWithin: "++showx++" is not within "++showdelta++" of "++showy)-- | Assert that some value is @Just@.just::Maybea->Assertionjustx=pure(isJustx)("just: received Nothing")-- | Assert that some value is @Nothing@.nothing::Maybea->Assertionnothingx=pure(isNothingx)("nothing: received Just")-- | Assert that some value is @Left@.left::Eitherab->Assertionleftx=pure(isLeftx)("left: received Right")whereisLeft(Left_)=TrueisLeft(Right_)=False-- | Assert that some value is @Right@.right::Eitherab->Assertionrightx=pure(isRightx)("right: received Left")whereisRight(Left_)=FalseisRight(Right_)=True-- | Assert that some computation throws an exception matching the provided-- predicate. This is mostly useful for exception types which do not have an-- instance for @Eq@, such as @'Control.Exception.ErrorCall'@.throws::Exceptionerr=>(err->Bool)->IOa->Assertionthrowspio=Assertion(doeither_exc<-Control.Exception.tryioreturn(caseeither_excofLeftexc->ifpexcthenAssertionPassedelseAssertionFailed(Data.Text.pack("throws: exception "++showexc++" did not match predicate"))Right_->AssertionFailed(Data.Text.pack("throws: no exception thrown"))))-- | Assert that some computation throws an exception equal to the given-- exception. This is better than just checking that the correct type was-- thrown, because the test can also verify the exception contains the correct-- information.throwsEq::(Eqerr,Exceptionerr,Showerr)=>err->IOa->AssertionthrowsEqexpectedio=Assertion(doeither_exc<-Control.Exception.tryioreturn(caseeither_excofLeftexc->ifexc==expectedthenAssertionPassedelseAssertionFailed(Data.Text.pack("throwsEq: exception "++showexc++" is not equal to "++showexpected))Right_->AssertionFailed(Data.Text.pack("throwsEq: no exception thrown"))))-- | Assert a value is greater than another.greater::(Orda,Showa)=>a->a->Assertiongreaterxy=pure(x>y)("greater: "++showx++" is not greater than "++showy)-- | Assert a value is greater than or equal to another.greaterEqual::(Orda,Showa)=>a->a->AssertiongreaterEqualxy=pure(x>y)("greaterEqual: "++showx++" is not greater than or equal to "++showy)-- | Assert a value is less than another.lesser::(Orda,Showa)=>a->a->Assertionlesserxy=pure(x<y)("lesser: "++showx++" is not less than "++showy)-- | Assert a value is less than or equal to another.lesserEqual::(Orda,Showa)=>a->a->AssertionlesserEqualxy=pure(x<=y)("lesserEqual: "++showx++" is not less than or equal to "++showy)-- | Assert that two containers have the same items, in any order.sameItems::(Foldablecontainer,Showitem,Orditem)=>containeritem->containeritem->AssertionsameItemsxy=equalDiff'"sameItems"sortxy-- | Assert that two containers have the same items, in the same order.equalItems::(Foldablecontainer,Showitem,Orditem)=>containeritem->containeritem->AssertionequalItemsxy=equalDiff'"equalItems"idxyequalDiff'::(Foldablecontainer,Showitem,Orditem)=>String->([item]->[item])->containeritem->containeritem->AssertionequalDiff'labelnormxy=checkDiff(itemsx)(itemsy)whereitems=norm.foldMap(:[])checkDiffxsys=casecheckItems(Patience.diffxsys)of(same,diff)->puresamediffcheckItemsdiffItems=casefoldl'checkItem(True,[])diffItemsof(same,diff)->(same,errorMsg(intercalate"\n"(reversediff)))checkItem(same,acc)item=caseitemofPatience.Oldt->(False,("\t- "++showt):acc)Patience.Newt->(False,("\t+ "++showt):acc)Patience.Botht_->(same,("\t "++showt):acc)errorMsgdiff=label++": items differ\n"++diff-- | Class for types which can be treated as text.classIsTextawheretoLines::a->[a]unpack::a->StringinstanceIsTextStringwheretoLines=linesunpack=idinstanceIsTextTextwheretoLines=Data.Text.linesunpack=Data.Text.unpackinstanceIsTextData.Text.Lazy.TextwheretoLines=Data.Text.Lazy.linesunpack=Data.Text.Lazy.unpack-- | Uses @Data.ByteString.Char8@instanceIsTextData.ByteString.Char8.ByteStringwheretoLines=Data.ByteString.Char8.linesunpack=Data.ByteString.Char8.unpack-- | Uses @Data.ByteString.Lazy.Char8@instanceIsTextData.ByteString.Lazy.Char8.ByteStringwheretoLines=Data.ByteString.Lazy.Char8.linesunpack=Data.ByteString.Lazy.Char8.unpack-- | Assert that two pieces of text are equal. This uses a diff algorithm-- to check line-by-line, so the error message will be easier to read on-- large inputs.equalLines::(Orda,IsTexta)=>a->a->AssertionequalLinesxy=checkDiff(toLinesx)(toLinesy)wherecheckDiffxsys=casecheckItems(Patience.diffxsys)of(same,diff)->puresamediffcheckItemsdiffItems=casefoldl'checkItem(True,[])diffItemsof(same,diff)->(same,errorMsg(intercalate"\n"(reversediff)))checkItem(same,acc)item=caseitemofPatience.Oldt->(False,("\t- "++unpackt):acc)Patience.Newt->(False,("\t+ "++unpackt):acc)Patience.Botht_->(same,("\t "++unpackt):acc)errorMsgdiff="equalLines: lines differ\n"++diff