module Main where import Data.Matrix hiding (trace) import Test.HUnit import Tak.ApplyPlay import Tak.Init import Tak.ParsePTN import Tak.PossiblePlays import Tak.Types import Tak.Win test_simple_move :: Test test_simple_move = TestCase $ assertEqual "moves" expectedMoves (possibleMoves gameState') where expectedMoves = parseMoves ["a1>", "a1+"] gameState = initialState 5 White gameState' = noPlayError $ play play1 gameState play1 = noParseError $ parsePtn "a1" test_stack_move :: Test test_stack_move = TestCase $ assertEqual "moves" expectedMoves (possibleMoves gameState') where expectedMoves = parseMoves [ "b2>", "2b2>11", "2b2>2", "b2<", "2b2<2", "b2+", "2b2+11", "2b2+2", "b2-", "2b2-2"] gameState = initialState 5 White gameState' = gameState{stBoard = setElem [(Flat, White), (Flat, White)] (2, 2) (stBoard gameState)} test_roadwin :: Test test_roadwin = TestCase $ assertEqual "roadwin" Nothing (roadWin board) where board = fromList 5 5 [ [], [], [], [], [], [], [], [], [(Flat, Black)], [], [], [], [], [(Flat, Black)], [], [], [], [], [(Flat, Black)], [], [], [], [], [(Flat, Black)], []] test_roadwin2 :: Test test_roadwin2 = TestCase $ assertEqual "roadwin" (Just $ RoadWin Black) (roadWin board) where board = fromList 5 5 [ [], [], [], [(Flat, Black)], [], [], [], [], [(Flat, Black)], [], [], [], [], [(Flat, Black)], [], [], [], [], [(Flat, Black)], [], [], [], [], [(Flat, Black)], []] test_stack_move_result :: Test test_stack_move_result = TestCase $ assertEqual "stack_move" expectedBoard (stBoard $ noPlayError $ play (parseMove "4b4>22") gameState) where gameState = (initialState 5 Black){stBoard = board} board = fromList 5 5 [ [], [], [], [], [], [], [], [], [(Cap, Black), (Flat, Black), (Flat, White), (Flat, Black)], [], [], [], [], [], [], [], [], [], [], [], [], [], [], [], []] expectedBoard = fromList 5 5 [ [], [], [], [], [], [], [], [], [], [], [], [], [], [(Flat, White), (Flat, Black)], [], [], [], [], [(Cap, Black), (Flat, Black)], [], [], [], [], [], []] test_stack_move_result2 :: Test test_stack_move_result2 = TestCase $ assertEqual "stack_move" expectedBoard (stBoard $ noPlayError $ play (parseMove "4b4>31") gameState) where gameState = (initialState 5 Black){stBoard = board} board = fromList 5 5 [ [], [], [], [], [], [], [], [], [(Cap, Black), (Flat, Black), (Flat, White), (Flat, Black)], [], [], [], [], [], [], [], [], [], [], [], [], [], [], [], []] expectedBoard = fromList 5 5 [ [], [], [], [], [], [], [], [], [], [], [], [], [], [(Flat, Black), (Flat, White), (Flat, Black)], [], [], [], [], [(Cap, Black)], [], [], [], [], [], []] test_stack_move_legal :: Test test_stack_move_legal = TestCase $ assert $ parseMove "5d2+122C" `elem` moves where moves = possibleMoves state --moves = stackMoves state (4, 2) (board ! (4, 2)) state = GameState board player player Nothing White 3 board = read $ "( X )\n" ++ "( )\n" ++ "( XXX )\n" ++ "( COXOOOO XO )\n" ++ "( XOOO O OXXO )\n" player = Player 1 0 test_roadwin3 :: Test test_roadwin3 = TestCase $ assert $ roadWin board == Just (RoadWin White) where board = read $ "( CX O X X )\n" ++ "( X OXXX )\n" ++ "( O O )\n" ++ "( O )\n" ++ "( O )\n" parseMoves :: [String] -> [Play] parseMoves = map parseMove parseMove :: String -> Play parseMove = noParseError . parsePtn noParseError :: (Show a) => Either a t -> t noParseError (Right p) = p noParseError (Left err) = error $ show err noPlayError :: Show a => Either t a -> t noPlayError (Left state) = state noPlayError (Right err) = error $ show err tests :: Test tests = TestList [TestLabel "test_simple_move" test_simple_move, TestLabel "test_stack_move" test_stack_move, TestLabel "test_roadwin" test_roadwin, TestLabel "test_roadwin2" test_roadwin2, TestLabel "test_stack_move_result" test_stack_move_result, TestLabel "test_stack_move_result2" test_stack_move_result2, TestLabel "test_stack_move_legal" test_stack_move_legal, TestLabel "test_roadwin3" test_roadwin3] main :: IO Counts main = do runTestTT tests