diff options
Diffstat (limited to 'test/Test.hs')
| -rw-r--r-- | test/Test.hs | 52 |
1 files changed, 41 insertions, 11 deletions
diff --git a/test/Test.hs b/test/Test.hs index 983b48d..b162a9f 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -2,15 +2,19 @@ -- vim: sw=2 ts=2 et ai: module Test where +import Control.Monad + import Data.Array -import Data.Attoparsec.ByteString.Char8 +import Data.Attoparsec.ByteString.Char8 (parseOnly) import Data.ByteString.Char8 (pack) import Data.Either import Data.Function import Data.List +import Data.MarkovChain import Data.Maybe -import Control.Monad +import System.IO +import System.Random import Test.QuickCheck import Test.QuickCheck.Random @@ -27,7 +31,11 @@ atAnyState = atAnyTwoStates . const atAnyTwoStates :: (Board -> Board -> Bool) -> PGN -> Property atAnyTwoStates ok pgn = let moveList = seqList [moveSAN m | m <- moves pgn] $ Right defaultBoard in - classify True (let l = length moveList - 1 in show l ++ " legal move" ++ if (l == 1) then "" else "s") $ + let moves = length moveList in + classify ( moves < 10) " <10 legal moves" $ + classify ( 10 <= moves && moves < 50) "10- 50 legal moves" $ + classify ( 50 <= moves && moves < 100) "50-100 legal moves" $ + classify (100 <= moves ) "100+ legal moves" $ and [ok b1 b2 | Right b1 <- moveList | Right b2 <- tail moveList] where seqList :: [r -> Either e r] -> Either e r -> [Either e r] @@ -113,11 +121,7 @@ prop_not_in_check_twice = atAnyTwoStates (\b1 b2 -> not (check White b1 && check White b2)) prop_move_not_result_check :: PGN -> Property -prop_move_not_result_check = atAnyTwoStates (\b1 b2 -> - case turn b1 of - White -> not (check White b2) - Black -> not (check Black b2) - ) +prop_move_not_result_check = atAnyTwoStates (\b1 b2 -> not (check (turn b1) b2)) prop_dont_touch_my_pieces :: PGN -> Property prop_dont_touch_my_pieces = atAnyTwoStates (\b1 b2 -> notMoved (turn b2) b1 b2) @@ -125,6 +129,32 @@ prop_dont_touch_my_pieces = atAnyTwoStates (\b1 b2 -> notMoved (turn b2) b1 b2) 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)})) +main = do + pgns <- readPGN + let gen = growingElements $ take 10000 $ runMulti 4 (map moves pgns) 0 (mkStdGen 37) + putStrLn "Testing: parser" + quickCheck prop_checkPGN + putStrLn $ "Building Markov chain from " ++ show (length pgns) ++ " games" + check "only 2 kings" gen prop_only_2_kings + check "no pawns on rank 1 or 8" gen prop_no_pawns_on_1_and_8 + check "no new pieces / more than one piece hit" gen prop_number_of_pieces + check "no check on same colour twice" gen prop_not_in_check_twice + check "player cannot cause himself to be check" gen prop_move_not_result_check + check "player cannot move opponent's pieces" gen prop_dont_touch_my_pieces + where + check name gen p = do + putStrLn $ "Testing: " ++ name + quickCheckWith args (forAll (mkPGN <$> gen) p) + where args = stdArgs {maxSuccess=10000, replay=Just (mkQCGen 37,0)} + + mkPGN :: [String] -> PGN + mkPGN = PGN "" "" "" "" "" "" Nothing Nothing + +readPGN :: IO [PGN] +readPGN = do + hSetEncoding stdin latin1 + pgn <- pack <$> getContents + case parseOnly pgnParser pgn of + Left err -> error err + Right [] -> error "no games" + Right games -> return games |