wordify 0.3.0.1 → 0.4.0.0

raw patch · 7 files changed

+250/−4 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• src/Wordify/Rules/Extra/ExtraRule.hs +45/−0
• src/Wordify/Rules/Extra/SpanishExtraRule.hs +42/−0
• src/Wordify/Rules/Game.hs +1/−1
• test/Tests/Internationalisation/Spanish/LetterBagTest.hs +0/−1
• test/Tests/Internationalisation/SpanishExtraRuleTest.hs +151/−0
• test/Tests/Regressions.hs +7/−1
• wordify.cabal +4/−1

@@ -0,0 +1,45 @@+module Wordify.Rules.Extra.ExtraRule (+    ExtraRule,+    makeExtraRule,+    applyExtraRule,+    applyExtraRules,+    RuleExecutionError(RuleExecutionError),+    RuleApplicationResult(RuleApplicationResult),+    RuleApplicationsResult(RuleApplicationsResult),+    finalTransition,+    bonusesApplied,+    transition,+    bonusApplied+    ) where+    +    import Control.Monad (foldM)+    import Wordify.Rules.Move (GameTransition)+    import Data.Maybe(Maybe(Just, Nothing))++    data RuleExecutionError = RuleExecutionError {errorCode :: String, description :: String }+    data BonusApplied = BonusApplied {bonusName :: String, value :: Int }+    data RuleApplicationResult = RuleApplicationResult {transition :: GameTransition, bonusApplied :: Maybe BonusApplied }+    data RuleApplicationsResult = RuleApplicationsResult {finalTransition :: GameTransition, bonusesApplied :: [BonusApplied] }++    instance Show RuleExecutionError where+        show (RuleExecutionError _ description) = description++    newtype ExtraRule = ExtraRule+        {rule :: GameTransition -> Either RuleExecutionError RuleApplicationResult}++    makeExtraRule :: (GameTransition -> Either RuleExecutionError RuleApplicationResult) -> ExtraRule+    makeExtraRule = ExtraRule++    applyExtraRules :: GameTransition -> [ExtraRule] -> Either RuleExecutionError RuleApplicationsResult+    applyExtraRules gameTransition extraRules = applyRules (RuleApplicationsResult gameTransition []) extraRules++    applyRules :: RuleApplicationsResult -> [ExtraRule] -> Either RuleExecutionError RuleApplicationsResult+    applyRules ruleApplicationResult [] = Right ruleApplicationResult+    applyRules (RuleApplicationsResult transition bonuses) (rule: rules) = do+        RuleApplicationResult newGameTransition bonusApplied <- applyExtraRule transition rule+        case bonusApplied of+            Just bonus -> applyRules (RuleApplicationsResult newGameTransition (bonus : bonuses)) rules+            Nothing -> applyRules (RuleApplicationsResult newGameTransition bonuses) rules++    applyExtraRule :: GameTransition -> ExtraRule -> Either RuleExecutionError RuleApplicationResult+    applyExtraRule gameTransition (ExtraRule ruleFn) = ruleFn gameTransition

@@ -0,0 +1,42 @@+module Wordify.Rules.Extra.SpanishExtraRule (spanishGameExtraRules) where+    import Wordify.Rules.Extra.ExtraRule (ExtraRule, RuleExecutionError (RuleExecutionError), makeExtraRule, RuleApplicationResult(RuleApplicationResult))+    import qualified Data.Text as T+    import Wordify.Rules.Game (Game)+    import Wordify.Rules.Move (Move (Pass, PlaceTiles , Exchange), GameTransition (MoveTransition))+    import Wordify.Rules.FormedWord (FormedWords, FormedWord, allWords)+    import Wordify.Rules.Square (tileIfOccupied)+    import Data.Foldable (Foldable(toList))+    import Wordify.Rules.Tile (tileString, Tile)+    import Data.List (isInfixOf)+    import Control.Error (mapMaybe)+    +    spanishGameExtraRules :: [ExtraRule]+    spanishGameExtraRules = [+            makeDisallowedConsecutiveLettersRule "L" "L",+            makeDisallowedConsecutiveLettersRule "R" "R",+            makeDisallowedConsecutiveLettersRule "C" "H"+        ]++    makeDisallowedConsecutiveLettersRule :: String -> String -> ExtraRule+    makeDisallowedConsecutiveLettersRule firstTile secondTile = makeExtraRule $ \gameTransition ->+        case gameTransition of+            MoveTransition game players formedWords -> validateDoesNotResultInConsecutiveLetters gameTransition formedWords firstTile secondTile+            other -> Right (RuleApplicationResult other Nothing)++    validateDoesNotResultInConsecutiveLetters :: GameTransition -> FormedWords -> String -> String -> Either RuleExecutionError RuleApplicationResult+    validateDoesNotResultInConsecutiveLetters gameTransition formedWords firstTile secondTile+        | any (containsConsecutiveTiles firstTile secondTile) allFormedWords = Left (RuleExecutionError "InvalidConsecutiveTiles" ruleDescription)+        | otherwise = Right (RuleApplicationResult gameTransition Nothing)+        where+            allFormedWords = allWords formedWords+            ruleDescription = concat ["Cannot place ", firstTile, " and ", secondTile, " consecutively"]++    containsConsecutiveTiles :: String -> String -> FormedWord -> Bool+    containsConsecutiveTiles firstTile secondTile formedWord =+        let tiles = mapMaybe (tileIfOccupied . snd) (toList formedWord)+        in containsConsecutive firstTile secondTile tiles++    containsConsecutive :: String -> String -> [Tile] -> Bool+    containsConsecutive firstTile secondTile tiles = [firstTile, secondTile] `isInfixOf` tileLetters tiles+        where+            tileLetters tiles = mapMaybe tileString tiles

@@ -32,7 +32,7 @@   import Control.Monad   import Control.Applicative   import qualified Data.List.Safe as LS-+     {- |     Starts a new game.  

@@ -68,4 +68,3 @@           assertEqual "Expect no letters to left in the bag" (bagSize newBag) 0           let actualTileQuantities = M.toList (countLetters tiles)           assertEqual "Expected the tiles" expectedTileQuantities actualTileQuantities-

@@ -0,0 +1,151 @@++module Tests.Internationalisation.SpanishExtraRuleTest where+    import qualified System.FilePath as F+    import Wordify.Rules.ScrabbleError (ScrabbleError)+    import Wordify.Rules.Dictionary (Dictionary, makeDictionary)+    import Wordify.Rules.LetterBag (LetterBag, bagFromTiles)+    import Wordify.Rules.Tile (Tile(..))+    import Wordify.Rules.Game (Game, makeGame)+    import Wordify.Rules.Player (makePlayer)+    import Test.HUnit (Assertion, assertBool, assertEqual, Assertable)+    import Test.HUnit.Base (assertFailure)+    import Wordify.Rules.Move (GameTransition(..), Move (..), makeMove, newGame)+    import qualified Data.Map as M+    import Wordify.Rules.Pos (rightPositions, starPos, abovePositions, right, belowPositions, above, below)+    import Wordify.Rules.Extra.SpanishExtraRule (spanishGameExtraRules)+    import Wordify.Rules.Extra.ExtraRule (applyExtraRules, RuleExecutionError (..))+    import Control.Error (isLeft)+    import Control.Error.Util (isRight)+    import Data.Either (fromRight)+    import Wordify.Rules.Extra.ExtraRule (RuleApplicationResult(..), RuleApplicationsResult(..))+    import Data.Maybe (fromJust)+    import qualified Control.Arrow as A++    testSpanishDictionary :: IO (Either ScrabbleError Dictionary)+    testSpanishDictionary = makeDictionary $ "Config" ++ [F.pathSeparator] ++ "spanishSet" ++ [F.pathSeparator] ++ "dictionary.txt"++    testSpanishLetterBag :: IO LetterBag+    testSpanishLetterBag = bagFromTiles tiles+        where+            tiles = [Letter "CH" 5, Letter "U" 1,Letter "C" 3,Letter "U" 1,Letter "H" 4,Letter "A" 1,Letter "A" 1,Letter "E" 1,Letter "D" 2,+                    Letter "C" 3,Letter "E" 1,Letter "I" 1,Letter "A" 1,Letter "E" 1,Letter "C" 3,Letter "N" 1,+                    Letter "E" 1,Letter "A" 1,Letter "D" 2,Letter "D" 2,Letter "RR" 8,Letter "D" 2,Letter "N" 1,+                    Letter "P" 3,Letter "T" 1,Letter "O" 1,Letter "A" 1,Letter "S" 1,Letter "D" 2,Letter "S" 1,+                    Letter "E" 1,Letter "R" 1,Letter "I" 1,Letter "I" 1,Letter "A" 1,Letter "N" 1,Letter "A" 1,+                    Letter "T" 1,Letter "Ñ" 8,Letter "E" 1,Letter "S" 1,Letter "O" 1,Letter "T" 1,Letter "L" 1,+                    Letter "O" 1,Letter "LL" 8,Letter "I" 1,Letter "N" 1,Letter "S" 1,Letter "P" 3,Letter "E" 1,+                    Letter "B" 3,Letter "B" 3,Letter "E" 1,Letter "A" 1,Letter "A" 1,Letter "C" 3,Letter "Z" 10,Letter "E" 1,+                    Letter "U" 1,Letter "E" 1,Letter "E" 1,Letter "R" 1,Letter "M" 3,Letter "O" 1,Letter "L" 1,Letter "U" 1,+                    Letter "R" 1,Letter "S" 1,Letter "A" 1,Letter "I" 1,Letter "I" 1,+                    Letter "L" 1,Letter "G" 2,Letter "O" 1,Letter "A" 1,Letter "R" 1,Letter "T" 1,Letter "J" 8,+                    Letter "O" 1,Letter "F" 4,Blank Nothing,Letter "Y" 4,Letter "N" 1,Letter "L" 1,Letter "O" 1,+                    Letter "X" 8,Letter "E" 1,Letter "O" 1,Letter "R" 1,Letter "M" 3,Letter "S" 1,Letter "G" 2,Letter "U" 1,+                    Letter "H" 4,Letter "V" 4,Letter "A" 1,Letter "Q" 5,Letter "O" 1,Blank Nothing]++    testGame :: IO (Either ScrabbleError Game)+    testGame = do+        letterBag <- testSpanishLetterBag+        dictionaryResult <- testSpanishDictionary++        case dictionaryResult of+            Left err -> return $ Left err+            Right dict -> pure $ setupGame letterBag dict++        where+            setupGame :: LetterBag -> Dictionary -> Either ScrabbleError Game+            setupGame bag dict = makeGame (player1, player2, Nothing) bag dict+                where+                    player1 = makePlayer "player 1"+                    player2 = makePlayer "player 2"++    testCannotPlayCandHOnOwn :: Assertion+    testCannotPlayCandHOnOwn = do+        gameResult <- testGame+        case gameResult of+            Left err -> assertFailure $ "Failed to set up game: " ++ show err+            Right game -> do+                let positions = rightPositions starPos 4+                let tiles = [Letter "C" 3, Letter "H" 4, Letter "A" 1]+                let moveMap = M.fromList $ zip positions tiles+                let move = PlaceTiles moveMap+                let result = makeMove game move++                case result of+                    Left err -> assertFailure $ "Initial game transition failed before applying extra rules: " ++ show err+                    Right moveTransition@MoveTransition {} -> do+                        let result = applyExtraRules moveTransition spanishGameExtraRules+                        assertBool "Expected rule to fail " (isLeft result)++                        case result of+                            Left (RuleExecutionError code description) -> do+                                assertEqual "Expected InvalidConsecutiveTiles as error code" "InvalidConsecutiveTiles" code+                                assertEqual "Expected correct error description" "Cannot place C and H consecutively" description+                            otherwise -> return ()++                    Right _ -> assertFailure "Unexpected move transition type"++    testCanPlayCHtile :: Assertion+    testCanPlayCHtile = do+        gameResult <- testGame+        case gameResult of+            Left err -> assertFailure $ "Failed to set up game: " ++ show err+            Right game -> do+                let positions = rightPositions starPos 4+                let tiles = [Letter "CH" 5, Letter "A" 1]+                let moveMap = M.fromList $ zip positions tiles+                let move = PlaceTiles moveMap++                let playerTwoMovePositions = reverse (drop 1 (fromJust (flip belowPositions 4 <$> right starPos)))+                let playerTwoMoveLetters = [Letter "C" 3, Letter "A" 1, Letter "D" 2]+                let moveMap = M.fromList $ zip playerTwoMovePositions playerTwoMoveLetters+                let move2 = PlaceTiles moveMap++                let result = makeMove game move+                case result of+                    Left err -> assertFailure $ "Initial game transition failed before applying extra rules: " ++ show err+                    Right moveTransition@MoveTransition {} -> do+                        let result = applyExtraRules moveTransition spanishGameExtraRules+                        assertBool "Expected rule to pass validation " (isRight result)+                        let Right (RuleApplicationsResult gameTransition _) = result+                        let secondMove = makeMove (newGame gameTransition) move2++                        case secondMove of+                            Left err -> assertFailure $ "Expected second move success. Error was " ++ show err+                            Right _ -> do+                                let result2 = applyExtraRules moveTransition spanishGameExtraRules+                                assertBool "Expected rule to pass validation " (isRight result2)++                    Right _ -> assertFailure "Unexpected move transition type"++    testCannotPlayCNextToExistingH :: Assertion+    testCannotPlayCNextToExistingH = do+        gameResult <- testGame+        case gameResult of+            Left err -> assertFailure $ "Failed to set up game: " ++ show err+            Right game -> do+                let positions = rightPositions starPos 2+                let tiles = [Letter "H" 4, Letter "A" 1]+                let moveMap = M.fromList $ zip positions tiles+                let move = PlaceTiles moveMap+                let result = A.left show (makeMove game move)++                let validated = result >>= A.left show <$> flip applyExtraRules spanishGameExtraRules+                assertBool "Should pass extra rule in first move" (isRight validated)++                let positionsMove2 = [above starPos, below starPos]+                let placedLettersMove2 = [Letter "C" 3, Letter "A" 1]+                let moveMap2 = M.fromList $ zip positionsMove2 placedLettersMove2+                let move2 = PlaceTiles moveMap+                let result2 = A.left show (makeMove game move2)++                assertBool "Move should succeed prior to extra rule" (isRight result2)++                let validated = result2 >>= A.left show <$> flip applyExtraRules spanishGameExtraRules+                assertBool "Should not pass extra validation on second move" (isRight validated)++                case validated of +                    Left description -> assertEqual "Description should be as expected" "Cannot place C and H consecutively" description+                    Right _ -> return ()+++

@@ -12,6 +12,7 @@ import Tests.LetterBagTest import Tests.MoveTest import Tests.Internationalisation.Spanish.MoveTest (playSpanishMoveTest)+import Tests.Internationalisation.SpanishExtraRuleTest (testCannotPlayCandHOnOwn, testCanPlayCHtile, testCannotPlayCNextToExistingH)  tests :: F.Test tests =@@ -85,5 +86,10 @@         "Internationalisation LetterBag"         [ F.testCase "Can construct a spanish letter bag" makeSpanishBagTestSuccess,           F.testCase "Can play a move in a game setup with a spanish dictionary and letter bag" playSpanishMoveTest-        ]+        ],+      F.testGroup "Extra Rules Tests (Spanish)" [+        F.testCase "Cannot play C and H tiles from a hand on their own" testCannotPlayCandHOnOwn,+        F.testCase  "Test can play CH tile" testCanPlayCHtile,+        F.testCase "Cannot play C next to existing H" testCannotPlayCNextToExistingH+      ]     ]

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           wordify-version:        0.3.0.1+version:        0.4.0.0 description:    Please see the README on GitHub at <https://github.com/githubuser/wordify#readme> category:       Game homepage:       https://github.com/happy0/wordify#readme@@ -30,6 +30,8 @@       Wordify.Rules.Board       Wordify.Rules.Board.Internal       Wordify.Rules.Dictionary+      Wordify.Rules.Extra.ExtraRule+      Wordify.Rules.Extra.SpanishExtraRule       Wordify.Rules.FormedWord       Wordify.Rules.Game       Wordify.Rules.Game.Internal@@ -102,6 +104,7 @@       Tests.Instances       Tests.Internationalisation.Spanish.LetterBagTest       Tests.Internationalisation.Spanish.MoveTest+      Tests.Internationalisation.SpanishExtraRuleTest       Tests.LetterBagTest       Tests.MoveTest       Tests.PosTest