summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCamil Staps2017-11-20 13:34:23 +0100
committerCamil Staps2017-11-20 13:34:23 +0100
commit3d6e2f2c4fc2fce161a640d2c4607ecc7981f670 (patch)
tree87e802819caae21fbd87ca6ee4720994fc688f86
parentMerge branch '3-quickcheck-property-there-should-not-ever-be-more-than-2-king... (diff)
Add pieceCoords
-rw-r--r--test/Test.hs16
1 files changed, 12 insertions, 4 deletions
diff --git a/test/Test.hs b/test/Test.hs
index c5c694e..4aa3197 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -8,6 +8,7 @@ import Data.ByteString.Char8 (pack)
import Data.Either
import Data.List
+import Data.Maybe
import Control.Monad
@@ -68,12 +69,19 @@ makePGN event site date round white black result moves =
tagPair :: String -> String -> String
tagPair tag val = "[" ++ tag ++ " \"" ++ val ++ "\"]\r\n"
+-- From Chess.hs, with adaptations
+pieceCoords :: Maybe Color -> Maybe PieceType -> Board -> [((Int,Int),Piece)]
+pieceCoords clr piece brd = [(i,pc) | (i,Just pc) <- (assocs $ board brd), match pc]
+ where
+ match :: Piece -> Bool
+ match (Piece clr' piece') =
+ (isJust clr && clr' == fromJust clr || isNothing clr) &&
+ (isJust piece && piece' == fromJust piece || isNothing piece)
+
prop_only_2_kings :: PGN -> Bool
prop_only_2_kings = atAnyState (\b ->
- length (pieceCoords Black b King) == 1 &&
- length (pieceCoords White b King) == 1)
- where
- pieceCoords clr brd piece = [i | (i, pc) <- (assocs $ board brd), pc == Just (Piece clr piece)]
+ length (pieceCoords (Just Black) (Just King) b) == 1 &&
+ length (pieceCoords (Just White) (Just King) b) == 1)
return []
main = $forAllProperties (quickCheckWithResult (stdArgs {maxSuccess=10000}))