haskellscrabble 1.0 → 1.1

raw patch · 11 files changed

+189/−67 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• haskellscrabble.cabal +1/−1
• src/Wordify/Rules/Board.hs +12/−3
• src/Wordify/Rules/Dictionary.hs +6/−1
• src/Wordify/Rules/FormedWord.hs +91/−32
• src/Wordify/Rules/Game.hs +19/−6
• src/Wordify/Rules/LetterBag.hs +11/−11
• src/Wordify/Rules/Move.hs +7/−6
• src/Wordify/Rules/Player.hs +16/−2
• src/Wordify/Rules/Pos.hs +12/−1
• src/Wordify/Rules/Square.hs +3/−3
• src/Wordify/Rules/Tile.hs +11/−1

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                haskellscrabble-version:             1.0+version:             1.1 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

@@ -1,5 +1,14 @@-module Wordify.Rules.Board(Board, allSquares, emptyBoard, placeTile, occupiedSquareAt,- lettersAbove, lettersBelow, lettersLeft, lettersRight, unoccupiedSquareAt, prettyPrint) where+module Wordify.Rules.Board(Board,+                           emptyBoard,+                           allSquares,+                           placeTile,+                           occupiedSquareAt,+                           lettersAbove,+                           lettersBelow,+                           lettersLeft,+                           lettersRight,+                           unoccupiedSquareAt,+                           prettyPrint) where    import Wordify.Rules.Square   import Wordify.Rules.Pos@@ -61,7 +70,7 @@   lettersRight :: Board -> Pos -> Seq (Pos,Square)   lettersRight board pos = walkFrom board pos right -  {- | Pretty prints a board to a human readable string representation -}+  {- | Pretty prints a board to a human readable string representation. Helpful for development. -}   prettyPrint :: Board -> String   prettyPrint board = rowsWithLabels ++ columnLabelSeparator ++ columnLabels     where

@@ -1,4 +1,9 @@-module Wordify.Rules.Dictionary (Dictionary, isValidWord, makeDictionary, invalidWords, dictionaryFromWords) where+module Wordify.Rules.Dictionary (Dictionary,+                                 makeDictionary,+                                 dictionaryFromWords,+                                 isValidWord,+                                 invalidWords+                                 ) where    import qualified Data.HashSet as HashSet   import Wordify.Rules.ScrabbleError

@@ -1,16 +1,20 @@-module Wordify.Rules.FormedWord- (- FormedWords,- FormedWord,- wordsFormedMidGame,- wordFormedFirstMove,- wordStrings,- wordsWithScores,- mainWord,- adjacentWords,- playerPlaced,- bingoBonusApplied- ) where+module Wordify.Rules.FormedWord (FormedWords,+                                 FormedWord,+                                 PlacedSquares,+                                 allWords,+                                 mainWord,+                                 adjacentWords,+                                 playerPlaced,+                                 playerPlacedMap,+                                 scoreWord,+                                 overallScore,+                                 bingoBonusApplied,+                                 prettyPrintIntersections,+                                 makeString,+                                 wordStrings,+                                 wordsWithScores,+                                 wordsFormedMidGame,+                                 wordFormedFirstMove) where    import Wordify.Rules.Pos   import Wordify.Rules.Square@@ -23,17 +27,83 @@   import Control.Monad   import Data.Foldable as Foldable   import qualified Data.Maybe as M+  import qualified Data.List.Split as S+  import Data.Char    data FormedWords =  FirstWord FormedWord  | FormedWords {                                               main :: FormedWord                                               , otherWords :: [FormedWord]-                                              , placed :: Map Pos Square+                                              , placed :: PlacedSquares                                             } deriving (Show, Eq)                                      type FormedWord = Seq (Pos, Square)+  type PlacedSquares = Map Pos Square   data Direction = Horizontal | Vertical deriving Eq    {- |+    Pretty prints the places a given formed word intersects with letters that were already on the board+    using brackets. E.g. T(HI)S would denote that the player placed a 'T' and an 'S' on to the board, using+    the already placed word 'HI' to form the new word 'THIS'.+  -}+  prettyPrintIntersections :: PlacedSquares -> FormedWord -> String+  prettyPrintIntersections placed formedWord = denotePassThroughs placed $ Foldable.toList formedWord+    where+        denotePassThroughs :: PlacedSquares -> [(Pos, Square)] -> String+        denotePassThroughs placed formed =+          let breaks = brokenSquaresToChars $ S.split (splitter placed) formed+          in case breaks of+            (part:parts) -> part ++ (concat $ Prelude.zipWith (++) (cycle ["(",")"]) parts)+            [] -> ""++        squareToChar :: Square -> Char+        squareToChar sq = maybe '_' id $ tileIfOccupied sq >>= printLetter++        -- Splits whenever we encounter a series of squares that the player's word passes through+        -- on the board+        splitter :: PlacedSquares -> S.Splitter (Pos, Square)+        splitter placed = S.condense $ S.whenElt (flip (Map.notMember . fst) placed)++        brokenSquaresToChars :: [[(Pos, Square)]] -> [[Char]]+        brokenSquaresToChars brokenSquares = (Prelude.map . Prelude.map) (squareToChar . snd) brokenSquares++  {- |+    Scores an individual word. ++    Note: overallscore should be used to obtain the overall score as it takes into account any bingo bonuses.+    +  -}+  scoreWord :: PlacedSquares -> FormedWord -> Int+  scoreWord played formed = +    let (notAlreadyPlaced, onBoardAlready) = partitionPlaced played formed+    in scoreSquares onBoardAlready notAlreadyPlaced+      where+        partitionPlaced placed formed = (mapTuple . fmap) snd $ Seq.partition (\(pos, _) -> Map.member pos placed) formed++        mapTuple :: (a -> b) -> (a, a) -> (b, b)+        mapTuple f (a1, a2) = (f a1, f a2)++  {- |+    Calculates the overall score of the play.++    If a player managed to place all 7 of their letters, then they receive a bingo bonus of 50 points.+  -}+  overallScore :: FormedWords -> Int+  overallScore formedWords =+    let wordsScore = Prelude.sum $ Prelude.map (scoreWord placed) $ allWords formedWords+    in case (Prelude.length $ placed) of+      7 -> wordsScore + 50+      _ -> wordsScore+      where+        placed = playerPlacedMap formedWords++  {-|+    All the words formed by a play.+  -}+  allWords :: FormedWords -> [FormedWord]+  allWords (FormedWords main adjacentWords _) = main :  adjacentWords+  allWords (FirstWord firstWord) = [firstWord]++  {- |      Returns the word formed by the first move on the board. The word must cover      the star tile, and be linear. Any blank tiles must be labeled.    -}@@ -78,30 +148,19 @@   playerPlaced (FirstWord word) = Foldable.toList word   playerPlaced formed = Map.toList $ placed formed +  playerPlacedMap :: FormedWords -> Map Pos Square+  playerPlacedMap (FirstWord word) = Map.fromList $ Foldable.toList word+  playerPlacedMap formed = placed formed+   {- |     Scores the words formed by the tiles placed. The first item in the tuple is the overall     score, while the second item is the list of scores for all the words formed.   -}   wordsWithScores :: FormedWords -> (Int, [(String, Int)])-  wordsWithScores (FirstWord firstWord) = -      let score = scoreWord Seq.empty (fmap snd firstWord) -      in (bingoBonus score (Seq.length firstWord), [(makeString firstWord, score)])-  wordsWithScores (FormedWords mainW others played) =-	  (bingoBonus (Prelude.sum scores) (Map.size played), Prelude.zip strings scores)+  wordsWithScores formedWords = (overallScore formedWords, fmap wordAndScore allFormedWords)     where-      allWords = mainW : others-      strings = Prelude.map makeString allWords-      scores = Prelude.map (\formedWord -> let (notAlreadyPlaced, alreadyPlaced) = partitionPlaced formedWord -                                           in scoreWord (fmap snd alreadyPlaced) (fmap snd notAlreadyPlaced) ) allWords-      partitionPlaced = Seq.partition (\(pos, _) -> Map.member pos played)- --  {--    It is a rule in scrabble that if the player manages to place all 7 letters, they receive a bonus of '50'-    to their score.-  -}-  bingoBonus :: Int -> Int -> Int-  bingoBonus score playedLetters = if playedLetters < 7 then score else score + 50+      allFormedWords = allWords formedWords+      wordAndScore formedWord = (makeString formedWord, scoreWord (playerPlacedMap formedWords) formedWord)    {- |     Returns true if the player placed all 7 of their letters while forming these words, incurring a + 50 score bonus.

@@ -1,6 +1,22 @@-module Wordify.Rules.Game(Game, player1, player2, optionalPlayers, currentPlayer,- board, bag, dictionary, playerNumber, moveNumber, makeGame, getGameStatus,-  GameStatus(InProgress, Finished), gameStatus, players, passes, numberOfPlayers, history, History(History),movesMade) where+module Wordify.Rules.Game(Game,+                          makeGame,+                          movesMade,+                          gameStatus,+                          board,+                          bag,+                          dictionary,+                          moveNumber,+                          player1,+                          player2,+                          optionalPlayers,+                          currentPlayer,+                          playerNumber,+                          GameStatus(InProgress, Finished),+                          players,+                          passes,+                          numberOfPlayers,+                          history,+                          History(History)) where    import Wordify.Rules.Player   import Wordify.Rules.Board@@ -81,9 +97,6 @@    players :: Game -> [Player]   players game = [player1 game, player2 game] ++ optionalsToPlayers (optionalPlayers game)--  getGameStatus :: Game -> GameStatus-  getGameStatus = gameStatus    numberOfPlayers :: Game -> Int   numberOfPlayers game = 2 + maybe 0 (\(_, maybePlayer4) -> if isJust maybePlayer4 then 2 else 1) (optionalPlayers game)

@@ -1,14 +1,14 @@-module Wordify.Rules.LetterBag (- LetterBag,- makeBag,- takeLetters,- exchangeLetters,- shuffleBag, bagSize,- tiles,- bagFromTiles, - makeBagUsingGenerator, - getGenerator, - shuffleWithNewGenerator) where+module Wordify.Rules.LetterBag (LetterBag,+                                makeBag,+                                tiles,+                                bagFromTiles, +                                makeBagUsingGenerator,+                                takeLetters,+                                exchangeLetters,+                                shuffleBag,+                                shuffleWithNewGenerator,+                                bagSize,+                                getGenerator) where  import Wordify.Rules.Tile import System.Random

@@ -1,9 +1,10 @@-module Wordify.Rules.Move (makeMove -            ,Move(PlaceTiles, Exchange, Pass)-            ,GameTransition(MoveTransition, ExchangeTransition, PassTransition, GameFinished)-            ,restoreGame-            ,restoreGameLazy-            ,newGame) where+module Wordify.Rules.Move (+            Move(PlaceTiles, Exchange, Pass)+           ,GameTransition(MoveTransition, ExchangeTransition, PassTransition, GameFinished)+           ,makeMove+           ,newGame+           ,restoreGame+           ,restoreGameLazy) where    import Wordify.Rules.ScrabbleError   import Wordify.Rules.FormedWord

@@ -1,5 +1,19 @@-module Wordify.Rules.Player (Player, LetterRack, name, rack, score, makePlayer, increaseScore, giveTiles, tilesOnRack,- removePlayedTiles, removeTiles, hasEmptyRack, tileValues, reduceScore, exchange) where+module Wordify.Rules.Player (+  Player,+  LetterRack,+  makePlayer,+  name,+  rack,+  tilesOnRack,+  score,+  increaseScore,+  giveTiles,+  removePlayedTiles,+  removeTiles,+  hasEmptyRack,+  tileValues,+  reduceScore,+  exchange) where    import Wordify.Rules.Tile   import Data.List

@@ -1,5 +1,16 @@ -module Wordify.Rules.Pos (Pos, posAt, above, below, left, right, xPos, yPos, gridValue, starPos, posMin, posMax) where+module Wordify.Rules.Pos (Pos,+                          posAt,+                          above,+                          below,+                          left,+                          right,+                          xPos,+                          yPos,+                          gridValue,+                          starPos,+                          posMin,+                          posMax) where    import qualified Data.Map as Map   import Wordify.Rules.Pos.Internal

@@ -1,5 +1,5 @@ module Wordify.Rules.Square (Square(Normal, DoubleLetter, TripleLetter, DoubleWord, TripleWord),-     isOccupied, scoreWord, squareIfOccupied, putTileOn, tileIfOccupied) where+     isOccupied, scoreSquares, squareIfOccupied, putTileOn, tileIfOccupied) where    import Wordify.Rules.Tile   import Data.Sequence as Seq@@ -27,10 +27,10 @@      The second list contains squares that are newly occupied.   -}-  scoreWord :: Seq Square -> Seq Square -> Int+  scoreSquares :: Seq Square -> Seq Square -> Int   -- Calculate the base score then add the letter bonuses (doubleLetter, doubleWord),   -- then multiply by word bonuses (DoubleWord, TripleWord)-  scoreWord xs ys = addBonuses (addBonuses baseScore letterBonuses) wordBonuses+  scoreSquares xs ys = addBonuses (addBonuses baseScore letterBonuses) wordBonuses     where       calcBaseScore = F.foldr (\square acc -> baseValue square + acc) 0       addBonuses = F.foldr applyWordBonus

@@ -1,5 +1,7 @@-module Wordify.Rules.Tile (Tile(Letter, Blank), tileValue, isPlayable, tileLetter) where+module Wordify.Rules.Tile (Tile(Letter, Blank), tileValue, isPlayable, tileLetter, printLetter) where +import Data.Char+ {- | A tile is a letter with a value, or a Blank tile which may have been given a letter. Blank tiles@@ -15,6 +17,14 @@ tileLetter (Letter char _) = Just char tileLetter (Blank (Just char)) = Just char tileLetter (Blank Nothing) = Nothing++{- |+	Prints a letter in the style found on a scoresheet. E.g. blank letters are printed in lowercase.+-}+printLetter :: Tile -> Maybe Char+printLetter (Letter char _) = Just char+printLetter (Blank (Just char)) = Just $ toLower char+printLetter _ = Nothing  {- |   isPlayble, applied to a played tile and compared against a tile