1 files changed, 56 insertions, 2 deletions
diff --git a/test/ArbitraryMove.hs b/test/ArbitraryMove.hs
index e1c5228..bcde156 100644
--- a/test/ArbitraryMove.hs
+++ b/test/ArbitraryMove.hs
@@ -1,9 +1,63 @@
+{-# LANGUAGE StandaloneDeriving #-}
 -- vim: sw=2 ts=2 et ai:
 module ArbitraryMove (arbitraryMove)
 where
 
+import Control.Monad
+
 import Test.QuickCheck
 
+import Chess
+import Chess.FEN
+import Chess.PGN
+
+deriving instance Eq PGN
+
+instance Arbitrary GameResult where arbitrary = elements [BlackWon, WhiteWon, Draw]
+instance Arbitrary Board where arbitrary = return defaultBoard
+
+type Move = String
+
+arbitraryMove :: Gen Move
+arbitraryMove = frequency
+  [ (2, probableArbitraryMove)
+  , (1, invalidMove)
+  ]
+  where
+    invalidMove :: Gen Move
+    invalidMove = oneof
+      [ liftM2 (\r c -> [r,c]) (choose ('i', 'z')) (elements "09")
+      ]
+
+instance Arbitrary PGN
+  where
+    arbitrary = liftM9 PGN
+        sensibleString
+        sensibleString
+        sensibleString
+        sensibleString
+        sensibleString
+        sensibleString
+        arbitrary
+        (Just <$> arbitrary)
+        (liftM2 (:) arbitraryMove (listOf arbitraryMove))
+      where
+        liftM9 f m1 m2 m3 m4 m5 m6 m7 m8 m9 = do
+          x1 <- m1
+          x2 <- m2
+          x3 <- m3
+          x4 <- m4
+          x5 <- m5
+          x6 <- m6
+          x7 <- m7
+          x8 <- m8
+          x9 <- m9
+          return $ f x1 x2 x3 x4 x5 x6 x7 x8 x9
+
+        sensibleString = listOf $ choose ('a', 'z')
+
+    shrink pgn = [pgn {moves=ms} | ms <- shrink $ moves pgn]
+
 {- This file can largely be generated with the following pipeline:
  -
  - grep -v '^\(\[\|$\)' \
@@ -17,8 +71,8 @@ import Test.QuickCheck
  - on a set of PGN games, e.g. from http://theweekinchess.com/twic.
  -}
 
-arbitraryMove :: Gen String
-arbitraryMove = frequency $ map (return <$>)
+probableArbitraryMove :: Gen String
+probableArbitraryMove = frequency $ map (return <$>)
   [ (8, "a1=B")
   , (2, "a1=B+")
   , (16, "a1=N")