Made Test.hs for adding properties

1 files changed, 63 insertions, 0 deletions

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}))