[SOLVED] CS module GameTest where

module GameTest where

import Test.Hspec
import Test.Hspec.Contrib.HUnit (fromHUnitTest)
import Test.Hspec.QuickCheck
import Test.HUnit
import Test.QuickCheck
import Data.Graph

import Types
import Constants
import Cell
import Action
import Game
import Players.Human

{-
Some defaults.
-}

All the cells.
startingCells :: [Cell]
startingCells = [(i, j) | i<-allColumns, j<-allRows]– All the edges.startingEdges :: [(Cell, Cell, [Cell])]startingEdges = [(c, c, adjacent c) | c<-startingCells]where adjacent :: Cell -> [Cell]
adjacent c = [c | c<-startingCells, isAdjacent c c’]– A board (graph) formed from all the edges.startingBoard :: Board startingBoard = b where (b, _, _) = graphFromEdges startingEdges– Starting players in the usual positions. Note that the player type is irrelevant for this test.startingPlayers :: [Player]startingPlayers = [makeHumanPlayer “X” (middleColumn, firstRow) wallsPerPlayer winningX,makeHumanPlayer “Y” (middleColumn, lastRow) wallsPerPlayer winningY]where middleColumn = intToColumn ((div boardSize 2) + 1)winningX = [(i, lastRow) |i<-allColumns]winningY = [(i, firstRow) | i<-allColumns]– Default game.startingGame :: Game startingGame = Game startingBoard startingPlayers{-Unit tests.-}{-currentPlayer :: [Player] -> Player
-}

currentPlayerTest :: Test
currentPlayerTest =
TestCase (assertEqual
name (currentPlayer startingPlayers)
(name (currentPlayer startingPlayers)) X)

{-
previousPlayer :: [Player] -> Player
-}

previousPlayerTest :: Test
previousPlayerTest =
TestCase (assertEqual
name (previousPlayer startingPlayers)
(name (previousPlayer startingPlayers)) Y)

{-
rotatePlayers :: [Player] -> [Player]
-}

rotatePlayersTest :: Test
rotatePlayersTest =
TestCase (assertEqual
name (currentPlayer (rotatePlayers startingPlayers))
(name (currentPlayer (rotatePlayers startingPlayers))) Y)

{-
validStepAction :: Game -> Player -> Step -> Bool
-}

validStepActionTestTrue :: Test
validStepActionTestTrue = let
p = currentPlayer startingPlayers
step = stepLeft (currentCell p) in
TestCase (assertBool
validStepAction startingGame step
(validStepAction startingGame step))

validStepActionTestFalse :: Test
validStepActionTestFalse = let
p = currentPlayer startingPlayers
c = currentCell p
step = (c, cellTop (cellTop c)) in
TestCase (assertBool
not (validStepAction startingGame step)
(not (validStepAction startingGame step)))

{-
validWallAction :: Game -> Player -> Wall -> Bool
-}

validWallActionTestTrue :: Test
validWallActionTestTrue = let
p = currentPlayer startingPlayers
c = currentCell p
step1 = stepLeft c
step2 = stepLeft (cellTop c)
wall = (step1, step2) in
TestCase (assertBool
validWallAction startingGame wall
(validWallAction startingGame wall))

validWallActionTestFalse :: Test
validWallActionTestFalse = let
p = currentPlayer startingPlayers
c = currentCell p
step1 = stepLeft c
step2 = stepRight (cellTop c)
wall = (step1, step2) in
TestCase (assertBool
not (validWallAction startingGame wall)
(not (validWallAction startingGame wall)))

{-
performAction :: Game -> Action -> Maybe Game
-}

performActionTest1 :: Test
performActionTest1 = let
p = currentPlayer startingPlayers
c = currentCell p
step = stepLeft c in
case (performAction startingGame (Move step)) of
(Just (Game _ ps)) -> let
p = previousPlayer ps
c = currentCell p in
TestCase (assertEqual performAction move left c (cellLeft c))
Nothing -> TestCase (assertBool performAction move left fail False)

performActionTest2 :: Test
performActionTest2 = let
p = currentPlayer startingPlayers
c = currentCell p
step = (c, cellTop (cellTop c)) in
case (performAction startingGame (Move step)) of
(Just _) -> TestCase (assertBool performAction invalid move fail False)
Nothing -> TestCase (assertBool performAction invalid move True)

performActionTest3 :: Test
performActionTest3 = let
p = currentPlayer startingPlayers
c = currentCell p
step1 = stepLeft c
step2 = stepLeft (cellTop c)
wall = (step1, step2) in
case (performAction startingGame (Place wall)) of
(Just (Game b _)) -> TestCase (assertEqual
performAction place wall number of edges
(length (edges startingBoard)) ((length (edges b)) + 4)) Edges go both ways.
Nothing -> TestCase (assertBool performAction place wall fail False)

All unit tests together.
gameUnitTests :: Spec
gameUnitTests = fromHUnitTest $
TestList [
TestLabel currentPlayerTest currentPlayerTest,
TestLabel previousPlayerTest previousPlayerTest,
TestLabel validStepActionTestTrue validStepActionTestTrue,
TestLabel validStepActionTestFalse validStepActionTestFalse,
TestLabel validWallActionTestTrue validWallActionTestTrue,
TestLabel validWallActionTestFalse validWallActionTestFalse,
TestLabel performActionTest1 performActionTest1,
TestLabel performActionTest2 performActionTest2,
TestLabel performActionTest3 performActionTest3]