packages feed

wordify-0.7.0.0: test/Tests/FullGameTest.hs

module Tests.FullGameTest where

import Control.Monad
import Data.Char
import Data.List
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Sequence as Seq
import qualified System.FilePath as F
import Test.HUnit.Base
import Tests.SharedTestData
import Wordify.Rules.Board
import Wordify.Rules.Dictionary
import Wordify.Rules.Game
import Wordify.Rules.LetterBag
import Wordify.Rules.Move
import Wordify.Rules.Player
import Wordify.Rules.Pos
import Wordify.Rules.WordifyError
import Wordify.Rules.Tile

letterValues :: M.Map String Int
letterValues = M.fromList $ [("A", 1), ("B", 3), ("C", 3), ("D", 2), ("E", 1), ("F", 4), ("G", 2), ("H", 4), ("I", 1), ("J", 8), ("K", 5), ("L", 1), ("M", 3), ("N", 1), ("O", 1), ("P", 3), ("Q", 10), ("R", 1), ("S", 1), ("T", 1), ("U", 1), ("V", 4), ("W", 4), ("X", 8), ("Y", 4), ("Z", 10)]

letterBag :: IO LetterBag
letterBag = bagFromTiles $ map toTileBag tilesAsLetters
  where
    tilesAsLetters = "JEARVINENVO_NILLEWBKONUIEUWEAZBDESIAPAEOOURGOCDSNIADOAACAR_RMYELTUTYTEREOSITNIRFGPHAQLHESOIITXFDMETG"

testPlayers :: (Player, Player, Maybe (Player, Maybe Player))
testPlayers = let [p1, p2, p3, p4] = map makePlayer ["a", "b", "c", "d"]
              in (p1, p2, Just (p3, Just p4))

moves :: [Move]
moves = moveList
  where
    moveList =
      map
        PlaceTiles
        [ placeMap "RAVINE" Horizontal (8, 8),
          placeMap "OVEl" Vertical (12, 9),
          placeMap "W" Vertical (9, 7) `M.union` placeMap "KE" Vertical (9, 9),
          placeMap "N" Horizontal (11, 9),
          placeMap "B" Horizontal (13, 7) `M.union` placeMap "D" Horizontal (13, 9),
          placeMap "NAI" Horizontal (9, 12),
          placeMap "B" Horizontal (11, 11) `M.union` placeMap "LLE" Horizontal (13, 11),
          placeMap "WEE" Vertical (10, 13),
          placeMap "JA" Vertical (15, 9) `M.union` placeMap "GERS" Vertical (15, 12),
          placeMap "CANOPI" Horizontal (4, 15) `M.union` placeMap "D" Horizontal (11, 15),
          placeMap "SONI" Vertical (4, 11),
          placeMap "AUDIO" Vertical (3, 10),
          placeMap "RAZeR" Vertical (5, 8),
          placeMap "MULEY" Vertical (2, 6),
          placeMap "ROOTY" Vertical (3, 2),
          placeMap "ETUIS" Vertical (14, 4),
          placeMap "RACING" Vertical (1, 10),
          placeMap "HATP" Vertical (11, 4),
          placeMap "HAES" Vertical (12, 2),
          placeMap "DOUX" Vertical (15, 1),
          placeMap "GEM" Vertical (13, 1),
          placeMap "Q" Horizontal (4, 9) `M.union` placeMap "T" Horizontal (6, 9),
          placeMap "IO" Vertical (6, 13),
          placeMap "FIT" Vertical (10, 2)
        ]

playThroughTest :: Assertion
playThroughTest =
  do
    bag <- letterBag
    Right dict <- testDictionary
    let moveTransitions = restoreGame testPlayers bag dict $ NE.fromList $ moves

    case moveTransitions of
      Left err ->
        assertFailure $ "Unable to play through test game, error was: " ++ show err
      Right transitions ->
        do
          let finalTransition = NE.last transitions
          assertBool "Expect the game to have ended" $ isFinalTransition finalTransition

          let finalGame = newGame finalTransition

          assertEqual "Unexpected number of moves" (length moves) (moveNumber finalGame)

          assertEqual "Unexpected history for game" (History bag (Seq.fromList moves)) (history finalGame)

          let finalBoard = board finalGame

          let [finalPlayer1, finalPlayer2, finalPlayer3, finalPlayer4] = players finalGame

          assertEqual "Unexpected final score for player 1" (189 - 5) (score finalPlayer1)
          assertEqual "Unexpected remaining tiles for player 1" [Letter "T" 1, Letter "F" 4] (tilesOnRack finalPlayer1)

          assertEqual "Unexpected remaining tiles for player 2" [Letter "L" 1] (tilesOnRack finalPlayer2)
          assertEqual "Unexpected final score for player 2" ((136 + 50) - 1) (score finalPlayer2) -- This player scored a bingo word
          assertEqual "Unexpected remaining tiles for player 3" [Letter "E" 1] (tilesOnRack finalPlayer3)
          assertEqual "Unexpected score for player 3" (110 - 1) (score finalPlayer3)

          assertEqual "Unexpected remaing tiles for player 4" [] (tilesOnRack finalPlayer4)
          assertEqual "Unexpected score for winning player" (154 + 1 + 5 + 1) (score finalPlayer4)
  where
    isFinalTransition trans =
      case trans of
        GameFinished _ _ -> True
        otherwise -> False

gameEndsOnConsecutiveSkips :: Assertion
gameEndsOnConsecutiveSkips =
  do
    bag <- letterBag
    Right dict <- testDictionary
    -- 8 consecutive passes ends the game
    let skipMoves = NE.fromList $ replicate 8 Pass
    let transitions = restoreGame testPlayers bag dict skipMoves
    let lastGame = fmap NE.last transitions
    assertBool ("Unexpected failure when playing moves ") $ isValid lastGame

    let Right finalTrans = lastGame

    case finalTrans of
      GameFinished _ _ -> assertEqual "Unexpected move number" (moveNumber (newGame finalTrans)) 8
      otherwise -> assertFailure "Unexpected end state. Expected ' Game finished ' "

gameDoesNotEndOnNonConsecutiveSkips :: Assertion
gameDoesNotEndOnNonConsecutiveSkips =
  do
    bag <- letterBag
    Right dict <- testDictionary
    let movesWithSkips = take 10 $ concat $ intersperse (replicate 4 Pass) $ splitEvery 4 moves
    let transitions = restoreGame testPlayers bag dict $ NE.fromList movesWithSkips

    assertBool "Unexpected error making moves" $ isValid transitions

    let Right gameTransitions = transitions
    let lastGame = newGame $ NE.last gameTransitions

    assertEqual "Expected game to still be in progress" InProgress (gameStatus lastGame)
    assertEqual "Unexpected player's move" ((10 `mod` 4) + 1) (playerNumber lastGame)
    assertEqual "Unexpected current player" (fmap fst (optionalPlayers lastGame)) (Just (currentPlayer lastGame))
  where
    splitEvery n = takeWhile (not . null) . unfoldr (Just . splitAt n)

exchangeMoveExchangesLetters :: Assertion
exchangeMoveExchangesLetters =
  do
    game <- letterBag >>= setupGame
    assertBool "Could not initialise game for test " $ isValid game
    let Right testGame = game
    let firstPlayer = player1 testGame
    let playerTiles = tilesOnRack firstPlayer
    let move = Exchange (drop 1 playerTiles)
    let outcome = makeMove testGame move

    assertBool ("Expected move to be successful. ") $ isValid outcome
    let Right transition = outcome

    let nextGame = newGame transition
    let newPlayer1 = player1 nextGame

    case transition of
      ExchangeTransition game playerBefore playerAfter tiles ->
        do
          assertEqual "playerBefore in the transition should be the player before making the move" (firstPlayer) playerBefore
          assertEqual "playerAfter in the transition should be the player after making the move" (newPlayer1) playerAfter
          assertEqual "Exchanged tiles in the transition should be the tiles exchanged in the move" (drop 1 playerTiles) tiles

    assertBool ("Player 1 should have new letters on their rack. Player 1 was: " ++ (show newPlayer1)) (not $ firstPlayer == newPlayer1)

    assertEqual "Game has transitioned to the next player " (currentPlayer nextGame) (player2 testGame)

    assertBool "Player number and move number incremented" $ (playerNumber nextGame == 2) && (moveNumber nextGame) == 2

    let originalLetterBag = bag testGame
    let exchangedLetterBag = fmap snd (exchangeLetters originalLetterBag (drop 1 playerTiles))

    assertEqual "The letter bag for the game transition is as expected " exchangedLetterBag (Just $ bag nextGame)

playerInMoveTransitionIsAsExpected :: Assertion
playerInMoveTransitionIsAsExpected =
  do
    game <- letterBag >>= setupGame
    assertBool "Could not initialise game for test " $ isValid game
    let Right testGame = game

    let move = head moves
    let outcome = makeMove testGame move

    case outcome of
      Right (MoveTransition player game formedwords) ->
        do
          assertEqual "Player should be the new state of the player in the game " (player1 game) player
      otherwise -> assertFailure "Failed to set up test correctly."