module Wordify.Rules.Player (
Player,
LetterRack,
makePlayer,
name,
rack,
tilesOnRack,
endBonus,
score,
increaseScore,
reduceScore,
giveEndLosePenalty,
giveEndWinBonus,
giveTiles,
removePlayedTiles,
removeTiles,
hasEmptyRack,
tileValues,
exchange) where
import Wordify.Rules.Tile
import Data.List
import Data.Maybe
import qualified Data.Map as Map
type Score = Int
type Name = String
data LetterRack = LetterRack [Tile] deriving (Show, Eq)
data Player = Player {name :: Name
, rack :: LetterRack
, score :: Score
, endBonus :: Int} deriving (Show, Eq)
makePlayer :: String -> Player
makePlayer playerName = Player playerName (LetterRack []) 0 0
tilesOnRack :: Player -> [Tile]
tilesOnRack (Player _ (LetterRack letters) _ _) = letters
increaseScore :: Player -> Int -> Player
increaseScore player justScored = player {score = currentScore + justScored}
where
currentScore = score player
reduceScore :: Player -> Int -> Player
reduceScore player removeScore = player {score = currentScore removeScore}
where
currentScore = score player
giveEndLosePenalty :: Player -> Int -> Player
giveEndLosePenalty player penalty = (reduceScore player penalty) {endBonus = penalty}
giveEndWinBonus :: Player -> Int -> Player
giveEndWinBonus player bonus = (increaseScore player bonus) {endBonus = bonus}
hasEmptyRack :: Player -> Bool
hasEmptyRack player = null $ tilesOnRack player
tileValues :: Player -> Int
tileValues player = sum $ map tileValue (tilesOnRack player)
giveTiles :: Player -> [Tile] -> Player
giveTiles player newTiles = player {rack = LetterRack $ newTiles ++ tilesOnRack player}
removeTiles :: Player -> [Tile] -> Player
removeTiles player toRemove = player {rack = LetterRack $ tilesOnRack player \\ toRemove}
removePlayedTiles :: Player -> [Tile] -> Maybe Player
removePlayedTiles player tiles =
if (playerCanPlace player tiles)
then Just $ player `removedFromRack` tiles
else Nothing
where
removedFromRack playing playedTiles = player {rack = LetterRack (deleteFirstsBy isPlayable (tilesOnRack playing) playedTiles) }
playerCanPlace :: Player -> [Tile] -> Bool
playerCanPlace player played = isNothing $ find isInvalid playedList
where
(playedFrequencies, rackFrequencies) = tileFrequencies played $ tilesOnRack player
playedList = Map.toList playedFrequencies
isInvalid (tile, freq) =
case tile of
Blank Nothing -> False
Blank _ -> freq > Map.findWithDefault 0 (Blank Nothing) rackFrequencies
Letter chr val -> freq > Map.findWithDefault 0 (Letter chr val) rackFrequencies
exchange :: Player -> [Tile] -> [Tile] -> Maybe Player
exchange player exchanged received =
if not (playerCanExchange player exchanged) then Nothing
else
Just $ giveTiles (removeTiles player exchanged) received
playerCanExchange :: Player -> [Tile] -> Bool
playerCanExchange (Player _ ( LetterRack letterRack) _ _) exchanged =
isNothing $ find cannotExchange exchangedList
where
(exchangedFrequencies, rackFrequencies) = tileFrequencies exchanged letterRack
exchangedList = Map.toList exchangedFrequencies
cannotExchange (tile, freq) =
case tile of
Blank (Just _) -> False
Blank _ -> freq > Map.findWithDefault 0 (Blank Nothing) rackFrequencies
Letter chr val -> freq > Map.findWithDefault 0 (Letter chr val) rackFrequencies
tileFrequencies :: [Tile] -> [Tile] -> ((Map.Map Tile Int), (Map.Map Tile Int))
tileFrequencies given letterRack = (givenFrequencies, rackFrequencies)
where
buildFrequencies tiles = foldl addFrequency (Map.empty) tiles
addFrequency dict tile = Map.alter newFrequency tile dict
newFrequency m = Just $ maybe 1 succ m
givenFrequencies = buildFrequencies given
rackFrequencies = buildFrequencies letterRack