packages feed

wordify-0.1.0.0: test/Tests/FullGameTest.hs

module Tests.FullGameTest where

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

    letterValues :: M.Map Char 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)]

    testDictionary :: IO (Either ScrabbleError Dictionary)
    testDictionary = makeDictionary $ "Config" ++ [F.pathSeparator] ++ "engSet" ++ [F.pathSeparator] ++ "en.txt"

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

    setupGame :: IO (Either ScrabbleError Game)
    setupGame =
      do
        bag <- letterBag
        dict <- testDictionary
        return $ resultGame bag dict
      where
        resultGame bag dict =
          do
            dc <- dict
            let [player1, player2,player3,player4] = map makePlayer ["a","b","c","d"]
            makeGame (player1, player2, Just (player3, Just player4)) bag dc



    placeMap :: String -> Direction -> (Int, Int) -> M.Map Pos Tile
    placeMap letters direction pos = M.fromList $ zip positions tiles
        where
            positions =
                case direction of
                    Horizontal -> catMaybes $ takeWhile isJust <$> map posAt $ iterate (\(x,y) -> (x+1,y)) pos
                    Vertical -> catMaybes $ takeWhile isJust <$> map posAt $ iterate (\(x,y) -> (x, y + 1)) pos

            tiles = map toTilePlaced letters

    toTileBag :: Char -> Tile
    toTileBag lettr =
        case lettr of
            '_' -> Blank Nothing
            x -> Letter x $ M.findWithDefault 0 x letterValues

    toTilePlaced :: Char -> Tile
    toTilePlaced char
        | isLower char = Blank $ Just (toUpper char)
        | otherwise = toTileBag char

    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
        game <- setupGame
        assertBool "Could not initialise game for test " $ isValid game

        let Right testGame = game
        bag <- letterBag
        let moveTransitions = restoreGame testGame $ 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
          game <- setupGame
          -- 8 consecutive passes ends the game
          let skipMoves = NE.fromList $ replicate 8 Pass
          assertBool "Could not initialise game for test " $ isValid game

          let Right testGame = game
          let transitions = restoreGame testGame 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
        game <- setupGame
        assertBool "Could not initialise game for test " $ isValid game
        let Right testGame = game
        let movesWithSkips = take 10 $ concat $ intersperse (replicate 4 Pass) $ splitEvery 4 moves
        let transitions = restoreGame testGame $ 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 <- 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 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 ->
                    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

            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 playerTiles)

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

    playerInMoveTransitionIsAsExpected :: Assertion
    playerInMoveTransitionIsAsExpected =
        do
            game <- 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."