Merge branch '2-quickcheck-property-zwart-wit-mag-geen-wit-zwart-stuk-verplaatsen' into 'master'

Resolve "QuickCheck property: {zwart,wit} mag geen {wit,zwart} stuk verplaatsen"

Closes #2

See merge request eveen/Testing-Techniques!8

1 files changed, 7 insertions, 1 deletions

diff --git a/test/Test.hs b/test/Test.hs
index 2d785e7..3db8aa3 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -5,8 +5,8 @@ module Test where
 import Data.Array
 import Data.Attoparsec.ByteString.Char8
 import Data.ByteString.Char8 (pack)
-
 import Data.Either
+import Data.Function
 import Data.List
 import Data.Maybe
 
@@ -119,6 +119,12 @@ prop_move_not_result_check = atAnyTwoStates (\b1 b2 ->
     Black -> not (check Black b2)
   )
 
+prop_dont_touch_my_pieces :: PGN -> Bool
+prop_dont_touch_my_pieces = atAnyTwoStates (\b1 b2 -> notMoved (turn b2) b1 b2)
+  where
+    notMoved :: Color -> Board -> Board -> Bool
+    notMoved c = (\b a -> null (a \\ b)) `on` pieceCoords (Just c) Nothing
+
 return []
 main = $forAllProperties (quickCheckWithResult (stdArgs
   {maxSuccess=100000, replay=Just (mkQCGen 37,0)}))