diff options
Diffstat (limited to 'test/test_parser.hs')
-rw-r--r-- | test/test_parser.hs | 107 |
1 files changed, 0 insertions, 107 deletions
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" |