tak-0.1.0.0: src/tests.hs

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