diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,13 @@ #### Upcoming +#### v0.3.1.3 + +*Revisions* + +* Fixed a bug where Werewolves could devour other Werewolves. ([#34](https://github.com/hjwylde/werewolf/issues/34)) +* Changed Werewolf text from "kill" to "devour". ([#34](https://github.com/hjwylde/werewolf/issues/34)) + #### v0.3.1.2 *Revisions* @@ -21,6 +28,13 @@ * Added a message to say the names of all the players at the start of a game. ([#23](https://github.com/hjwylde/werewolf/issues/23)) * Added a message to say the roles in play at the start of a game. ([#16](https://github.com/hjwylde/werewolf/issues/16)) + +#### v0.3.0.5 + +*Revisions* + +* Fixed a bug where Werewolves could devour other Werewolves. ([#34](https://github.com/hjwylde/werewolf/issues/34)) +* Changed Werewolf text from "kill" to "devour". ([#34](https://github.com/hjwylde/werewolf/issues/34)) #### v0.3.0.4 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -14,8 +14,8 @@ It is now time to take control and eliminate this ancient evil, before the town loses its last few inhabitants. Objective of the Game: -For the Villagers: kill all of the Werewolves. -For the Werewolves: kill all of the Villagers. +For the Villagers: lynch all of the Werewolves. +For the Werewolves: devour all of the Villagers. #### Roles @@ -76,11 +76,11 @@ {"ok":true,"messages":[ {"to":["@grault"],"message":"@qux is a Villager."}, {"to":null,"message":"The Werewolves wake up, recognise one another and choose a new victim."}, - {"to":["@bar","@corge"],"message":"Who would you like to kill?"} + {"to":["@bar","@corge"],"message":"Who would you like to devour?"} ]} ``` -Let's have _@bar_, a Werewolf, vote to kill a Villager. +Let's have _@bar_, a Werewolf, vote to devour a Villager. ```bash > werewolf --caller @bar vote @foo {"ok":true,"messages":[]} @@ -102,8 +102,8 @@ ```bash > werewolf --caller @corge vote @foo {"ok":true,"messages":[ - {"to":["@bar","@corge"],"message":"@bar voted to kill @foo."}, - {"to":["@bar","@corge"],"message":"@corge voted to kill @foo."}, + {"to":["@bar","@corge"],"message":"@bar voted to devour @foo."}, + {"to":["@bar","@corge"],"message":"@corge voted to devour @foo."}, {"to":null,"message":"The sun rises. Everybody wakes up and opens their eyes..."}, {"to":null,"message":"As you open them you notice a door broken down and @foo's guts spilling out over the cobblestones. From the look of their personal effects, you deduce they were a Villager."} ]} diff --git a/app/Werewolf/Commands/Help.hs b/app/Werewolf/Commands/Help.hs --- a/app/Werewolf/Commands/Help.hs +++ b/app/Werewolf/Commands/Help.hs @@ -82,7 +82,7 @@ T.unwords [ "- Vote against a player.", "A townsperson may vote at daytime to lynch someone", - "and a Werewolf may vote at nighttime to kill a Villager." + "and a Werewolf may vote at nighttime to devour a Villager." ] ]] @@ -103,8 +103,8 @@ ] ], [ "Objective of the Game:", - "For the Villagers: kill all of the Werewolves.", - "For the Werewolves: kill all of the Villagers." + "For the Villagers: lynch all of the Werewolves.", + "For the Werewolves: devour all of the Villagers." ]] rulesMessages :: [Text] diff --git a/app/Werewolf/Commands/Vote.hs b/app/Werewolf/Commands/Vote.hs --- a/app/Werewolf/Commands/Vote.hs +++ b/app/Werewolf/Commands/Vote.hs @@ -47,7 +47,7 @@ let command = (if isVillagersTurn game then lynchVoteCommand - else killVoteCommand + else devourVoteCommand ) callerName targetName case runExcept (runWriterT $ execStateT (apply command >> checkTurn >> checkGameOver) game) of diff --git a/src/Game/Werewolf/Command.hs b/src/Game/Werewolf/Command.hs --- a/src/Game/Werewolf/Command.hs +++ b/src/Game/Werewolf/Command.hs @@ -17,7 +17,7 @@ Command(..), -- ** Instances - killVoteCommand, lynchVoteCommand, noopCommand, quitCommand, seeCommand, + devourVoteCommand, lynchVoteCommand, noopCommand, quitCommand, seeCommand, ) where import Control.Lens hiding (only) @@ -37,22 +37,23 @@ data Command = Command { apply :: forall m . (MonadError [Message] m, MonadState Game m, MonadWriter [Message] m) => m () } -killVoteCommand :: Text -> Text -> Command -killVoteCommand callerName targetName = Command $ do - validateArguments callerName targetName - - unlessM isWerewolvesTurn $ throwError [playerCannotDoThatMessage callerName] +devourVoteCommand :: Text -> Text -> Command +devourVoteCommand callerName targetName = Command $ do + validatePlayer callerName callerName unlessM (isPlayerWerewolf callerName) $ throwError [playerCannotDoThatMessage callerName] + unlessM isWerewolvesTurn $ throwError [playerCannotDoThatRightNowMessage callerName] whenJustM (getPlayerVote callerName) . const $ throwError [playerHasAlreadyVotedMessage callerName] + validatePlayer callerName targetName + whenM (isPlayerWerewolf targetName) $ throwError [playerCannotDevourAnotherWerewolf callerName] votes %= Map.insert callerName targetName lynchVoteCommand :: Text -> Text -> Command lynchVoteCommand callerName targetName = Command $ do - validateArguments callerName targetName - - unlessM isVillagersTurn $ throwError [playerCannotDoThatMessage callerName] + validatePlayer callerName callerName + unlessM isVillagersTurn $ throwError [playerCannotDoThatRightNowMessage callerName] whenJustM (getPlayerVote callerName) . const $ throwError [playerHasAlreadyVotedMessage callerName] + validatePlayer callerName targetName votes %= Map.insert callerName targetName @@ -61,10 +62,7 @@ quitCommand :: Text -> Command quitCommand callerName = Command $ do - whenM isGameOver $ throwError [gameIsOverMessage callerName] - unlessM (doesPlayerExist callerName) $ throwError [playerDoesNotExistMessage callerName callerName] - - whenM (isPlayerDead callerName) $ throwError [playerIsDeadMessage callerName] + validatePlayer callerName callerName caller <- uses players $ findByName_ callerName @@ -76,19 +74,16 @@ seeCommand :: Text -> Text -> Command seeCommand callerName targetName = Command $ do - validateArguments callerName targetName - - unlessM isSeersTurn $ throwError [playerCannotDoThatMessage callerName] + validatePlayer callerName callerName unlessM (isPlayerSeer callerName) $ throwError [playerCannotDoThatMessage callerName] + unlessM isSeersTurn $ throwError [playerCannotDoThatRightNowMessage callerName] whenJustM (getPlayerSee callerName) . const $ throwError [playerHasAlreadySeenMessage callerName] + validatePlayer callerName targetName sees %= Map.insert callerName targetName -validateArguments :: (MonadError [Message] m, MonadState Game m) => Text -> Text -> m () -validateArguments callerName targetName = do - whenM isGameOver $ throwError [gameIsOverMessage callerName] - unlessM (doesPlayerExist callerName) $ throwError [playerDoesNotExistMessage callerName callerName] - unlessM (doesPlayerExist targetName) $ throwError [playerDoesNotExistMessage callerName targetName] - - whenM (isPlayerDead callerName) $ throwError [playerIsDeadMessage callerName] - whenM (isPlayerDead targetName) $ throwError [targetIsDeadMessage callerName targetName] +validatePlayer :: (MonadError [Message] m, MonadState Game m) => Text -> Text -> m () +validatePlayer callerName name = do + whenM isGameOver $ throwError [gameIsOverMessage callerName] + unlessM (doesPlayerExist name) $ throwError [playerDoesNotExistMessage callerName name] + whenM (isPlayerDead name) $ throwError [if callerName == name then playerIsDeadMessage callerName else targetIsDeadMessage callerName name] diff --git a/src/Game/Werewolf/Engine.hs b/src/Game/Werewolf/Engine.hs --- a/src/Game/Werewolf/Engine.hs +++ b/src/Game/Werewolf/Engine.hs @@ -105,18 +105,18 @@ votes' <- use votes when (length aliveWerewolves == Map.size votes') $ do - tell $ map (uncurry . playerMadeKillVoteMessage $ map _name aliveWerewolves) (Map.toList votes') + tell $ map (uncurry . playerMadeDevourVoteMessage $ map _name aliveWerewolves) (Map.toList votes') advanceTurn let mTargetName = only . last $ groupSortOn (length . flip elemIndices (Map.elems votes')) (nub $ Map.elems votes') case mTargetName of - Nothing -> tell [noPlayerKilledMessage] + Nothing -> tell [noPlayerDevouredMessage] Just targetName -> do target <- uses players (findByName_ targetName) killPlayer target - tell [playerKilledMessage (target ^. name) (target ^. role . Role.name)] + tell [playerDevouredMessage (target ^. name) (target ^. role . Role.name)] NoOne -> return () diff --git a/src/Game/Werewolf/Response.hs b/src/Game/Werewolf/Response.hs --- a/src/Game/Werewolf/Response.hs +++ b/src/Game/Werewolf/Response.hs @@ -27,16 +27,31 @@ Message(..), publicMessage, privateMessage, - -- ** Game messages - newGameMessages, nightFallsMessage, turnMessages, seersTurnMessages, villagersTurnMessage, - werewolvesTurnMessages, playerSeenMessage, playerMadeKillVoteMessage, playerKilledMessage, - noPlayerKilledMessage, playerMadeLynchVoteMessage, playerLynchedMessage, noPlayerLynchedMessage, - playerQuitMessage, gameOverMessage, + -- ** Generic messages + newGameMessages, turnMessages, nightFallsMessage, gameOverMessage, playerQuitMessage, - -- ** Error messages - roleDoesNotExistMessage, playerDoesNotExistMessage, playerCannotDoThatMessage, - playerCannotDoThatRightNowMessage, gameIsOverMessage, playerIsDeadMessage, - playerHasAlreadySeenMessage, playerHasAlreadyVotedMessage, targetIsDeadMessage, + -- ** Seers turn messages + seersTurnMessages, playerSeenMessage, + + -- ** Villagers turn messages + villagersTurnMessage, playerMadeLynchVoteMessage, playerLynchedMessage, noPlayerLynchedMessage, + + -- ** Werewolves turn messages + werewolvesTurnMessages, playerMadeDevourVoteMessage, playerDevouredMessage, + noPlayerDevouredMessage, + + -- ** Generic error messages + gameIsOverMessage, playerDoesNotExistMessage, playerCannotDoThatMessage, + playerCannotDoThatRightNowMessage, playerIsDeadMessage, roleDoesNotExistMessage, + + -- ** Seers turn error messages + playerHasAlreadySeenMessage, + + -- ** Voting turn error messages + playerHasAlreadyVotedMessage, targetIsDeadMessage, + + -- ** Werewolves turn error messages + playerCannotDevourAnotherWerewolf, ) where import Control.Lens @@ -139,42 +154,30 @@ | length (filterWerewolves players) <= 1 = "." | otherwise = T.concat [", along with ", T.intercalate "," (map _name $ filterWerewolves players \\ [player]), "."] -nightFallsMessage :: Message -nightFallsMessage = publicMessage "Night falls, the townsfolk are asleep." - turnMessages :: Turn -> [Player] -> [Message] turnMessages Seers players = seersTurnMessages $ filter isSeer players turnMessages Villagers _ = [villagersTurnMessage] turnMessages Werewolves players = werewolvesTurnMessages $ filter isWerewolf players turnMessages NoOne _ = [] -seersTurnMessages :: [Player] -> [Message] -seersTurnMessages seers = publicMessage "The Seers wake up.":privateMessage (map _name seers) "Who's allegiance would you like to see?":[] +nightFallsMessage :: Message +nightFallsMessage = publicMessage "Night falls, the townsfolk are asleep." -villagersTurnMessage :: Message -villagersTurnMessage = publicMessage "The sun rises. Everybody wakes up and opens their eyes..." +gameOverMessage :: Maybe Text -> Message +gameOverMessage Nothing = publicMessage "The game is over! Everyone died..." +gameOverMessage (Just allegiance) = publicMessage $ T.unwords ["The game is over! The", allegiance, "have won."] -werewolvesTurnMessages :: [Player] -> [Message] -werewolvesTurnMessages werewolves = [ - publicMessage "The Werewolves wake up, recognise one another and choose a new victim.", - privateMessage (map _name werewolves) "Who would you like to kill?" - ] +playerQuitMessage :: Player -> Message +playerQuitMessage player = publicMessage $ T.unwords [player ^. name, "the", player ^. role . Role.name, "has quit!"] +seersTurnMessages :: [Player] -> [Message] +seersTurnMessages seers = publicMessage "The Seers wake up.":privateMessage (map _name seers) "Who's allegiance would you like to see?":[] + playerSeenMessage :: Text -> Player -> Message playerSeenMessage seerName target = privateMessage [seerName] $ T.concat [target ^. name, " is aligned with the ", T.pack . show $ target ^. role . allegiance, "."] -playerMadeKillVoteMessage :: [Text] -> Text -> Text -> Message -playerMadeKillVoteMessage to voterName targetName = privateMessage to $ T.concat [voterName, " voted to kill ", targetName, "."] - -playerKilledMessage :: Text -> Text -> Message -playerKilledMessage name roleName = publicMessage $ T.concat [ - "As you open them you notice a door broken down and ", - name, "'s guts spilling out over the cobblestones.", - " From the look of their personal effects, you deduce they were a ", roleName, "." - ] - -noPlayerKilledMessage :: Message -noPlayerKilledMessage = publicMessage "Surprisingly you see everyone present at the town square. Perhaps the Werewolves have left Miller's Hollow?" +villagersTurnMessage :: Message +villagersTurnMessage = publicMessage "The sun rises. Everybody wakes up and opens their eyes..." playerMadeLynchVoteMessage :: Text -> Text -> Message playerMadeLynchVoteMessage voterName targetName = publicMessage $ T.concat [voterName, " voted to lynch ", targetName, "."] @@ -194,16 +197,28 @@ noPlayerLynchedMessage :: Message noPlayerLynchedMessage = publicMessage "Daylight is wasted as the townsfolk squabble over whom to tie up. Looks like no one is being burned this day." -playerQuitMessage :: Player -> Message -playerQuitMessage player = publicMessage $ T.unwords [player ^. name, "the", player ^. role . Role.name, "has quit!"] +werewolvesTurnMessages :: [Player] -> [Message] +werewolvesTurnMessages werewolves = [ + publicMessage "The Werewolves wake up, recognise one another and choose a new victim.", + privateMessage (map _name werewolves) "Who would you like to devour?" + ] -gameOverMessage :: Maybe Text -> Message -gameOverMessage Nothing = publicMessage "The game is over! Everyone died..." -gameOverMessage (Just allegiance) = publicMessage $ T.unwords ["The game is over! The", allegiance, "have won."] +playerMadeDevourVoteMessage :: [Text] -> Text -> Text -> Message +playerMadeDevourVoteMessage to voterName targetName = privateMessage to $ T.concat [voterName, " voted to devour ", targetName, "."] -roleDoesNotExistMessage :: Text -> Text -> Message -roleDoesNotExistMessage to name = privateMessage [to] $ T.unwords ["Role", name, "does not exist."] +playerDevouredMessage :: Text -> Text -> Message +playerDevouredMessage name roleName = publicMessage $ T.concat [ + "As you open them you notice a door broken down and ", + name, "'s guts half devoured and spilling out over the cobblestones.", + " From the look of their personal effects, you deduce they were a ", roleName, "." + ] +noPlayerDevouredMessage :: Message +noPlayerDevouredMessage = publicMessage "Surprisingly you see everyone present at the town square. Perhaps the Werewolves have left Miller's Hollow?" + +gameIsOverMessage :: Text -> Message +gameIsOverMessage name = privateMessage [name] "The game is over!" + playerDoesNotExistMessage :: Text -> Text -> Message playerDoesNotExistMessage to name = privateMessage [to] $ T.unwords ["Player", name, "does not exist."] @@ -213,12 +228,12 @@ playerCannotDoThatRightNowMessage :: Text -> Message playerCannotDoThatRightNowMessage name = privateMessage [name] "You cannot do that right now!" -gameIsOverMessage :: Text -> Message -gameIsOverMessage name = privateMessage [name] "The game is over!" - playerIsDeadMessage :: Text -> Message playerIsDeadMessage name = privateMessage [name] "Sshh, you're meant to be dead!" +roleDoesNotExistMessage :: Text -> Text -> Message +roleDoesNotExistMessage to name = privateMessage [to] $ T.unwords ["Role", name, "does not exist."] + playerHasAlreadySeenMessage :: Text -> Message playerHasAlreadySeenMessage name = privateMessage [name] "You've already seen!" @@ -227,3 +242,6 @@ targetIsDeadMessage :: Text -> Text -> Message targetIsDeadMessage name targetName = privateMessage [name] $ T.unwords [targetName, "is already dead!"] + +playerCannotDevourAnotherWerewolf :: Text -> Message +playerCannotDevourAnotherWerewolf name = privateMessage [name] "You cannot devour another Werewolf!" diff --git a/test/app/Main.hs b/test/app/Main.hs --- a/test/app/Main.hs +++ b/test/app/Main.hs @@ -28,15 +28,16 @@ allCommandTests :: [TestTree] allCommandTests = [ - testProperty "PROP: kill vote command errors when game is over" prop_killVoteCommandErrorsWhenGameIsOver, - testProperty "PROP: kill vote command errors when caller does not exist" prop_killVoteCommandErrorsWhenCallerDoesNotExist, - testProperty "PROP: kill vote command errors when target does not exist" prop_killVoteCommandErrorsWhenTargetDoesNotExist, - testProperty "PROP: kill vote command errors when caller is dead" prop_killVoteCommandErrorsWhenCallerIsDead, - testProperty "PROP: kill vote command errors when target is dead" prop_killVoteCommandErrorsWhenTargetIsDead, - testProperty "PROP: kill vote command errors when not werewolves turn" prop_killVoteCommandErrorsWhenNotWerewolvesTurn, - testProperty "PROP: kill vote command errors when caller not werewolf" prop_killVoteCommandErrorsWhenCallerNotWerewolf, - testProperty "PROP: kill vote command errors when caller has voted" prop_killVoteCommandErrorsWhenCallerHasVoted, - testProperty "PROP: kill vote command updates votes" prop_killVoteCommandUpdatesVotes, + testProperty "PROP: devour vote command errors when game is over" prop_devourVoteCommandErrorsWhenGameIsOver, + testProperty "PROP: devour vote command errors when caller does not exist" prop_devourVoteCommandErrorsWhenCallerDoesNotExist, + testProperty "PROP: devour vote command errors when target does not exist" prop_devourVoteCommandErrorsWhenTargetDoesNotExist, + testProperty "PROP: devour vote command errors when caller is dead" prop_devourVoteCommandErrorsWhenCallerIsDead, + testProperty "PROP: devour vote command errors when target is dead" prop_devourVoteCommandErrorsWhenTargetIsDead, + testProperty "PROP: devour vote command errors when not werewolves turn" prop_devourVoteCommandErrorsWhenNotWerewolvesTurn, + testProperty "PROP: devour vote command errors when caller not werewolf" prop_devourVoteCommandErrorsWhenCallerNotWerewolf, + testProperty "PROP: devour vote command errors when caller has voted" prop_devourVoteCommandErrorsWhenCallerHasVoted, + testProperty "PROP: devour vote command errors when target werewolf" prop_devourVoteCommandErrorsWhenTargetWerewolf, + testProperty "PROP: devour vote command updates votes" prop_devourVoteCommandUpdatesVotes, testProperty "PROP: lynch vote command errors when game is over" prop_lynchVoteCommandErrorsWhenGameIsOver, testProperty "PROP: lynch vote command errors when caller does not exist" prop_lynchVoteCommandErrorsWhenCallerDoesNotExist, @@ -51,7 +52,7 @@ testProperty "PROP: quit command errors when caller does not exist" prop_quitCommandErrorsWhenCallerDoesNotExist, testProperty "PROP: quit command errors when caller is dead" prop_quitCommandErrorsWhenCallerIsDead, testProperty "PROP: quit command kills player" prop_quitCommandKillsPlayer, - testProperty "PROP: quit command clears players kill vote" prop_quitCommandClearsPlayersKillVote, + testProperty "PROP: quit command clears players devour vote" prop_quitCommandClearsPlayersDevourVote, testProperty "PROP: quit command clears players lynch vote" prop_quitCommandClearsPlayersLynchVote, testProperty "PROP: quit command clears players see" prop_quitCommandClearsPlayersSee, diff --git a/test/src/Game/Werewolf/Test/Arbitrary.hs b/test/src/Game/Werewolf/Test/Arbitrary.hs --- a/test/src/Game/Werewolf/Test/Arbitrary.hs +++ b/test/src/Game/Werewolf/Test/Arbitrary.hs @@ -10,7 +10,7 @@ module Game.Werewolf.Test.Arbitrary ( -- * Contextual arbitraries - arbitraryCommand, arbitraryKillVoteCommand, arbitraryLynchVoteCommand, arbitraryQuitCommand, + arbitraryCommand, arbitraryDevourVoteCommand, arbitraryLynchVoteCommand, arbitraryQuitCommand, arbitrarySeeCommand, arbitraryNewGame, arbitraryPlayer, arbitrarySeer, arbitraryVillager, arbitraryWerewolf, @@ -44,17 +44,17 @@ arbitraryCommand game = case game ^. turn of Seers -> arbitrarySeeCommand game Villagers -> arbitraryLynchVoteCommand game - Werewolves -> arbitraryKillVoteCommand game + Werewolves -> arbitraryDevourVoteCommand game NoOne -> return noopCommand -arbitraryKillVoteCommand :: Game -> Gen Command -arbitraryKillVoteCommand game = do +arbitraryDevourVoteCommand :: Game -> Gen Command +arbitraryDevourVoteCommand game = do let applicableCallers = filter (flip Map.notMember (game ^. votes) . _name) (filterAlive . filterWerewolves $ game ^. players) - target <- arbitraryPlayer game + target <- suchThat (arbitraryPlayer game) $ not . isWerewolf if null applicableCallers then return noopCommand - else elements applicableCallers >>= \caller -> return $ killVoteCommand (caller ^. name) (target ^. name) + else elements applicableCallers >>= \caller -> return $ devourVoteCommand (caller ^. name) (target ^. name) arbitraryLynchVoteCommand :: Game -> Gen Command arbitraryLynchVoteCommand game = do diff --git a/test/src/Game/Werewolf/Test/Command.hs b/test/src/Game/Werewolf/Test/Command.hs --- a/test/src/Game/Werewolf/Test/Command.hs +++ b/test/src/Game/Werewolf/Test/Command.hs @@ -8,12 +8,14 @@ {-# OPTIONS_HADDOCK hide, prune #-} module Game.Werewolf.Test.Command ( - -- * killVoteCommand - prop_killVoteCommandErrorsWhenGameIsOver, prop_killVoteCommandErrorsWhenCallerDoesNotExist, - prop_killVoteCommandErrorsWhenTargetDoesNotExist, prop_killVoteCommandErrorsWhenCallerIsDead, - prop_killVoteCommandErrorsWhenTargetIsDead, prop_killVoteCommandErrorsWhenNotWerewolvesTurn, - prop_killVoteCommandErrorsWhenCallerNotWerewolf, prop_killVoteCommandErrorsWhenCallerHasVoted, - prop_killVoteCommandUpdatesVotes, + -- * devourVoteCommand + prop_devourVoteCommandErrorsWhenGameIsOver, prop_devourVoteCommandErrorsWhenCallerDoesNotExist, + prop_devourVoteCommandErrorsWhenTargetDoesNotExist, + prop_devourVoteCommandErrorsWhenCallerIsDead, prop_devourVoteCommandErrorsWhenTargetIsDead, + prop_devourVoteCommandErrorsWhenNotWerewolvesTurn, + prop_devourVoteCommandErrorsWhenCallerNotWerewolf, + prop_devourVoteCommandErrorsWhenCallerHasVoted, prop_devourVoteCommandErrorsWhenTargetWerewolf, + prop_devourVoteCommandUpdatesVotes, -- * lynchVoteCommand prop_lynchVoteCommandErrorsWhenGameIsOver, prop_lynchVoteCommandErrorsWhenCallerDoesNotExist, @@ -24,7 +26,7 @@ -- * quitCommand prop_quitCommandErrorsWhenGameIsOver, prop_quitCommandErrorsWhenCallerDoesNotExist, prop_quitCommandErrorsWhenCallerIsDead, prop_quitCommandKillsPlayer, - prop_quitCommandClearsPlayersKillVote, prop_quitCommandClearsPlayersLynchVote, + prop_quitCommandClearsPlayersDevourVote, prop_quitCommandClearsPlayersLynchVote, prop_quitCommandClearsPlayersSee, -- * seeCommand @@ -47,55 +49,65 @@ import Test.QuickCheck -prop_killVoteCommandErrorsWhenGameIsOver :: Game -> Property -prop_killVoteCommandErrorsWhenGameIsOver game = isGameOver game - ==> forAll (arbitraryKillVoteCommand game) $ verbose_runCommandErrors game +prop_devourVoteCommandErrorsWhenGameIsOver :: Game -> Property +prop_devourVoteCommandErrorsWhenGameIsOver game = + isGameOver game + ==> forAll (arbitraryDevourVoteCommand game) $ verbose_runCommandErrors game -prop_killVoteCommandErrorsWhenCallerDoesNotExist :: Game -> Player -> Property -prop_killVoteCommandErrorsWhenCallerDoesNotExist game caller = not (doesPlayerExist (caller ^. name) (game ^. players)) +prop_devourVoteCommandErrorsWhenCallerDoesNotExist :: Game -> Player -> Property +prop_devourVoteCommandErrorsWhenCallerDoesNotExist game caller = + not (doesPlayerExist (caller ^. name) (game ^. players)) ==> forAll (arbitraryPlayer game) $ \target -> - verbose_runCommandErrors game (killVoteCommand (caller ^. name) (target ^. name)) + verbose_runCommandErrors game (devourVoteCommand (caller ^. name) (target ^. name)) -prop_killVoteCommandErrorsWhenTargetDoesNotExist :: Game -> Player -> Property -prop_killVoteCommandErrorsWhenTargetDoesNotExist game target = not (doesPlayerExist (target ^. name) (game ^. players)) +prop_devourVoteCommandErrorsWhenTargetDoesNotExist :: Game -> Player -> Property +prop_devourVoteCommandErrorsWhenTargetDoesNotExist game target = + not (doesPlayerExist (target ^. name) (game ^. players)) ==> forAll (arbitraryWerewolf game) $ \caller -> - verbose_runCommandErrors game (killVoteCommand (caller ^. name) (target ^. name)) + verbose_runCommandErrors game (devourVoteCommand (caller ^. name) (target ^. name)) -prop_killVoteCommandErrorsWhenCallerIsDead :: Game -> Property -prop_killVoteCommandErrorsWhenCallerIsDead game = +prop_devourVoteCommandErrorsWhenCallerIsDead :: Game -> Property +prop_devourVoteCommandErrorsWhenCallerIsDead game = forAll (arbitraryWerewolf game) $ \caller -> forAll (arbitraryPlayer game) $ \target -> - verbose_runCommandErrors (killPlayer game caller) (killVoteCommand (caller ^. name) (target ^. name)) + verbose_runCommandErrors (killPlayer game caller) (devourVoteCommand (caller ^. name) (target ^. name)) -prop_killVoteCommandErrorsWhenTargetIsDead :: Game -> Property -prop_killVoteCommandErrorsWhenTargetIsDead game = +prop_devourVoteCommandErrorsWhenTargetIsDead :: Game -> Property +prop_devourVoteCommandErrorsWhenTargetIsDead game = forAll (arbitraryWerewolf game) $ \caller -> forAll (arbitraryPlayer game) $ \target -> - verbose_runCommandErrors (killPlayer game target) (killVoteCommand (caller ^. name) (target ^. name)) + verbose_runCommandErrors (killPlayer game target) (devourVoteCommand (caller ^. name) (target ^. name)) -prop_killVoteCommandErrorsWhenNotWerewolvesTurn :: Game -> Property -prop_killVoteCommandErrorsWhenNotWerewolvesTurn game = +prop_devourVoteCommandErrorsWhenNotWerewolvesTurn :: Game -> Property +prop_devourVoteCommandErrorsWhenNotWerewolvesTurn game = not (isWerewolvesTurn game) - ==> forAll (arbitraryKillVoteCommand game) $ verbose_runCommandErrors game + ==> forAll (arbitraryDevourVoteCommand game) $ verbose_runCommandErrors game -prop_killVoteCommandErrorsWhenCallerNotWerewolf :: Game -> Property -prop_killVoteCommandErrorsWhenCallerNotWerewolf game = +prop_devourVoteCommandErrorsWhenCallerNotWerewolf :: Game -> Property +prop_devourVoteCommandErrorsWhenCallerNotWerewolf game = forAll (arbitraryPlayer game) $ \caller -> not (isWerewolf caller) ==> forAll (arbitraryPlayer game) $ \target -> - verbose_runCommandErrors game (killVoteCommand (caller ^. name) (target ^. name)) + verbose_runCommandErrors game (devourVoteCommand (caller ^. name) (target ^. name)) -prop_killVoteCommandErrorsWhenCallerHasVoted :: Game -> Property -prop_killVoteCommandErrorsWhenCallerHasVoted game = +prop_devourVoteCommandErrorsWhenCallerHasVoted :: Game -> Property +prop_devourVoteCommandErrorsWhenCallerHasVoted game = isWerewolvesTurn game ==> forAll (arbitraryWerewolf game) $ \caller -> forAll (arbitraryPlayer game) $ \target -> - let command = killVoteCommand (caller ^. name) (target ^. name) + not (isWerewolf target) + ==> let command = devourVoteCommand (caller ^. name) (target ^. name) in verbose_runCommandErrors (run_ (apply command) game) command -prop_killVoteCommandUpdatesVotes :: Game -> Property -prop_killVoteCommandUpdatesVotes game = +prop_devourVoteCommandErrorsWhenTargetWerewolf :: Game -> Property +prop_devourVoteCommandErrorsWhenTargetWerewolf game = + forAll (arbitraryPlayer game) $ \target -> isWerewolf target + ==> forAll (arbitraryPlayer game) $ \caller -> + verbose_runCommandErrors game (devourVoteCommand (caller ^. name) (target ^. name)) + +prop_devourVoteCommandUpdatesVotes :: Game -> Property +prop_devourVoteCommandUpdatesVotes game = isWerewolvesTurn game - ==> forAll (arbitraryKillVoteCommand game) $ \command -> + ==> forAll (arbitraryDevourVoteCommand game) $ \command -> Map.size (run_ (apply command) game ^. votes) == 1 prop_lynchVoteCommandErrorsWhenGameIsOver :: Game -> Property @@ -167,11 +179,12 @@ ==> forAll (arbitraryQuitCommand game) $ \command -> length (filterDead $ run_ (apply command) game ^. players) == 1 -prop_quitCommandClearsPlayersKillVote :: Game -> Property -prop_quitCommandClearsPlayersKillVote game = +prop_quitCommandClearsPlayersDevourVote :: Game -> Property +prop_quitCommandClearsPlayersDevourVote game = forAll (arbitraryWerewolf game') $ \caller -> forAll (arbitraryPlayer game') $ \target -> - let game'' = run_ (apply $ killVoteCommand (caller ^. name) (target ^. name)) game' + not (isWerewolf target) + ==> let game'' = run_ (apply $ devourVoteCommand (caller ^. name) (target ^. name)) game' in Map.null $ run_ (apply $ quitCommand (caller ^. name)) game'' ^. votes where game' = game { _turn = Werewolves } diff --git a/werewolf.cabal b/werewolf.cabal --- a/werewolf.cabal +++ b/werewolf.cabal @@ -1,5 +1,5 @@ name: werewolf -version: 0.3.1.2 +version: 0.3.1.3 author: Henry J. Wylde maintainer: public@hjwylde.com