Made Test.hs for adding properties

3 files changed, 119 insertions, 109 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")
diff --git a/test/Test.hs b/test/Test.hs
new file mode 100644
index 0000000..1f0a02d
--- /dev/null
+++ b/test/Test.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE TemplateHaskell #-}
+-- vim: sw=2 ts=2 et ai:
+module Test where
+
+import Data.Attoparsec.ByteString.Char8
+import Data.ByteString.Char8 (pack)
+
+import Data.Either
+import Data.List
+
+import Control.Monad
+
+import Test.QuickCheck
+
+import Chess
+import Chess.FEN
+import Chess.PGN
+
+import ArbitraryMove
+
+prop_checkPGN :: PGN -> Bool
+prop_checkPGN pgn
+  | isLeft parsed       = False
+  | length parsed' /= 1 = False
+  | otherwise           = pgn == ((head parsed') {initialPosition=Just defaultBoard})
+  where
+    parsed = parseOnly pgnParser (pack $ pgnToString pgn)
+    (Right parsed') = parsed
+
+pgnToString :: PGN -> String
+pgnToString pgn = makePGN
+    (event pgn)
+    (site pgn)
+    (date pgn)
+    (Chess.PGN.round pgn)
+    (whitePlayer pgn)
+    (blackPlayer pgn)
+    (resultString $ result pgn)
+    ("1. " ++ intercalate " 1. " (moves pgn) ++ " " ++ resultString (result pgn))
+  where
+    resultString :: Maybe GameResult -> String
+    resultString Nothing = "*"
+    resultString (Just WhiteWon) = "1-0"
+    resultString (Just BlackWon) = "0-1"
+    resultString (Just Draw)     = "1/2-1/2"
+
+makePGN :: String -> String -> String -> String -> String -> String -> String -> String -> String
+makePGN event site date round white black result moves =
+  concatMap (uncurry tagPair)
+    [ ("Event",  event)
+    , ("Site",   site)
+    , ("Date",   date)
+    , ("Round",  round)
+    , ("White",  white)
+    , ("Black",  black)
+    , ("Result", result)
+    ] ++ "\r\n" ++ moves
+  where
+    tagPair :: String -> String -> String
+    tagPair tag val = "[" ++ tag ++ " \"" ++ val ++ "\"]\r\n"
+
+return []
+main = $forAllProperties (quickCheckWithResult (stdArgs {maxSuccess=10000}))
diff --git a/test/test_parser.hs b/test/test_parser.hs
deleted file mode 100644
index 397248f..0000000
--- a/test/test_parser.hs
+++ /dev/null
@@ -1,107 +0,0 @@
-{-# LANGUAGE StandaloneDeriving #-}
--- vim: sw=2 ts=2 et ai:
-import Data.Attoparsec.ByteString.Char8
-import Data.ByteString.Char8 (pack)
-
-import Data.Either
-import Data.List
-
-import Control.Monad
-
-import Test.QuickCheck
-
-import Chess
-import Chess.FEN
-import Chess.PGN
-
-import qualified ArbitraryMove as AM
-
-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, AM.arbitraryMove)
-  , (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]
-
-main = quickCheck (withMaxSuccess 10000 checkPGN)
-  where
-    checkPGN :: PGN -> Bool
-    checkPGN pgn
-      | isLeft parsed       = False
-      | length parsed' /= 1 = False
-      | otherwise           = pgn == ((head parsed') {initialPosition=Just defaultBoard})
-      where
-        parsed = parseOnly pgnParser (pack $ pgnToString pgn)
-        (Right parsed') = parsed
-
-pgnToString :: PGN -> String
-pgnToString pgn = makePGN
-    (event pgn)
-    (site pgn)
-    (date pgn)
-    (Chess.PGN.round pgn)
-    (whitePlayer pgn)
-    (blackPlayer pgn)
-    (resultString $ result pgn)
-    ("1. " ++ intercalate " 1. " (moves pgn) ++ " " ++ resultString (result pgn))
-  where
-    resultString :: Maybe GameResult -> String
-    resultString Nothing = "*"
-    resultString (Just WhiteWon) = "1-0"
-    resultString (Just BlackWon) = "0-1"
-    resultString (Just Draw)     = "1/2-1/2"
-
-makePGN :: String -> String -> String -> String -> String -> String -> String -> String -> String
-makePGN event site date round white black result moves =
-  concatMap (uncurry tagPair)
-    [ ("Event",  event)
-    , ("Site",   site)
-    , ("Date",   date)
-    , ("Round",  round)
-    , ("White",  white)
-    , ("Black",  black)
-    , ("Result", result)
-    ] ++ "\r\n" ++ moves
-  where
-    tagPair :: String -> String -> String
-    tagPair tag val = "[" ++ tag ++ " \"" ++ val ++ "\"]\r\n"