haskellscrabble 1.4.3 → 2.0.0

raw patch · 3 files changed

+45/−36 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• haskellscrabble.cabal +1/−1
• src/Wordify/Rules/Move.hs +24/−24
• src/Wordify/Rules/Player.hs +20/−11

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                haskellscrabble-version:             1.4.3+version:             2.0.0 synopsis:            A scrabble library capturing the core game logic of scrabble. description:         A scrabble library which enforces legal transitions between moves. Intended to facilitate the development of a playable game. homepage:            http://www.github.com/happy0/haskellscrabble

@@ -30,13 +30,13 @@                         -- | The new game state, and the player with their rack before and after the exchange respectively.                         | ExchangeTransition Game Player Player                         -- | The new game state with the opportunity to play passed on to the next player.-                        | PassTransition Game -                        {- | +                        | PassTransition Game+                        {- |                           The game has finished. The final game state, and the final words formed (if the game was ended by a                           player placing their final tiles.) The players before their scores were increased or decreased is also                           given.                         -}-                        | GameFinished Game (Maybe FormedWords) [Player]+                        | GameFinished Game (Maybe FormedWords)    {-|     Transitiions the game to the next state. If the move places tiles, the player must have the tiles to place and@@ -58,7 +58,7 @@     do       formed <- formedWords       (overallScore, _) <- scoresIfWordsLegal dict formed-      nextBoard <- newBoard currentBoard placed +      nextBoard <- newBoard currentBoard placed       intermediatePlayer <- removeLettersandGiveScore player playedTiles overallScore        if hasEmptyRack intermediatePlayer && (bagSize letterBag == 0)@@ -66,7 +66,7 @@         do           let beforeFinalisingGame = updateGame game intermediatePlayer nextBoard letterBag           let finalisedGame = finaliseGame beforeFinalisingGame-          return $ GameFinished finalisedGame (Just formed) (players beforeFinalisingGame)+          return $ GameFinished finalisedGame (Just formed)         else           do             let (newPlayer, newBag) = updatePlayerRackAndBag intermediatePlayer letterBag (Map.size placed)@@ -81,18 +81,18 @@        formedWords = if any isPlaceMove (movesMade game)        then wordsFormedMidGame currentBoard placed-       else wordFormedFirstMove currentBoard placed +       else wordFormedFirstMove currentBoard placed -      isPlaceMove mv = case mv of +      isPlaceMove mv = case mv of                           PlaceTiles _ -> True                           _ -> False-      +   exchangeMove :: Game -> [Tile] -> Either ScrabbleError GameTransition   exchangeMove game exchangedTiles =     let exchangeOutcome = exchangeLetters (bag game) exchangedTiles     in case exchangeOutcome of       Nothing -> Left CannotExchangeWhenNoLettersInBag-      Just (givenTiles, newBag) -> +      Just (givenTiles, newBag) ->           let newPlayer = exchange player exchangedTiles givenTiles           in maybe (Left $ PlayerCannotExchange (rack player) exchangedTiles) (\exchangedPlayer ->                     let gameState = updateGame game exchangedPlayer (board game) newBag@@ -101,11 +101,11 @@       player = currentPlayer game    passMove :: Game -> GameTransition-  passMove game = -    let gameState = pass game +  passMove game =+    let gameState = pass game     in       if gameFinished-      then GameFinished (finaliseGame gameState) Nothing (players gameState)+      then GameFinished (finaliseGame gameState) Nothing       else PassTransition gameState     where       numPasses = passes game + 1@@ -115,21 +115,21 @@     Restores a game from a list of moves. The game must be set up in the way the original game was set up     (including the letter bag constructed with the same tiles and random generator, dictionary and the list of players     in the original order.)- +     If the game is not set up as it was originally, this function will return a scrabble error with the move which was invalid     with the given state. For example, if the original players are not ordered in the correct way then the player will not have     the required tiles to make the move.   -}   restoreGame :: Game -> NE.NonEmpty Move -> Either ScrabbleError (NE.NonEmpty GameTransition)   restoreGame game = T.sequence . restoreGameLazy game-  +   {- |     Maps each move to a resulting game transition, if the move is legal. Has the same semantics as 'restoreGame'     but returns a list of 'Either' so that laziness can be maintained, meaning all the game transitions-    dont have to be buffered before they can be consumed.  +    dont have to be buffered before they can be consumed.   -}   restoreGameLazy :: Game -> NE.NonEmpty Move -> NE.NonEmpty (Either ScrabbleError GameTransition)-  restoreGameLazy game (mv NE.:| moves) = NE.scanl nextMove (makeMove game mv) moves +  restoreGameLazy game (mv NE.:| moves) = NE.scanl nextMove (makeMove game mv) moves     where       nextMove transition move = transition >>= \success -> makeMove (newGame success) move @@ -137,13 +137,13 @@   newGame (MoveTransition _ game _) = game   newGame (ExchangeTransition game _ _) = game   newGame (PassTransition game) = game-  newGame (GameFinished game _ _) = game+  newGame (GameFinished game _) = game    addMoveToHistory :: GameTransition -> Move -> GameTransition   addMoveToHistory (MoveTransition player game formedWords) move = MoveTransition player (updateHistory game move) formedWords   addMoveToHistory (ExchangeTransition game oldPlayer newPlayer ) move = ExchangeTransition (updateHistory game move) oldPlayer newPlayer   addMoveToHistory (PassTransition game) move = PassTransition (updateHistory game move)-  addMoveToHistory (GameFinished game wordsFormed allPlayers) move = GameFinished (updateHistory game move) wordsFormed allPlayers+  addMoveToHistory (GameFinished game wordsFormed) move = GameFinished (updateHistory game move) wordsFormed    finaliseGame :: Game -> Game   finaliseGame game@@ -159,8 +159,8 @@         optionals = optionalPlayers game >>= (\(player3, maybePlayer4) ->             Just (finalisePlayer player3, finalisePlayer <$> maybePlayer4 ) ) -        finalisePlayer player = if hasEmptyRack player then increaseScore player unplayedValues-          else reduceScore player (tileValues player) +        finalisePlayer player = if hasEmptyRack player then giveEndWinBonus player unplayedValues+          else giveEndLosePenalty player (tileValues player)    updatePlayerRackAndBag :: Player -> LetterBag -> Int -> (Player, LetterBag)   updatePlayerRackAndBag player letterBag numPlayed@@ -176,14 +176,14 @@     where       newBoardIfUnoccupied brd pos tile = note (PlacedTileOnOccupiedSquare pos tile) $ placeTile brd tile pos -  +   removeLettersandGiveScore :: Player -> [Tile] -> Int -> Either ScrabbleError Player-  removeLettersandGiveScore player playedTiles justScored = -    let newPlayer = flip increaseScore justScored <$> removePlayedTiles player playedTiles +  removeLettersandGiveScore player playedTiles justScored =+    let newPlayer = flip increaseScore justScored <$> removePlayedTiles player playedTiles     in note (PlayerCannotPlace (rack player) playedTiles) newPlayer    scoresIfWordsLegal :: Dictionary -> FormedWords -> Either ScrabbleError (Int, [(String, Int)])-  scoresIfWordsLegal dict formedWords = +  scoresIfWordsLegal dict formedWords =     let strings = wordStrings formedWords     in case invalidWords dict strings of       []-> Right $ wordsWithScores formedWords

@@ -7,12 +7,14 @@   tilesOnRack,   score,   increaseScore,+  reduceScore,+  giveEndLosePenalty,+  giveEndWinBonus,   giveTiles,   removePlayedTiles,   removeTiles,   hasEmptyRack,   tileValues,-  reduceScore,   exchange) where    import Wordify.Rules.Tile@@ -27,13 +29,14 @@    data Player = Player {name :: Name                        , rack :: LetterRack-                       , score :: Score } deriving (Show, Eq)+                       , score :: Score+                       , endBonus :: Int} deriving (Show, Eq)    makePlayer :: String -> Player-  makePlayer playerName = Player playerName (LetterRack []) 0+  makePlayer playerName = Player playerName (LetterRack []) 0 0    tilesOnRack :: Player -> [Tile]-  tilesOnRack (Player _ (LetterRack letters) _) = letters+  tilesOnRack (Player _ (LetterRack letters) _ _) = letters    increaseScore :: Player -> Int -> Player   increaseScore player justScored = player {score = currentScore + justScored}@@ -45,6 +48,12 @@     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 @@ -63,7 +72,7 @@   {- |     Removes played tiles from the player's tile rack, if it was possible for the player     to play those tiles in the first place. A player may play a tile on his rack, unless-    it is a blank, which must first be assigned a letter. +    it is a blank, which must first be assigned a letter.   -}   removePlayedTiles :: Player -> [Tile] -> Maybe Player   removePlayedTiles player tiles =@@ -86,20 +95,20 @@       isInvalid (tile, freq) =        case tile of         -- Tried to play a blank without a letter-        Blank Nothing -> False +        Blank Nothing -> False         -- Player doesn't have tiles         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 = +  exchange player exchanged received =     if not (playerCanExchange player exchanged) then Nothing-      else +      else         Just $ giveTiles (removeTiles player exchanged) received    playerCanExchange :: Player -> [Tile] -> Bool-  playerCanExchange (Player _ ( LetterRack letterRack) _ ) exchanged = isNothing $ find cannotExchange exchangedList-+  playerCanExchange (Player _ ( LetterRack letterRack) _ _) exchanged =+     isNothing $ find cannotExchange exchangedList     where       (exchangedFrequencies, rackFrequencies) = tileFrequencies exchanged letterRack       exchangedList = Map.toList exchangedFrequencies@@ -107,7 +116,7 @@       cannotExchange (tile, freq) =        case tile of         -- Tried to exchange a blank letter which has been labeled. Client error.-        Blank (Just _) -> False +        Blank (Just _) -> False         -- Player doesn't have tiles         Blank _ -> freq > Map.findWithDefault 0 (Blank Nothing) rackFrequencies         Letter chr val -> freq > Map.findWithDefault 0 (Letter chr val) rackFrequencies