Merge branch 'master' into 5-quickcheck-property-there-can-never-be-a-pawn-on-rank-a-and-h

1 files changed, 19 insertions, 1 deletions

diff --git a/test/Test.hs b/test/Test.hs
index 9cf10b4..d758d2b 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, ParallelListComp #-}
 -- vim: sw=2 ts=2 et ai:
 module Test where
 
@@ -28,6 +28,17 @@ atAnyState ok pgn = and [ok b | Right b <- seqList [moveSAN m | m <- moves pgn]
     seqList _      (Left _)   = []
     seqList []     _          = []
 
+atAnyTwoStates :: (Board -> Board -> Bool) -> PGN -> Bool
+atAnyTwoStates ok pgn =
+  let moveList = seqList [moveSAN m | m <- moves pgn] $ Right defaultBoard in
+  and [ok b1 b2 | Right b1 <- moveList | Right b2 <- tail moveList]
+  where
+    seqList :: [r -> Either e r] -> Either e r -> [Either e r]
+    seqList (f:fs) (Right io) = f io:seqList fs (f io)
+    seqList _      (Left _)   = []
+    seqList []     _          = []
+
+
 prop_checkPGN :: PGN -> Bool
 prop_checkPGN pgn
   | isLeft parsed       = False
@@ -89,5 +100,12 @@ prop_no_pawns_on_1_and_8 = atAnyState $ all notOnAorH . pieceCoords Nothing (Jus
     notOnAorH :: ((Int,Int),a) -> Bool
     notOnAorH ((_,r),_) = r /= 0 && r /= 7
 
+prop_number_of_pieces :: PGN -> Bool
+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)
+  )
+
 return []
 main = $forAllProperties (quickCheckWithResult (stdArgs {maxSuccess=10000}))