wordify-0.1.0.0: test/Tests/FormedWordsTest.hs
module Tests.FormedWordsTest where
import Tests.SharedTestData
import Wordify.Rules.Pos
import Wordify.Rules.Tile
import Wordify.Rules.Board
import Wordify.Rules.Board.Internal
import qualified Data.Map as M
import Wordify.Rules.FormedWord
import Test.HUnit.Base
import Data.Maybe
import Data.Either
import Wordify.Rules.Pos.Internal
import qualified Data.Sequence as S
import Wordify.Rules.Square
import Control.Applicative
import Wordify.Rules.ScrabbleError
import Wordify.Rules.Pos.Internal
testBoard :: Board
testBoard = Board squareMap
where
squareMap = M.fromList $ (M.assocs emptySquares ++ verticals ++ horizontals)
Board (emptySquares) = emptyBoard
{-
Asserts that we can correctly add the bracket notation to a placed word, prepending to a word
-}
testPrettyPrintIntersectionPrepend :: Assertion
testPrettyPrintIntersectionPrepend =
do
let positions = take 3 $ catMaybes $ map posAt $ iterate(\(x,y) -> (x + 1,y)) (4,5)
let tiles = [Letter 'T' 1, Letter 'E' 1, Letter 'S' 1]
let placedList = zip positions $ map (Normal . Just) tiles
let placed = M.fromList placedList
let formedPositions = catMaybes $ map posAt $ iterate(\(x,y) -> (x + 1,y)) (8,5)
let formed = (S.fromList placedList) S.>< (S.fromList $ zip formedPositions $ map (Normal . Just . flip Letter 1) ['T', 'I', 'N', 'G'])
let actual = prettyPrintIntersections placed formed
assertEqual "Did not form expected pretty printed intersection" "TES(TING)" actual
testPrettyPrintIntersectionAppend :: Assertion
testPrettyPrintIntersectionAppend =
do
let positions = take 4 $ catMaybes $ map posAt $ iterate(\(x,y) -> (x + 1,y)) (8,5)
let tiles = map (flip Letter 1) ['T', 'I', 'N', 'G']
let placedList = zip positions $ map (Normal . Just) tiles
let placed = M.fromList placedList
let formedPositions = take 3 $ catMaybes $ map posAt $ iterate(\(x,y) -> (x + 1,y)) (4,5)
let formed = (S.fromList $ zip formedPositions $ map (Normal . Just . flip Letter 1) ['T','E','S']) S.>< S.fromList placedList
let actual = prettyPrintIntersections placed formed
assertEqual "Did not form expected pretty printed intersection" "(TES)TING" actual
testPrettyPrintIntersectionFirstWord :: Assertion
testPrettyPrintIntersectionFirstWord =
do
let positions = take 4 $ catMaybes $ map posAt $ iterate(\(x,y) -> (x + 1,y)) (8,5)
let tiles = map (flip Letter 1) ['T', 'E', 'S', 'T']
let placedList = zip positions $ map (Normal . Just) tiles
let placed = M.fromList placedList
let formed = S.fromList $ zip positions $ map (Normal . Just) tiles
let actual = prettyPrintIntersections placed formed
assertEqual "Did not form expected pretty printed intersection" "TEST" actual
testPrettyPrintThroughPlacedLetters :: Assertion
testPrettyPrintThroughPlacedLetters =
do
let positions = take 4 $ catMaybes $ map posAt $ iterate(\(x,y) -> (x + 1,y)) (8,5)
let positions2 = take 2 $ catMaybes $ map posAt $ iterate(\(x,y) -> (x + 1,y)) (13,5)
let tiles = map (flip Letter 1) ['T', 'I', 'N', 'G']
let placedList = zip positions $ map (Normal . Just) tiles
let placed = M.fromList placedList
let alreadyPlacedList2 = zip positions2 $ map (Normal . Just) tiles
let formedPositions = take 3 $ catMaybes $ map posAt $ iterate(\(x,y) -> (x + 1,y)) (4,5)
let formed = (S.fromList $ zip formedPositions $ map (Normal . Just . flip Letter 1) ['T','E','S']) S.>< S.fromList placedList S.>< S.fromList alreadyPlacedList2
let actual = prettyPrintIntersections placed formed
assertEqual "Did not form expected pretty printed intersection" "(TES)TING(TI)" actual
attachLeftWord :: Assertion
attachLeftWord =
do
let positions = take 3 $ catMaybes $ map posAt $ iterate(\(x,y) -> (x + 1,y)) (4,5)
let tiles = [Letter 'T' 1, Letter 'E' 1, Letter 'S' 1]
let placed = M.fromList $ zip positions tiles
let formed = wordsFormedMidGame testBoard placed
assertBool "Unexpected error in wordsFormedMidGame in attach left test initialisation" $ isValid formed
let Right wordsFormed = formed
let expectedWord = S.fromList $ M.toList placed ++ [(Pos 7 5 "G5", Letter 'T' 1)]
assertBool "Unexpected words formed " $ (wordStrings wordsFormed) == ["TEST"]
let squares = catMaybes $ map (unoccupiedSquareAt testBoard) positions
let expectedSquares = zipWith putTileOn squares tiles
let expectedFormedWord = S.fromList $ zip positions expectedSquares ++ [(Pos 7 5 "G5", Normal $ Just $ Letter 'T' 1)]
assertEqual "Unexpected main word formed" expectedFormedWord (mainWord wordsFormed)
assertEqual "Unexpected player placed" (S.take 3 expectedFormedWord) (S.fromList $ (playerPlaced wordsFormed))
assertEqual "Expected empty adjecent words" [] (adjacentWords wordsFormed)
let (overallscore, _) = wordsWithScores wordsFormed
assertEqual "Unexpected score for placed tiles" ((1 + 1 + 1 + 1) * 2) overallscore
attachRightWord :: Assertion
attachRightWord =
do
let positions = take 5 $ catMaybes $ map posAt $ iterate (\(x,y) -> (x + 1,y)) (8,9)
let tiles = [Letter 'E' 1, Letter 'L' 1, Letter 'L' 1, Letter 'O' 1, Blank (Just 'W')]
let placed = M.fromList $ zip positions tiles
let formed = wordsFormedMidGame testBoard placed
assertBool "Unexpected error in wordsFormedMidGame in attach right test initialisation" $ isValid formed
let Right wordsFormed = formed
let expectedWord = S.fromList $ (Pos 7 9 "G7", Letter 'Y' 4) : M.toList placed
assertBool "Unexpected words formed " $ (wordStrings wordsFormed) == ["YELLOW"]
let squares = catMaybes $ map (unoccupiedSquareAt testBoard) positions
let expectedSquares = zipWith putTileOn squares tiles
let expectedFormedWord = S.fromList $ ((Pos 7 9 "G9"), (DoubleLetter $ Just $ Letter 'Y' 4)) : zip positions expectedSquares
assertEqual "Unexpected main word formed" expectedFormedWord (mainWord wordsFormed)
assertEqual "Unexpected player placed" (S.drop 1 expectedFormedWord) (S.fromList $ (playerPlaced wordsFormed))
assertEqual "Expected empty adjecent words" [] (adjacentWords wordsFormed)
let (overallscore, _) = wordsWithScores wordsFormed
assertEqual "Unexpected score for placed tiles" (4 + 1 + (2 * 1) + 1 + 1 + 0) overallscore
attachAboveWord :: Assertion
attachAboveWord =
do
let positions = catMaybes $ map posAt $ iterate (\(x,y) -> (x,y + 1)) (7,3)
let tiles = [Letter 'A' 1, Letter 'B' 3]
let placed = M.fromList $ zip positions tiles
let formed = wordsFormedMidGame testBoard placed
assertBool "Unexpected error in wordsFormedMidGame in attach above test initialisation" $ isValid formed
let Right wordsFormed = formed
assertBool "Unexpected words formed " $ (wordStrings wordsFormed) == ["ABTELLY"]
let squares = catMaybes $ map (unoccupiedSquareAt testBoard) positions
let expectedFormedWord = S.fromList $ zip positions $ zipWith putTileOn squares tiles ++ verticalSquares
assertEqual "Unexpected main word formed" expectedFormedWord (mainWord wordsFormed)
assertEqual "Unexpected player placed" (S.take 2 expectedFormedWord) (S.fromList $ (playerPlaced wordsFormed))
assertEqual "Expected empty adjecent words" [] (adjacentWords wordsFormed)
let (overallscore, _) = wordsWithScores wordsFormed
assertEqual "Unexpected score for placed tiles" ((2 * 1) + 3 + 1 + 1 + 1 + 1 + 4) overallscore
attachWordBelow :: Assertion
attachWordBelow =
do
let positions = take 2 $ catMaybes $ map posAt $ iterate (\(x,y) -> (x,y + 1)) (7,10)
let tiles = [Letter 'A' 1, Letter 'B' 3]
let placed = M.fromList $ zip positions tiles
let formed = wordsFormedMidGame testBoard placed
assertBool "Unexpected error in wordsFormedMidGame in attach below test initialisation" $ isValid formed
let Right wordsFormed = formed
assertBool "Unexpected words formed " $ (wordStrings wordsFormed) == ["TELLYAB"]
let squares = catMaybes $ map (unoccupiedSquareAt testBoard) positions
let leadingPositions = catMaybes $ map posAt $ iterate (\(x,y) -> (x,y + 1)) (7,5)
let expectedFormedWord = S.fromList $ (zip leadingPositions verticalSquares) ++ (zip positions $ zipWith putTileOn squares tiles)
assertEqual "Unexpected main word formed" expectedFormedWord (mainWord wordsFormed)
assertEqual "Unexpected player placed" (S.drop 5 expectedFormedWord) (S.fromList $ (playerPlaced wordsFormed))
assertEqual "Expected empty adjecent words" [] (adjacentWords wordsFormed)
let (overallscore, _) = wordsWithScores wordsFormed
assertEqual "Unexpected score for placed tiles" (1 + 1 + 1 + 1 + 4 + 1 + 3) overallscore
attachAboveAndBelow :: Assertion
attachAboveAndBelow =
do
let abovePositions = catMaybes $ map posAt $ [(7,3), (7,4)]
let belowPositions = catMaybes $ map posAt $ [(7,10), (7,11)]
let placedPositions = (abovePositions ++ belowPositions)
let tiles = cycle $ [Letter 'A' 1, Letter 'B' 3]
let placed = M.fromList $ zip placedPositions tiles
let formed = wordsFormedMidGame testBoard placed
assertBool "Unexpected error in wordsFormedMidGame in attach above test initialisation" $ isValid formed
let Right wordsFormed = formed
assertBool "Unexpected words formed " $ (wordStrings wordsFormed) == ["ABTELLYAB"]
let placedSquares = catMaybes $ map (unoccupiedSquareAt testBoard) placedPositions
let tilesOnPlaced = zipWith putTileOn placedSquares tiles
let expectedFormedWord = S.fromList $ zip abovePositions (take 2 tilesOnPlaced) ++ (zip verticalPositions verticalSquares) ++ (zip belowPositions (drop 2 tilesOnPlaced))
assertEqual "Unexpected main word formed" expectedFormedWord (mainWord wordsFormed)
assertEqual "Expected empty adjecent words" [] (adjacentWords wordsFormed)
let (overallscore, _) = wordsWithScores wordsFormed
assertEqual "Unexpected score for placed tiles" ((2 * 1) + 3 + 1 + 1 + 1 + 1 + 4 + 1 + 3) overallscore
attachLeftAndRight :: Assertion
attachLeftAndRight =
do
let leftPositions = catMaybes $ map posAt $ [(3,7), (4,7)]
let rightPositions = catMaybes $ map posAt $ [(10,7), (11,7)]
let placedPositions = (leftPositions ++ rightPositions)
let tiles = cycle $ [Letter 'A' 1, Letter 'B' 3]
let placed = M.fromList $ zip placedPositions tiles
let formed = wordsFormedMidGame testBoard placed
assertBool "Unexpected error in wordsFormedMidGame test initialisation" $ isValid formed
let Right wordsFormed = formed
assertBool "Unexpected words formed " $ (wordStrings wordsFormed) == ["ABHELLOAB"]
let placedSquares = catMaybes $ map (unoccupiedSquareAt testBoard) placedPositions
let tilesOnPlaced = zipWith putTileOn placedSquares tiles
let expectedFormedWord = S.fromList $ zip leftPositions (take 2 tilesOnPlaced) ++ (zip horizontalPositions horizontalSquares) ++ (zip rightPositions (drop 2 tilesOnPlaced))
assertEqual "Unexpected main word formed" expectedFormedWord (mainWord wordsFormed)
assertEqual "Expected empty adjecent words" [] (adjacentWords wordsFormed)
let (overallscore, _) = wordsWithScores wordsFormed
assertEqual "Unexpected score for placed tiles" ((2 * 1) + 3 + 4 + 1 + 1 + 1 + 1 + 1 + 3) overallscore
adjacentWordsLeft :: Assertion
adjacentWordsLeft =
do
let positions = catMaybes $ map posAt [(8,5), (8,6), (8,8)]
let tiles = [Letter 'O' 1, Letter 'I' 1, Letter 'S' 1]
let placedList = zip positions tiles
let placed = M.fromList $ placedList
let formed = wordsFormedMidGame testBoard placed
assertBool "Unexpected error in wordsFormedMidGame test initialisation" $ isValid formed
let Right wordsFormed = formed
assertEqual "Unexpected words formed" ["OILS", "TO", "EI", "LS"] (wordStrings wordsFormed)
let squares = zipWith putTileOn (catMaybes $ map (unoccupiedSquareAt testBoard) positions) tiles
let positionsFromTop = catMaybes $ map posAt $ iterate (\(x,y) -> (x, y + 1)) (8,5)
let squaresWithPositions = zip positionsFromTop $ (init squares) ++ [Normal $ Just $ Letter 'L' 1] ++ [last squares]
let expectedMainWord = S.fromList $ squaresWithPositions
assertEqual "Unexpected main word" expectedMainWord (mainWord wordsFormed)
let expectedWordsWithScores = (((1 + 1 + 1 + 1) * 2) + 2 + 2 + 4, [("OILS", ((1 + 1 + 1 + 1) * 2)), ("TO", 2), ("EI", 2), ("LS", 4)] )
assertEqual "Unexpected words with scores" expectedWordsWithScores (wordsWithScores wordsFormed)
let connectedTo = take 2 verticals ++ drop 3 verticals
let placedSquares = zip positions $ (init squares) ++ [last squares]
let expectedAdjacent = zipWith (\l r -> l S.<| S.singleton r) connectedTo placedSquares
assertEqual "Unexpected adjacent words" expectedAdjacent (adjacentWords wordsFormed)
adjacentWordsRight :: Assertion
adjacentWordsRight =
do
let positions = catMaybes $ map posAt [(6,4), (6,5), (6,6), (6,8)]
let tiles = [Letter 'B' 3, Letter 'I' 1, Letter 'T' 1, Letter 'R' 1]
let placedList = zip positions tiles
let placed = M.fromList $ placedList
let formed = wordsFormedMidGame testBoard placed
assertBool "Unexpected error in wordsFormedMidGame test initialisation" $ isValid formed
let Right wordsFormed = formed
assertEqual "Unexpected words formed" ["BITER", "IT", "TE", "RL"] (wordStrings wordsFormed)
let squares = zipWith putTileOn (catMaybes $ map (unoccupiedSquareAt testBoard) positions) tiles
let positionsFromTop = catMaybes $ map posAt $ iterate (\(x,y) -> (x, y + 1)) (6,4)
let squaresWithPositions = zip positionsFromTop $ (init squares) ++ [Normal $ Just $ Letter 'E' 1] ++ [last squares]
let expectedMainWord = S.fromList $ squaresWithPositions
assertEqual "Unexpected main word" expectedMainWord (mainWord wordsFormed)
let expectedWordsWithScores = ((3 + 1 + 3 + 1 + 1) + 2 + 4 + 2, [("BITER",(3 + 1 + 3 + 1 + 1)) , ("IT", 2), ("TE", 4), ("RL", 2)] )
assertEqual "Unexpected words with scores" expectedWordsWithScores (wordsWithScores wordsFormed)
let connectedTo = take 2 verticals ++ drop 3 verticals
let placedSquares = zip positions $ (init squares) ++ [last squares]
let expectedAdjacent = zipWith (\l r -> l S.<| S.singleton r) (drop 1 placedSquares) connectedTo
assertEqual "Unexpected adjacent words" expectedAdjacent (adjacentWords wordsFormed)
adjacentWordsAbove :: Assertion
adjacentWordsAbove =
do
let positions = catMaybes $ map posAt [(6,6), (8,6)]
let tiles = [Letter 'H' 4, Letter 'J' 8]
let placedList = zip positions tiles
let placed = M.fromList $ placedList
let formed = wordsFormedMidGame testBoard placed
assertBool "Unexpected error in wordsFormedMidGame test initialisation" $ isValid formed
let Right wordsFormed = formed
assertEqual "Unexpected words formed" ["HEJ", "HE", "JL"] (wordStrings wordsFormed)
let squares = zipWith putTileOn (catMaybes $ map (unoccupiedSquareAt testBoard) positions) tiles
let positionsFromLeft = catMaybes $ map posAt $ iterate (\(x,y) -> (x + 1, y)) (6,6)
let squaresWithPositions = zip positionsFromLeft $ (init squares) ++ [Normal $ Just $ Letter 'E' 1] ++ [last squares]
let expectedMainWord = S.fromList $ squaresWithPositions
assertEqual "Unexpected main word" expectedMainWord (mainWord wordsFormed)
let expectedWordsWithScores = (((4 * 3) + 1 + 8) + 13 + 9, [("HEJ", ((4 * 3) + 1 + 8)), ("HE", 13), ("JL", 9)] )
assertEqual "Unexpected words with scores" expectedWordsWithScores (wordsWithScores wordsFormed)
let connectedTo = [head (drop 1 horizontals)] ++ [head $ drop 3 horizontals]
let placedSquares = zip positions $ (init squares) ++ [last squares]
let expectedAdjacent = zipWith (\l r -> l S.<| S.singleton r) placedSquares connectedTo
assertEqual "Unexpected adjacent words" expectedAdjacent (adjacentWords wordsFormed)
adjacentWordsBelow :: Assertion
adjacentWordsBelow =
do
let positions = catMaybes $ map posAt [(6,8), (8,8)]
let tiles = [Letter 'I' 1, Letter 'L' 1]
let placedList = zip positions tiles
let placed = M.fromList $ placedList
let formed = wordsFormedMidGame testBoard placed
assertBool "Unexpected error in wordsFormedMidGame test initialisation" $ isValid formed
let Right wordsFormed = formed
assertEqual "Unexpected words formed" ["ILL", "EI", "LL"] (wordStrings wordsFormed)
let squares = zipWith putTileOn (catMaybes $ map (unoccupiedSquareAt testBoard) positions) tiles
let positionsFromLeft = catMaybes $ map posAt $ iterate (\(x,y) -> (x + 1, y)) (6,8)
let squaresWithPositions = zip positionsFromLeft $ (init squares) ++ [Normal $ Just $ Letter 'L' 1] ++ [last squares]
let expectedMainWord = S.fromList $ squaresWithPositions
assertEqual "Unexpected main word" expectedMainWord (mainWord wordsFormed)
let expectedWordsWithScores = (6 + 2 + 4, [("ILL", 6), ("EI", 2), ("LL", 4)] )
assertEqual "Unexpected words with scores" expectedWordsWithScores (wordsWithScores wordsFormed)
let connectedTo = [head (drop 1 horizontals)] ++ [head $ drop 3 horizontals]
let placedSquares = zip positions $ (init squares) ++ [last squares]
let expectedAdjacent = zipWith (\l r -> l S.<| S.singleton r) connectedTo placedSquares
assertEqual "Unexpected adjacent words" expectedAdjacent (adjacentWords wordsFormed)
placedOneTileAbove :: Assertion
placedOneTileAbove =
do
let placed = catMaybes $ map posAt [(9,6)]
let tiles = [Letter 'Y' 4]
let placedTiles = M.fromList $ zip placed tiles
let formed = wordsFormedMidGame testBoard placedTiles
assertBool "Unexpected error in wordsFormedMidGame test initialisation" $ isValid formed
let Right wordsFormed = formed
assertEqual "Unexpected words formed" ["YO"] (wordStrings wordsFormed)
placedOneTileBelow :: Assertion
placedOneTileBelow =
do
let placed = catMaybes $ map posAt [(9,8)]
let tiles = [Letter 'I' 1]
let placedTiles = M.fromList $ zip placed tiles
let formed = wordsFormedMidGame testBoard placedTiles
assertBool "Unexpected error in wordsFormedMidGame test initialisation" $ isValid formed
let Right wordsFormed = formed
assertEqual "Unexpected words formed" ["OI"] (wordStrings wordsFormed)
placedOneTileRight :: Assertion
placedOneTileRight =
do
let placed = catMaybes $ map posAt [(8,5)]
let tiles = [Letter 'O' 1]
let placedTiles = M.fromList $ zip placed tiles
let formed = wordsFormedMidGame testBoard placedTiles
assertBool "Unexpected error in wordsFormedMidGame test initialisation" $ isValid formed
let Right wordsFormed = formed
assertEqual "Unexpected words formed" ["TO"] (wordStrings wordsFormed)
placedOneTileLeft :: Assertion
placedOneTileLeft =
do
let placed = catMaybes $ map posAt [(6,9)]
let tiles = [Letter 'O' 1]
let placedTiles = M.fromList $ zip placed tiles
let formed = wordsFormedMidGame testBoard placedTiles
assertBool "Unexpected error in wordsFormedMidGame test initialisation" $ isValid formed
let Right wordsFormed = formed
assertEqual "Unexpected words formed" ["OY"] (wordStrings wordsFormed)
passesAbove :: Assertion
passesAbove =
do
let positions = catMaybes $ map posAt $ iterate (\(x,y) -> (x + 1, y)) (6,4)
let tiles = [Letter 'H' 4, Letter 'A' 1, Letter 'S' 1]
let placedTiles = M.fromList $ zip positions tiles
let formed = wordsFormedMidGame testBoard placedTiles
assertBool "Unexpected error in initialisation" $ isValid formed
let Right wordsFormed = formed
assertEqual "Unexpected words formed" ["HAS", "ATELLY"] (wordStrings wordsFormed)
passesBelow :: Assertion
passesBelow =
do
let positions = catMaybes $ map posAt $ iterate (\(x,y) -> (x + 1, y)) (6,10)
let tiles = [Letter 'H' 4, Letter 'A' 1, Letter 'S' 1]
let placedTiles = M.fromList $ zip positions tiles
let formed = wordsFormedMidGame testBoard placedTiles
assertBool "Unexpected error in initialisation" $ isValid formed
let Right wordsFormed = formed
assertEqual "Unexpected words formed" ["HAS", "TELLYA"] (wordStrings wordsFormed)
passesThroughTwoWords :: Assertion
passesThroughTwoWords =
do
let setupPositions = catMaybes $ map posAt $ iterate (\(x,y) -> (x, y + 1)) (9,8)
let setupSquares = [Normal $ Just $ Letter 'F' 4, Normal $ Just $ Letter 'F' 4]
let boardSetup = Board $ M.fromList $ (allSquares testBoard) ++ zip setupPositions setupSquares
let placePositions = catMaybes $ map posAt [(8,9), (10,9)]
let tiles = [Letter 'O' 1, Letter 'O' 1]
let placedTiles = M.fromList $ zip placePositions tiles
let formed = wordsFormedMidGame boardSetup placedTiles
assertBool "Unexpected error in initilisation" $ isValid formed
let Right wordsFormed = formed
assertEqual "Unexpected words formed" ["YOFO"] (wordStrings wordsFormed)
assertEqual "Unexpected score for word formed" (10, [("YOFO", 10)])(wordsWithScores wordsFormed)
firstWordThroughStar :: Assertion
firstWordThroughStar =
do
let positions = catMaybes $ map posAt $ iterate (\(x, y) -> (x + 1, y)) (6,8)
let tiles = map (\lett -> Letter lett 1) "LAST"
let placedList = zip positions tiles
let placed = M.fromList $ placedList
let formed = wordFormedFirstMove emptyBoard placed
assertBool "Unexpected error in initilisation" $ isValid formed
let Right wordsFormed = formed
assertEqual "Unexpected words formed by valid first move" (wordsWithScores wordsFormed) (8, [("LAST", 8)])
firstWordNotThroughStar :: Assertion
firstWordNotThroughStar =
do
let positions = catMaybes $ map posAt $ iterate (\(x, y) -> (x, y + 1)) (8,9)
let tiles = map (\lett -> Letter lett 1) "LAST"
let placedList = zip positions tiles
let placed = M.fromList $ placedList
let formed = wordFormedFirstMove emptyBoard placed
assertEqual "Unexpected result for placing tiles which do not intersect the star on the first move" (Left DoesNotCoverTheStarTile) formed
firstWordNotContigiousWord :: Assertion
firstWordNotContigiousWord =
do
let positions = catMaybes $ map posAt $ iterate (\(x, y) -> (x + 1, y)) (6,8)
let tiles = map (\lett -> Letter lett 1) "LAST"
let placedList = zip positions tiles
let placed = M.fromList $ (take 1 placedList) ++ (drop 2 placedList)
let formed = wordFormedFirstMove emptyBoard placed
assertEqual "Unexpected error when placing tiles which are not in a connected line " (Left $ MisplacedLetter (Pos 8 8 "H8") ) formed
doesNotConnectWithWord :: Assertion
doesNotConnectWithWord =
do
let positions = catMaybes $ map posAt $ iterate (\(x, y) -> (x+1, y)) (4,15)
let tiles = map (\lett -> Letter lett 1) "LAST"
let placedList = zip positions tiles
let placed = M.fromList $ placedList
let formed = wordsFormedMidGame emptyBoard placed
assertEqual "Placing tiles that do not connect with a word does not throw the expected error" (Left DoesNotConnectWithWord) formed
nonContigiousHorizontal :: Assertion
nonContigiousHorizontal =
do
let positions = catMaybes $ map posAt [(5,9), (6,9),(8,10),(9,9)]
let tiles = [Letter 'T' 1, Letter 'O' 1, Letter 'E' 1, Letter 'D' 2]
let placedList = zip positions tiles
let placed = M.fromList placedList
let formed = wordsFormedMidGame testBoard placed
assertEqual "Unexpected outcome when placing tiles which are not in a connected line while passing through a word" (Left $ MisplacedLetter (Pos 8 10 "H10") ) formed
nonContigiousVertical :: Assertion
nonContigiousVertical =
do
let positions = catMaybes $ map posAt [(9,6), (9,8), (10,9), (9,10)]
let tiles = [Letter 'T' 1, Letter 'Y' 1, Letter 'E' 1, Letter 'D' 2]
let placedList = zip positions tiles
let placed = M.fromList placedList
let formed = wordsFormedMidGame testBoard placed
assertEqual "Unexpected outcome when placing tiles which are not in a connected line while passing through a word" (Left $ MisplacedLetter (Pos 10 9 "J9") ) formed
placeBlankNothing :: Assertion
placeBlankNothing =
do
let positions = catMaybes $ map posAt $ iterate (\(x, y) -> (x+1,y)) (10,7)
let tiles = [Letter 'T' 1, Blank Nothing, Letter 'A' 1]
let placed = M.fromList $ zip positions tiles
let formed = wordsFormedMidGame testBoard placed
assertEqual "Unexpected outcome when placing a blank tile without a chosen letter" (Left $ CannotPlaceBlankWithoutLetter $ Pos 11 7 "K7") formed
placeOnOccupiedSquare :: Assertion
placeOnOccupiedSquare =
do
let tiles = [Letter 'T' 1, Blank Nothing, Letter 'A' 1]
let placed = M.fromList $ zip verticalPositions tiles
let formed = wordsFormedMidGame testBoard placed
assertEqual "Unexpected outcome for tiles placed on an already occupied square" (Left $ PlacedTileOnOccupiedSquare (head verticalPositions) (head tiles)) formed