From c33bb4e96dbd9805dc7f76bac39c19b85b88cf52 Mon Sep 17 00:00:00 2001
From: rhiannon morris <rhi@rhiannon.website>
Date: Fri, 24 Mar 2023 21:56:25 +0100
Subject: [PATCH] add ToValue interface

---
 TAP.idr | 19 +++++++++++++++----
 1 file changed, 15 insertions(+), 4 deletions(-)

diff --git a/TAP.idr b/TAP.idr
index 77c9a94..83e6c6f 100644
--- a/TAP.idr
+++ b/TAP.idr
@@ -11,6 +11,7 @@ import Control.Monad.Reader
 import Control.Monad.State
 import Control.ANSI
 import System
+import Text.PrettyPrint.Prettyprinter
 
 %default total
 
@@ -52,10 +53,20 @@ public export
 interface ToInfo e where
   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
 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
@@ -134,7 +145,7 @@ skip = skipWith ""
 ||| - if the body returns `Right val`, then the test fails with
 |||   `{success: val}`
 export
-testThrowsIO : (ToInfo e, Show a) =>
+testThrowsIO : (ToInfo e, ToValue a) =>
                String -> (e -> Bool) -> EitherT e IO a -> Test
 testThrowsIO label p act = One $ MakeTest label $ do
   case !(runEitherT act) of
@@ -143,8 +154,8 @@ testThrowsIO label p act = One $ MakeTest label $ do
 
 ||| pure version of `testThrowsIO`
 export
-testThrows : (ToInfo e, Show a) =>
-           String -> (e -> Bool) -> Lazy (Either e a) -> Test
+testThrows : (ToInfo e, ToValue a) =>
+             String -> (e -> Bool) -> Lazy (Either e a) -> Test
 testThrows label p act = testThrowsIO label p $ MkEitherT $ lazyToIO act
 
 infix 1 :-