From 3d6e2f2c4fc2fce161a640d2c4607ecc7981f670 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Mon, 20 Nov 2017 13:34:23 +0100
Subject: Add pieceCoords

---
 test/Test.hs | 16 ++++++++++++----
 1 file 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}))
-- 
cgit v1.2.3