support notes/comments in test output

tests/TAP.idr

@@ -51,7 +51,17 @@ export Show a => ToInfo (List (String, a)) where toInfo = map (map show)
 
 
 export
-data Test = One TestBase | Group String (List Test)
+data Test
+= One TestBase
+| Group String (List Test)
+| Note String
+
+
+export
+isRealTest : Test -> Bool
+isRealTest (One   _)   = True
+isRealTest (Group _ _) = True
+isRealTest (Note  _)   = False
 
 
 private
@@ -89,6 +99,7 @@ export
 skipWith : Test -> String -> Test
 skipWith (One   t)   reason = makeSkip t.label reason
 skipWith (Group l _) reason = makeSkip l       reason
+skipWith (Note  n)   _      = Note n
 
 export
 skip : Test -> Test
@@ -113,11 +124,17 @@ bailOut = One $ MakeTest "bail out" $ do
   putStrLn "Bail out!"
   exitFailure
 
+export
+note : String -> Test
+note = Note
+
 
 
 export
-header : List a -> String
+header : List Test -> String
-header tests = "1..\{show $ length tests}"
+header tests =
+  let count = length $ filter isRealTest tests in
+  "1..\{show count}"
 
 private
 makePrefix : SnocList String -> String
@@ -138,6 +155,7 @@ mutual
   flatten1With : SnocList String -> Test -> List Test
   flatten1With pfx (One   t)    = [withPrefix pfx t]
   flatten1With pfx (Group x ts) = flattenWith (pfx :< x) ts
+  flatten1With pfx (Note  n)    = [Note n]
 
 export
 flatten : List Test -> List Test
@@ -174,11 +192,13 @@ toBool _            = True
 
 
 private
-numbered : List a -> List (Nat, a)
+numbered : (a -> Bool) -> List a -> List (Nat, a)
-numbered = go 1 where
+numbered p = go 1 where
   go : Nat -> List a -> List (Nat, a)
   go _ []        = []
-  go i (x :: xs) = (i, x) :: go (S i) xs
+  go i (x :: xs) =
+    if p x then (i, x) :: go (S i) xs
+           else (0, x) :: go i     xs
 
 
 private
@@ -230,12 +250,16 @@ mutual
     res <- local {indent $= plus 4} $ runList tests
     putOk res index label
     pure res
+  run' (_, Note note) = do
+    putIndentLines [!(col Magenta "# ") ++ note]
+    pure True
 
   private
   runList : List Test -> Runner Bool
   runList tests = do
     putColor Cyan $ header tests
-    all id <$> traverse (\t => run' (assert_smaller tests t)) (numbered tests)
+    let tests' = numbered isRealTest tests
+    all id <$> traverse (\t => run' (assert_smaller tests t)) tests'
 
 
 mutual
@@ -254,6 +278,7 @@ mutual
     case filterMatch (Just pat) tests of
          []  => Nothing
          res => Just $ Group label res
+  filterMatch1 pat note@(Note _) = Just note
 
 
 export