diff --git a/haskellscrabble.cabal b/haskellscrabble.cabal --- a/haskellscrabble.cabal +++ b/haskellscrabble.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: haskellscrabble -version: 0.1.0.2 +version: 1.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 @@ -34,8 +34,8 @@ other-modules: Wordify.Rules.Game.Internal - build-depends: base < 4.8, containers, array, random, mtl, transformers, QuickCheck, - parsec, unordered-containers, semigroups, errors, safe, split + build-depends: base < 5, containers, array, random, mtl, transformers, QuickCheck, + parsec, unordered-containers, semigroups, errors < 2.0, safe, split, arrows hs-source-dirs: src test-suite tests @@ -45,7 +45,7 @@ build-depends: haskellscrabble, - base < 4.8, + base < 5, QuickCheck, HUnit, test-framework, diff --git a/src/Wordify/Rules/Dictionary.hs b/src/Wordify/Rules/Dictionary.hs --- a/src/Wordify/Rules/Dictionary.hs +++ b/src/Wordify/Rules/Dictionary.hs @@ -4,8 +4,10 @@ import Wordify.Rules.ScrabbleError import qualified Control.Exception as Exc import Text.ParserCombinators.Parsec + import Text.Parsec.Prim import Data.Char import Control.Monad + import Control.Arrow data Dictionary = Dictionary (HashSet.HashSet String) deriving Show @@ -23,38 +25,37 @@ isValidWord (Dictionary dictionaryWords) = flip HashSet.member dictionaryWords dictionaryFromWords :: [String] -> Dictionary - dictionaryFromWords wordList = Dictionary $ HashSet.fromList upperCaseWords - where - upperCaseWords = (map . map) toUpper wordList + dictionaryFromWords = Dictionary . HashSet.fromList . upperCaseWords {- | Creates a dictionary from a file containing a list of valid words, each word being seperated by a newline. -} makeDictionary :: FilePath -> IO (Either ScrabbleError Dictionary) - makeDictionary filePath = - do - fileContents <- Exc.try (readFile filePath) :: IO (Either Exc.IOException String) - case fileContents of - Left _ -> return $ Left (DictionaryFileNotFound filePath) - Right dictContents -> - let dictWords = parseFile dictContents - in case dictWords of - Left _ -> return $ Left (MalformedDictionaryFile filePath) - Right wordList -> return $ Right (Dictionary $ HashSet.fromList wordList) + makeDictionary filePath = join . fmap parseDictionary <$> readDictionaryFile filePath + readDictionaryFile :: FilePath -> IO (Either ScrabbleError String) + readDictionaryFile filePath = convertFileError <$> (Exc.try (readFile filePath) :: (IO (Either Exc.IOException String))) where - toUpperCase = (map . map) toUpper - parseFile contents = liftM toUpperCase $ parse dictionaryFile "Malformed dictionary file " contents + convertFileError = left (\_ -> DictionaryFileNotFound filePath) - dictionaryFile = - do - dictWords <- many word - _ <- eof - return dictWords + parseDictionary :: String -> Either ScrabbleError Dictionary + parseDictionary = either (Left . MalformedDictionaryFile . show) (Right . dictionaryFromWords) . parseFile + where + parseFile = parse dictionaryFile "" - word = - do - entry <- many letter - _ <- newline - return entry + dictionaryFile = + do + dictWords <- many word + _ <- eof + return dictWords + + word = + do + entry <- many letter :: Parser String + _ <- newline + return entry + + upperCaseWords :: [String] -> [String] + upperCaseWords = (map . map) toUpper + diff --git a/src/Wordify/Rules/FormedWord.hs b/src/Wordify/Rules/FormedWord.hs --- a/src/Wordify/Rules/FormedWord.hs +++ b/src/Wordify/Rules/FormedWord.hs @@ -38,11 +38,9 @@ the star tile, and be linear. Any blank tiles must be labeled. -} wordFormedFirstMove :: Board -> Map Pos Tile -> Either ScrabbleError FormedWords - wordFormedFirstMove board tiles = - if starPos `Map.notMember` tiles - then Left DoesNotCoverTheStarTile - else placedSquares board tiles >>= - \squares -> (FirstWord . main) <$> wordsFormed board squares + wordFormedFirstMove board tiles + | starPos `Map.notMember` tiles = Left DoesNotCoverTheStarTile + | otherwise = placedSquares board tiles >>= fmap (FirstWord . main) . wordsFormed board {- | Returns the words formed by the tiles played on the board. A played word @@ -122,7 +120,7 @@ makeString word = M.mapMaybe (\(_, sq) -> tileIfOccupied sq >>= tileLetter) $ Foldable.toList word {- - Checks that the tiles can be placed, and if so turns a map of the squares at the placed positions. + Checks that the tiles can be placed, and if so returns a map of the squares at the placed positions. A tile may be placed if the square is not already occupied, and if it is not an unlabeled blank tile. -} placedSquares :: Board -> Map Pos Tile -> Either ScrabbleError (Map Pos Square) @@ -166,7 +164,7 @@ middleFirstWord direction = case placedList of - x:[] -> Right (Seq.singleton x, minPos) + [x] -> Right (Seq.singleton x, minPos) (x:xs) -> foldM (\(word, lastPos) (pos, square) -> if not $ stillOnPath lastPos pos direction diff --git a/src/Wordify/Rules/LetterBag.hs b/src/Wordify/Rules/LetterBag.hs --- a/src/Wordify/Rules/LetterBag.hs +++ b/src/Wordify/Rules/LetterBag.hs @@ -24,6 +24,8 @@ import Control.Monad.ST import Data.STRef + + {- | Creates a letter bag from a file where each line contains a space delimited letter character, letter value, and letter distribution. A blank letter is represented by a '_' character and has a disribution, but no value. diff --git a/src/Wordify/Rules/Move.hs b/src/Wordify/Rules/Move.hs --- a/src/Wordify/Rules/Move.hs +++ b/src/Wordify/Rules/Move.hs @@ -50,7 +50,7 @@ gameTransition = case move of PlaceTiles placed -> makeBoardMove game placed Exchange exchanged -> exchangeMove game exchanged - Pass -> passMove game + Pass -> (Right . passMove) game makeBoardMove :: Game -> M.Map Pos Tile -> Either ScrabbleError GameTransition makeBoardMove game placed = @@ -86,7 +86,6 @@ PlaceTiles _ -> True _ -> False - exchangeMove :: Game -> [Tile] -> Either ScrabbleError GameTransition exchangeMove game exchangedTiles = let exchangeOutcome = exchangeLetters (bag game) exchangedTiles @@ -100,11 +99,10 @@ where player = currentPlayer game - passMove :: Game -> Either ScrabbleError GameTransition + passMove :: Game -> GameTransition passMove game = let gameState = pass game - in - Right $ + in if gameFinished then GameFinished (finaliseGame gameState) Nothing (players gameState) else PassTransition gameState diff --git a/src/Wordify/Rules/ScrabbleError.hs b/src/Wordify/Rules/ScrabbleError.hs --- a/src/Wordify/Rules/ScrabbleError.hs +++ b/src/Wordify/Rules/ScrabbleError.hs @@ -16,7 +16,7 @@ -- | The path given to a dictionary file was invalid. | DictionaryFileNotFound FilePath -- | The dictionary file could not be parsed as it was malformed. - | MalformedDictionaryFile FilePath + | MalformedDictionaryFile String -- | A letter bag with insufficient tiles was used to create a game. | NotEnoughLettersInStartingBag Int -- | The player has made an illegal tile placement. Tiles placed must form a line of tiles. @@ -45,7 +45,7 @@ instance Show ScrabbleError where - show (MalformedDictionaryFile path) = "Dictionary file " ++ path ++ " was malformed." + show (MalformedDictionaryFile reason) = "Dictionary file could not be parsed for the following reason: " ++ reason show (MalformedLetterBagFile path) = "Letter bag file " ++ path ++ " was malformed." show (DictionaryFileNotFound path) = "Dictionary file " ++ path ++ " was not found." show (LetterBagFileNotOpenable path) = "Letter bag file " ++ path ++ " was not openable"