add testThrowsIO

This commit is contained in:
rhiannon morris 2022-05-27 13:31:01 +02:00
parent fdac74820c
commit 520047b47f

16
TAP.idr
View file

@ -126,7 +126,7 @@ export
skip : Test -> Test skip : Test -> Test
skip = skipWith "" 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`, ||| - if the body returns `Left err` and the predicate given returns `True`,
||| then the test succeeds ||| then the test succeeds
||| - if the body returns `Left err` and the predicate given returns `False`, ||| - 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 ||| - if the body returns `Right val`, then the test fails with
||| `{success: val}` ||| `{success: val}`
export export
testThrows : (ToInfo e, Show a) => testThrowsIO : (ToInfo e, Show a) =>
String -> (e -> Bool) -> Lazy (Either e a) -> Test String -> (e -> Bool) -> EitherT e IO a -> Test
testThrows label p act = One $ MakeTest label $ do testThrowsIO label p act = One $ MakeTest label $ do
case !(lazyToIO act) of case !(runEitherT act) of
Left err => if p err then result True () else result False err Left err => if p err then result True () else result False err
Right val => result False [("success", val)] 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 :- infix 1 :-
||| make a test group ||| make a test group
export export