wordify 0.1.0.1 → 0.1.1.0

raw patch · 3 files changed

+286/−196 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• src/Wordify/Rules/Board.hs +196/−137
• src/Wordify/Rules/Pos.hs +89/−58
• wordify.cabal +1/−1

@@ -1,160 +1,219 @@-module Wordify.Rules.Board(Board,-                           emptyBoard,-                           allSquares,-                           placeTile,-                           occupiedSquareAt,-                           emptySquaresFrom,-                           lettersAbove,-                           lettersBelow,-                           lettersLeft,-                           lettersRight,-                           unoccupiedSquareAt,-                           prettyPrint) where+module Wordify.Rules.Board+  ( Board,+    emptyBoard,+    allSquares,+    placeTile,+    placeTiles,+    occupiedSquareAt,+    emptySquaresFrom,+    lettersAbove,+    lettersBelow,+    lettersLeft,+    lettersRight,+    unoccupiedSquareAt,+    textRepresentation,+    loadFromTextRepresentation,+    prettyPrint,+  )+where -  import Wordify.Rules.Square-  import Wordify.Rules.Pos-  import Data.Maybe-  import Wordify.Rules.Tile-  import qualified Data.Map as Map-  import Control.Monad-  import Data.Sequence as Seq-  import Wordify.Rules.Board.Internal-  import Control.Applicative-  import Data.List.Split as S-  import qualified Data.List as L-  import Data.Foldable as F+import Control.Applicative+import Control.Monad+import Data.Foldable as F+import qualified Data.List as L+import Data.List.Split as S+import qualified Data.Map as M+import qualified Data.Map as Map+import Data.Maybe+import Data.Sequence as Seq+import qualified Data.Text as T+import Wordify.Rules.Board.Internal+import Wordify.Rules.Pos+import Wordify.Rules.Square+import Wordify.Rules.Tile -  instance Show Board where-    show = prettyPrint+instance Show Board where+  show = prettyPrint -  {- |-    Returns all the squares on the board, ordered by column then row.-  -}-  allSquares :: Board -> [(Pos, Square)]-  allSquares (Board squares) = Map.toList squares+-- |+--    Returns all the squares on the board, ordered by column then row.+allSquares :: Board -> [(Pos, Square)]+allSquares (Board squares) = Map.toList squares -  {- |-    Places a tile on a square and yields the new board, if the-    target square is empty. Otherwise yields 'Nothing'.-  -}-  placeTile :: Board -> Tile -> Pos -> Maybe Board-  placeTile board tile pos =-    (\sq -> insertSquare board pos (putTileOn sq tile)) <$> unoccupiedSquareAt board pos+-- |+--    Places a tile on a square and yields the new board, if the+--    target square is empty. Otherwise yields 'Nothing'.+placeTile :: Board -> Tile -> Pos -> Maybe Board+placeTile board tile pos =+  (\sq -> insertSquare board pos (putTileOn sq tile)) <$> unoccupiedSquareAt board pos -  insertSquare :: Board -> Pos -> Square -> Board-  insertSquare (Board squares) pos square = Board $ Map.insert pos square squares+-- |+--    Places tiles on the given squares and yields the new board, if+--    all the target squares are empty. Otherwise yields 'Nothing'.+placeTiles :: Board -> [(Tile, Pos)] -> Maybe Board+placeTiles board = foldl tryPlaceTile (Just board)+  where+    tryPlaceTile :: Maybe Board -> (Tile, Pos) -> Maybe Board+    tryPlaceTile Nothing (tile, pos) = Nothing+    tryPlaceTile (Just board) (tile, pos) = placeTile board tile pos -  squareAt :: Board -> Pos -> Maybe Square-  squareAt (Board squares)  = flip Map.lookup squares+insertSquare :: Board -> Pos -> Square -> Board+insertSquare (Board squares) pos square = Board $ Map.insert pos square squares -  {- | Returns the square at a given position if it is not occupied by a tile. Otherwise returns Nothing.-}-  unoccupiedSquareAt :: Board -> Pos -> Maybe Square-  unoccupiedSquareAt board pos =-    squareAt board pos >>= (\sq -> if isOccupied sq then Nothing else Just sq)+squareAt :: Board -> Pos -> Maybe Square+squareAt (Board squares) = flip Map.lookup squares -  {- | Returns the square at a given position if it is occupied by a tile. Otherwise returns Nothing.-}-  occupiedSquareAt :: Board -> Pos -> Maybe Square-  occupiedSquareAt board pos = squareAt board pos >>= squareIfOccupied+-- | Returns the square at a given position if it is not occupied by a tile. Otherwise returns Nothing.+unoccupiedSquareAt :: Board -> Pos -> Maybe Square+unoccupiedSquareAt board pos =+  squareAt board pos >>= (\sq -> if isOccupied sq then Nothing else Just sq) -  {- | All letters immediately above a given square until a non-occupied square -}-  lettersAbove :: Board -> Pos -> Seq (Pos,Square)-  lettersAbove board pos = walkFrom board pos above+-- | Returns the square at a given position if it is occupied by a tile. Otherwise returns Nothing.+occupiedSquareAt :: Board -> Pos -> Maybe Square+occupiedSquareAt board pos = squareAt board pos >>= squareIfOccupied -  {- | All letters immediately below a given square until a non-occupied square -}-  lettersBelow :: Board -> Pos -> Seq (Pos,Square)-  lettersBelow board pos = Seq.reverse $ walkFrom board pos below+-- | All letters immediately above a given square until a non-occupied square+lettersAbove :: Board -> Pos -> Seq (Pos, Square)+lettersAbove board pos = walkFrom board pos above -  {- | All letters immediately left of a given square until a non-occupied square -}-  lettersLeft :: Board -> Pos -> Seq (Pos,Square)-  lettersLeft board pos = Seq.reverse $ walkFrom board pos left+-- | All letters immediately below a given square until a non-occupied square+lettersBelow :: Board -> Pos -> Seq (Pos, Square)+lettersBelow board pos = Seq.reverse $ walkFrom board pos below -  {- | All letters immediately right of a given square until a non-occupied square -}-  lettersRight :: Board -> Pos -> Seq (Pos,Square)-  lettersRight board pos = walkFrom board pos right+-- | All letters immediately left of a given square until a non-occupied square+lettersLeft :: Board -> Pos -> Seq (Pos, Square)+lettersLeft board pos = Seq.reverse $ walkFrom board pos left -  {- | Finds the empty square positions horizontally or vertically from a given position,-       skipping any squares that are occupied by a tile-  -}-  emptySquaresFrom :: Board -> Pos -> Int -> Direction -> [Pos]-  emptySquaresFrom board startPos numSquares direction =-    let changingOnwards = [changing .. 15]-    in  L.take numSquares $-            L.filter (isJust . unoccupiedSquareAt board) $-                 mapMaybe posAt $ zipDirection (repeat constant) changingOnwards-    where-        (constant, changing) = if direction == Horizontal then (yPos startPos, xPos startPos) else (xPos startPos, yPos startPos)-        zipDirection = if (direction == Horizontal) then flip L.zip else L.zip+-- | All letters immediately right of a given square until a non-occupied square+lettersRight :: Board -> Pos -> Seq (Pos, Square)+lettersRight board pos = walkFrom board pos right +-- | Finds the empty square positions horizontally or vertically from a given position,+--       skipping any squares that are occupied by a tile+emptySquaresFrom :: Board -> Pos -> Int -> Direction -> [Pos]+emptySquaresFrom board startPos numSquares direction =+  let changingOnwards = [changing .. 15]+   in L.take numSquares $+        L.filter (isJust . unoccupiedSquareAt board) $+          mapMaybe posAt $ zipDirection (repeat constant) changingOnwards+  where+    (constant, changing) = if direction == Horizontal then (yPos startPos, xPos startPos) else (xPos startPos, yPos startPos)+    zipDirection = if (direction == Horizontal) then flip L.zip else L.zip -  {- | Pretty prints a board to a human readable string representation. Helpful for development. -}-  prettyPrint :: Board -> String-  prettyPrint board = rowsWithLabels ++ columnLabelSeparator ++ columnLabels-    where-      rows = L.transpose . S.chunksOf 15 . map (squareToString . snd) . allSquares-      rowsWithLabels = concatMap (\(rowNo, row) -> (rowStr rowNo) ++ concat row ++ "\n") . Prelude.zip [1 .. ] $ (rows board)+-- | Pretty prints a board to a human readable string representation. Helpful for development.+prettyPrint :: Board -> String+prettyPrint board = rowsWithLabels ++ columnLabelSeparator ++ columnLabels+  where+    rows = L.transpose . S.chunksOf 15 . map (squareToString . snd) . allSquares+    rowsWithLabels = concatMap (\(rowNo, row) -> (rowStr rowNo) ++ concat row ++ "\n") . Prelude.zip [1 ..] $ (rows board) -      rowStr :: Int -> String-      rowStr number = if number < 10 then ((show number) ++ " | ") else (show number) ++ "| "-      columnLabelSeparator = "  " ++ (Prelude.take (15 * 5) $ repeat '-') ++ "\n"-      columnLabels = "      " ++ (concat $ Prelude.take (15 * 2) . L.intersperse "    " . map ( : []) $ ['A' .. ])+    rowStr :: Int -> String+    rowStr number = if number < 10 then ((show number) ++ " | ") else (show number) ++ "| "+    columnLabelSeparator = "  " ++ (Prelude.take (15 * 5) $ repeat '-') ++ "\n"+    columnLabels = "      " ++ (concat $ Prelude.take (15 * 2) . L.intersperse "    " . map (: []) $ ['A' ..]) -      squareToString square =-        case (tileIfOccupied square) of-          Just sq -> maybe " |_| " (\lt -> " |" ++ lt : "| ") $ tileLetter sq-          Nothing ->-            case square of-              (Normal _) -> "  N  "-              (DoubleLetter _) -> "  DL "-              (TripleLetter _) -> "  TL "-              (DoubleWord _) -> "  DW "-              (TripleWord _) -> "  TW "+    squareToString square =+      case (tileIfOccupied square) of+        Just sq -> maybe " |_| " (\lt -> " |" ++ lt : "| ") $ tileLetter sq+        Nothing ->+          case square of+            (Normal _) -> "  N  "+            (DoubleLetter _) -> "  DL "+            (TripleLetter _) -> "  TL "+            (DoubleWord _) -> "  DW "+            (TripleWord _) -> "  TW " -  {--    Walks the tiles from a given position in a given direction-    until an empty square is found or the boundary of the board-    is reached.-  -}-  walkFrom :: Board -> Pos -> (Pos -> Maybe Pos) -> Seq (Pos,Square)-  walkFrom board pos direction = maybe mzero (\(next,sq) ->-   (next, sq) <| walkFrom board next direction) neighbourPos-    where-      neighbourPos = direction pos >>= \nextPos -> occupiedSquareAt board nextPos >>=-        \sq -> return (nextPos, sq)+{-+  Walks the tiles from a given position in a given direction+  until an empty square is found or the boundary of the board+  is reached.+-}+walkFrom :: Board -> Pos -> (Pos -> Maybe Pos) -> Seq (Pos, Square)+walkFrom board pos direction =+  maybe+    mzero+    ( \(next, sq) ->+        (next, sq) <| walkFrom board next direction+    )+    neighbourPos+  where+    neighbourPos =+      direction pos >>= \nextPos ->+        occupiedSquareAt board nextPos+          >>= \sq -> return (nextPos, sq) -  {- |-    Creates an empty board.-  -}-  emptyBoard :: Board-  emptyBoard = Board (Map.fromList posSquares)-    where-      layout =-        [["TW","N","N","DL","N","N","N","TW","N","N","N","DL","N","N","TW"]-       ,["N","DW","N","N","N","TL","N","N","N","TL","N","N","N","DW","N"]-       ,["N","N","DW","N","N","N","DL","N","DL","N","N","N","DW","N","N"]-       ,["DL","N","N","DW","N","N","N","DL","N","N","N","DW","N","N","DL"]-       ,["N","N","N","N","DW","N","N","N","N","N","DW","N","N","N","N"]-       ,["N","TL","N","N","N","TL","N","N","N","TL","N","N","N","TL","N"]-       ,["N","N","DL","N","N","N","DL","N","DL","N","N","N","DL","N","N"]-       ,["TW","N","N","DL","N","N","N","DW","N","N","N","DL","N","N","TW"]-       ,["N","N","DL","N","N","N","DL","N","DL","N","N","N","DL","N","N"]-       ,["N","TL","N","N","N","TL","N","N","N","TL","N","N","N","TL","N"]-       ,["N","N","N","N","DW","N","N","N","N","N","DW","N","N","N","N"]-       ,["DL","N","N","DW","N","N","N","DL","N","N","N","DW","N","N","DL"]-       ,["N","N","DW","N","N","N","DL","N","DL","N","N","N","DW","N","N"]-       ,["N","DW","N","N","N","TL","N","N","N","TL","N","N","N","DW","N"]-       ,["TW","N","N","DL","N","N","N","TW","N","N","N","DL","N","N","TW"]]+{-+  Represents the board as a comma delimited string where each character is either the character in the board square+  or an empty string. The string is ordered by column then row, starting at position A1 and ending at O15. -      squares = (map . map) toSquare layout-      columns = Prelude.zip [1..15] squares-      labeledSquares= concatMap (uncurry columnToMapping) columns-      columnToMapping columnNo columnSquares = Prelude.zipWith (\sq y -> ((columnNo,y),sq)) columnSquares [1..15]-      posSquares = mapMaybe (\((x,y), sq) -> fmap (\pos -> (pos, sq)) (posAt (x,y))) labeledSquares+  E.g. an empty board would be representated as 244 contiguous , characters. A -      toSquare :: String -> Square-      toSquare "DL" = DoubleLetter Nothing-      toSquare "TL" = TripleLetter Nothing-      toSquare "DW" = DoubleWord Nothing-      toSquare "TW" = TripleWord Nothing-      toSquare _ = Normal Nothing+  A board with the tile 'H' at position H8 and 'I' at position H9 would look like this:+  ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,H,I,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,+-}+textRepresentation :: Board -> String+textRepresentation board = L.intercalate "," (squareStrings board)+  where+    squareStrings :: Board -> [String]+    squareStrings board = map getLetterRepresentation (allSquares board) +    getLetterRepresentation :: (Pos, Square) -> String+    getLetterRepresentation square = toLetterRepresentation ((tileIfOccupied . snd) square >>= tileLetter) +    toLetterRepresentation :: Maybe Char -> String+    toLetterRepresentation (Just char) = [char]+    toLetterRepresentation Nothing = ""++{-+  Loads a board from the string representation of the board generated by the 'textPresentation' function+-}+loadFromTextRepresentation :: M.Map Char Tile -> String -> Maybe Board+loadFromTextRepresentation validTiles textRepresentation =+  let positionsWithLetters = L.zip [0 ..] (S.splitOn "," textRepresentation)+   in let placements = mapMaybe (uncurry positionWithLetter) positionsWithLetters+       in placeTiles emptyBoard placements+  where+    positionWithLetter :: Int -> [Char] -> Maybe (Tile, Pos)+    positionWithLetter oneDimensionalCoordinate [] = Nothing +    positionWithLetter oneDimensionalCoordinate (letter: []) = do+      tile <- M.lookup letter validTiles+      let x = (oneDimensionalCoordinate  `div` 15) + 1+      let y = (oneDimensionalCoordinate `mod` 15) + 1+      coordinate <- posAt (x, y)+      return (tile, coordinate)++-- |+--    Creates an empty board.+emptyBoard :: Board+emptyBoard = Board (Map.fromList posSquares)+  where+    layout =+      [ ["TW", "N", "N", "DL", "N", "N", "N", "TW", "N", "N", "N", "DL", "N", "N", "TW"],+        ["N", "DW", "N", "N", "N", "TL", "N", "N", "N", "TL", "N", "N", "N", "DW", "N"],+        ["N", "N", "DW", "N", "N", "N", "DL", "N", "DL", "N", "N", "N", "DW", "N", "N"],+        ["DL", "N", "N", "DW", "N", "N", "N", "DL", "N", "N", "N", "DW", "N", "N", "DL"],+        ["N", "N", "N", "N", "DW", "N", "N", "N", "N", "N", "DW", "N", "N", "N", "N"],+        ["N", "TL", "N", "N", "N", "TL", "N", "N", "N", "TL", "N", "N", "N", "TL", "N"],+        ["N", "N", "DL", "N", "N", "N", "DL", "N", "DL", "N", "N", "N", "DL", "N", "N"],+        ["TW", "N", "N", "DL", "N", "N", "N", "DW", "N", "N", "N", "DL", "N", "N", "TW"],+        ["N", "N", "DL", "N", "N", "N", "DL", "N", "DL", "N", "N", "N", "DL", "N", "N"],+        ["N", "TL", "N", "N", "N", "TL", "N", "N", "N", "TL", "N", "N", "N", "TL", "N"],+        ["N", "N", "N", "N", "DW", "N", "N", "N", "N", "N", "DW", "N", "N", "N", "N"],+        ["DL", "N", "N", "DW", "N", "N", "N", "DL", "N", "N", "N", "DW", "N", "N", "DL"],+        ["N", "N", "DW", "N", "N", "N", "DL", "N", "DL", "N", "N", "N", "DW", "N", "N"],+        ["N", "DW", "N", "N", "N", "TL", "N", "N", "N", "TL", "N", "N", "N", "DW", "N"],+        ["TW", "N", "N", "DL", "N", "N", "N", "TW", "N", "N", "N", "DL", "N", "N", "TW"]+      ]++    squares = (map . map) toSquare layout+    columns = Prelude.zip [1 .. 15] squares+    labeledSquares = concatMap (uncurry columnToMapping) columns+    columnToMapping columnNo columnSquares = Prelude.zipWith (\sq y -> ((columnNo, y), sq)) columnSquares [1 .. 15]+    posSquares = mapMaybe (\((x, y), sq) -> fmap (\pos -> (pos, sq)) (posAt (x, y))) labeledSquares++    toSquare :: String -> Square+    toSquare "DL" = DoubleLetter Nothing+    toSquare "TL" = TripleLetter Nothing+    toSquare "DW" = DoubleWord Nothing+    toSquare "TW" = TripleWord Nothing+    toSquare _ = Normal Nothing

@@ -1,74 +1,105 @@+module Wordify.Rules.Pos+  ( Pos,+    Direction (Horizontal, Vertical),+    posAt,+    above,+    below,+    left,+    right,+    abovePositions,+    belowPositions,+    leftPositions,+    rightPositions,+    xPos,+    yPos,+    gridValue,+    direction,+    starPos,+    posMin,+    posMax,+  )+where -module Wordify.Rules.Pos (Pos,-                          Direction(Horizontal, Vertical),-                          posAt,-                          above,-                          below,-                          left,-                          right,-                          xPos,-                          yPos,-                          gridValue,-                          direction,-                          starPos,-                          posMin,-                          posMax) where+import qualified Data.Map as Map+import Data.Maybe+import Wordify.Rules.Pos.Internal -  import qualified Data.Map as Map-  import Wordify.Rules.Pos.Internal-  import Data.Maybe+data Direction = Horizontal | Vertical deriving (Eq) -  data Direction = Horizontal | Vertical deriving Eq+posMin :: Int+posMin = 1 -  posMin :: Int-  posMin = 1+posMax :: Int+posMax = 15 -  posMax :: Int-  posMax = 15+posAt :: (Int, Int) -> Maybe Pos+posAt = flip Map.lookup posMap -  posAt :: (Int, Int) -> Maybe Pos-  posAt = flip Map.lookup posMap+-- | The position above the given position, if it exists.+above :: Pos -> Maybe Pos+above (Pos x y _) = posAt (x, y + 1) -  -- | The position above the given position, if it exists.-  above :: Pos -> Maybe Pos-  above (Pos x y _) = posAt (x,y + 1)+-- | The position below the given position, if it exists.+below :: Pos -> Maybe Pos+below (Pos x y _) = posAt (x, y - 1) -  -- | The position below the given position, if it exists.-  below :: Pos -> Maybe Pos-  below (Pos x y _) = posAt (x, y - 1 )+-- | The position to the left of the given position, if it exists.+left :: Pos -> Maybe Pos+left (Pos x y _) = posAt (x - 1, y) -  -- | The position to the left of the given position, if it exists.-  left :: Pos -> Maybe Pos-  left (Pos x y _) = posAt (x - 1, y)+-- | The position to the right of the given position, if it exists.+right :: Pos -> Maybe Pos+right (Pos x y _) = posAt (x + 1, y) -  -- | The position to the right of the given position, if it exists.-  right :: Pos -> Maybe Pos-  right (Pos x y _) = posAt (x + 1, y)+-- | The positions above the position (inclusive)+abovePositions :: Pos -> Int -> [Pos]+abovePositions pos = walkTimes pos above -  -- | The position of the star square-  starPos :: Pos-  starPos = Pos 8 8 "H8"+-- | The positions below the position (inclusive)+belowPositions :: Pos -> Int -> [Pos]+belowPositions pos = walkTimes pos below -  direction :: Pos -> Pos -> Maybe Direction-  direction startPos endPos-    | xPos startPos == xPos endPos = Just Vertical-    | yPos startPos == yPos endPos = Just Horizontal-    | otherwise = Nothing+-- | The positions to the right of the position (inclusive)+rightPositions :: Pos -> Int -> [Pos]+rightPositions pos = walkTimes pos right -  {- A map keyed by tuples representing (x,y) co-ordinates, and valued by their-  corresponding Pos types -}-  posMap :: Map.Map (Int, Int) Pos-  posMap = Map.fromList $ catMaybes coordTuples-      where-          coordTuples = zipWith makeTuple (sequence [[posMin..posMax], [posMin..posMax]]) $ cycle ['A'..'O']-          makeTuple (x:y:_) gridLetter = Just $ ((y,x) , Pos y x (gridLetter : show x) )-          makeTuple _ _ = Nothing+-- | The positions to the left of the position (inclusive)+leftPositions :: Pos -> Int -> [Pos]+leftPositions pos = walkTimes pos left -  xPos :: Pos -> Int-  xPos (Pos x _ _) = x+walkTimes :: Pos -> (Pos -> Maybe Pos) -> Int -> [Pos]+walkTimes startPosition travelFunction = flip take (walkDirection startPosition travelFunction) -  yPos :: Pos -> Int-  yPos (Pos _ y _) = y+walkDirection :: Pos -> (Pos -> Maybe Pos) -> [Pos]+walkDirection startPosition travelFunction =+  case travelFunction startPosition of+    Nothing -> [startPosition]+    Just nextPosition -> startPosition : walkDirection nextPosition travelFunction -  gridValue :: Pos -> String-  gridValue (Pos _ _ grid) = grid+-- | The position of the star square+starPos :: Pos+starPos = Pos 8 8 "H8"++direction :: Pos -> Pos -> Maybe Direction+direction startPos endPos+  | xPos startPos == xPos endPos = Just Vertical+  | yPos startPos == yPos endPos = Just Horizontal+  | otherwise = Nothing++{- A map keyed by tuples representing (x,y) co-ordinates, and valued by their+corresponding Pos types -}+posMap :: Map.Map (Int, Int) Pos+posMap = Map.fromList $ catMaybes coordTuples+  where+    coordTuples = zipWith makeTuple (sequence [[posMin .. posMax], [posMin .. posMax]]) $ cycle ['A' .. 'O']+    makeTuple (x : y : _) gridLetter = Just $ ((y, x), Pos y x (gridLetter : show x))+    makeTuple _ _ = Nothing++xPos :: Pos -> Int+xPos (Pos x _ _) = x++yPos :: Pos -> Int+yPos (Pos _ y _) = y++gridValue :: Pos -> String+gridValue (Pos _ _ grid) = grid

@@ -7,7 +7,7 @@ -- hash: f28111054d235bc18dc5e0d167dd433a32a9e0c4e9627cc10c02822b5b2ac44e  name:           wordify-version:        0.1.0.1+version:        0.1.1.0 description:    Please see the README on GitHub at <https://github.com/githubuser/wordify#readme> category:       Game homepage:       https://github.com/happy0/wordify#readme