add ToValue interface
This commit is contained in:
parent
48b14e5980
commit
c33bb4e96d
1 changed files with 15 additions and 4 deletions
17
TAP.idr
17
TAP.idr
|
@ -11,6 +11,7 @@ import Control.Monad.Reader
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Control.ANSI
|
import Control.ANSI
|
||||||
import System
|
import System
|
||||||
|
import Text.PrettyPrint.Prettyprinter
|
||||||
|
|
||||||
%default total
|
%default total
|
||||||
|
|
||||||
|
@ -52,10 +53,20 @@ public export
|
||||||
interface ToInfo e where
|
interface ToInfo e where
|
||||||
toInfo : e -> Info
|
toInfo : e -> Info
|
||||||
|
|
||||||
|
||| represent a value as a string value in an `Info`.
|
||||||
|
public export
|
||||||
|
interface ToValue e where
|
||||||
|
toValue : e -> String
|
||||||
|
|
||||||
||| an info of `()` prints nothing
|
||| an info of `()` prints nothing
|
||||||
export ToInfo () where toInfo () = []
|
export ToInfo () where toInfo () = []
|
||||||
|
|
||||||
export Show a => ToInfo (List (String, a)) where toInfo = map (map show)
|
export
|
||||||
|
(ToValue a, Foldable t) => ToInfo (t (String, a)) where
|
||||||
|
toInfo = map (mapSnd toValue) . toList
|
||||||
|
|
||||||
|
export ToValue String where toValue = id
|
||||||
|
export ToValue (Doc a) where toValue = show . align
|
||||||
|
|
||||||
|
|
||||||
||| a test or group of tests
|
||| a test or group of tests
|
||||||
|
@ -134,7 +145,7 @@ 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
|
||||||
testThrowsIO : (ToInfo e, Show a) =>
|
testThrowsIO : (ToInfo e, ToValue a) =>
|
||||||
String -> (e -> Bool) -> EitherT e IO a -> Test
|
String -> (e -> Bool) -> EitherT e IO a -> Test
|
||||||
testThrowsIO label p act = One $ MakeTest label $ do
|
testThrowsIO label p act = One $ MakeTest label $ do
|
||||||
case !(runEitherT act) of
|
case !(runEitherT act) of
|
||||||
|
@ -143,7 +154,7 @@ testThrowsIO label p act = One $ MakeTest label $ do
|
||||||
|
|
||||||
||| pure version of `testThrowsIO`
|
||| pure version of `testThrowsIO`
|
||||||
export
|
export
|
||||||
testThrows : (ToInfo e, Show a) =>
|
testThrows : (ToInfo e, ToValue a) =>
|
||||||
String -> (e -> Bool) -> Lazy (Either e a) -> Test
|
String -> (e -> Bool) -> Lazy (Either e a) -> Test
|
||||||
testThrows label p act = testThrowsIO label p $ MkEitherT $ lazyToIO act
|
testThrows label p act = testThrowsIO label p $ MkEitherT $ lazyToIO act
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue