Add reports on triviality of test cases

1 files changed, 8 insertions, 7 deletions

diff --git a/test/Test.hs b/test/Test.hs
index 897c788..dfa3102 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -20,12 +20,13 @@ import Chess.PGN
 
 import ArbitraryMove
 
-atAnyState :: (Board -> Bool) -> PGN -> Bool
+atAnyState :: (Board -> Bool) -> PGN -> Property
 atAnyState = atAnyTwoStates . const
 
-atAnyTwoStates :: (Board -> Board -> Bool) -> PGN -> Bool
+atAnyTwoStates :: (Board -> Board -> Bool) -> PGN -> Property
 atAnyTwoStates ok pgn =
   let moveList = seqList [moveSAN m | m <- moves pgn] $ Right defaultBoard in
+  classify True (show (length moveList - 1) ++ " legal move(s)") $
   and [ok b1 b2 | Right b1 <- moveList | Right b2 <- tail moveList]
   where
     seqList :: [r -> Either e r] -> Either e r -> [Either e r]
@@ -84,30 +85,30 @@ pieceCoords clr piece brd = [(i,pc) | (i,Just pc) <- assocs $ board brd, match p
       (isJust clr   && clr'   == fromJust clr   || isNothing clr) &&
       (isJust piece && piece' == fromJust piece || isNothing piece)
 
-prop_only_2_kings :: PGN -> Bool
+prop_only_2_kings :: PGN -> Property
 prop_only_2_kings = atAnyState (\b ->
   length (pieceCoords (Just Black) (Just King) b) == 1 &&
   length (pieceCoords (Just White) (Just King) b) == 1)
 
-prop_no_pawns_on_1_and_8 :: PGN -> Bool
+prop_no_pawns_on_1_and_8 :: PGN -> Property
 prop_no_pawns_on_1_and_8 = atAnyState $ all notOn1or8 . pieceCoords Nothing (Just Pawn)
   where
     notOn1or8 :: ((Int,Int),a) -> Bool
     notOn1or8 ((_,r),_) = r /= 0 && r /= 7
 
-prop_number_of_pieces :: PGN -> Bool
+prop_number_of_pieces :: PGN -> Property
 prop_number_of_pieces = atAnyTwoStates (\b1 b2 ->
   length (pieceCoords Nothing Nothing b1) == length (pieceCoords Nothing Nothing b2)
   ||
   length (pieceCoords Nothing Nothing b1) - 1 == length (pieceCoords Nothing Nothing b2)
   )
 
-prop_not_in_check_twice :: PGN -> Bool
+prop_not_in_check_twice :: PGN -> Property
 prop_not_in_check_twice = atAnyTwoStates (\b1 b2 ->
   not (check Black b1 && check Black b2) &&
   not (check White b1 && check White b2))
 
-prop_move_not_result_check :: PGN -> Bool
+prop_move_not_result_check :: PGN -> Property
 prop_move_not_result_check = atAnyTwoStates (\b1 b2 ->
   case turn b1 of
     White -> not (check White b2)