add testThrowsIO

This commit is contained in:
rhiannon morris 2022-05-27 13:31:01 +02:00
parent fdac74820c
commit 520047b47f
1 changed files with 11 additions and 5 deletions

16
TAP.idr
View File

@ -126,7 +126,7 @@ export
skip : Test -> Test
skip = skipWith ""
||| test that an expression fails in an expected way.
||| test that an action fails in an expected way.
||| - if the body returns `Left err` and the predicate given returns `True`,
||| then the test succeeds
||| - if the body returns `Left err` and the predicate given returns `False`,
@ -134,13 +134,19 @@ skip = skipWith ""
||| - if the body returns `Right val`, then the test fails with
||| `{success: val}`
export
testThrows : (ToInfo e, Show a) =>
String -> (e -> Bool) -> Lazy (Either e a) -> Test
testThrows label p act = One $ MakeTest label $ do
case !(lazyToIO act) of
testThrowsIO : (ToInfo e, Show a) =>
String -> (e -> Bool) -> EitherT e IO a -> Test
testThrowsIO label p act = One $ MakeTest label $ do
case !(runEitherT act) of
Left err => if p err then result True () else result False err
Right val => result False [("success", val)]
||| pure version of `testThrowsIO`
export
testThrows : (ToInfo e, Show a) =>
String -> (e -> Bool) -> Lazy (Either e a) -> Test
testThrows label p act = testThrowsIO label p $ MkEitherT $ lazyToIO act
infix 1 :-
||| make a test group
export