diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,23 +2,12 @@ #### Upcoming -#### 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 - -*Revisions* - -* Fixed dead werewolves being informed of votes. ([#24](https://github.com/hjwylde/werewolf/issues/24)) +#### v0.3.1.0 -#### v0.3.0.3 +*Minor* -* Tidied up the help text to be smaller. ([#26](https://github.com/hjwylde/werewolf/issues/26)) -* Fixed a bug where the turn was advanced to Werewolves when no Werewolves were alive. ([#26](https://github.com/hjwylde/werewolf/issues/26)) +* 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.1 @@ -37,19 +26,6 @@ * Allowed `start` to work when the game has ended but `end` hasn't been called. ([#15](https://github.com/hjwylde/werewolf/issues/15)) * Added `quit` command. ([#13](https://github.com/hjwylde/werewolf/issues/13)) - -#### v0.2.0.2 - -*Revisions* - -* Fixed dead werewolves being informed of votes. ([#24](https://github.com/hjwylde/werewolf/issues/24)) - -#### v0.2.0.1 - -*Revisions* - -* Tidied up the help text to be smaller. ([#26](https://github.com/hjwylde/werewolf/issues/26)) -* Fixed a bug where the turn was advanced to Werewolves when no Werewolves were alive. ([#26](https://github.com/hjwylde/werewolf/issues/26)) #### v0.2.0.0 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: lynch all of the Werewolves. -For the Werewolves: devour all of the Villagers. +For the Villagers: kill all of the Werewolves. +For the Werewolves: kill 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 devour?"} + {"to":["@bar","@corge"],"message":"Who would you like to kill?"} ]} ``` -Let's have _@bar_, a Werewolf, vote to devour a Villager. +Let's have _@bar_, a Werewolf, vote to kill 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 devour @foo."}, - {"to":["@bar","@corge"],"message":"@corge voted to devour @foo."}, + {"to":["@bar","@corge"],"message":"@bar voted to kill @foo."}, + {"to":["@bar","@corge"],"message":"@corge voted to kill @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/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -14,8 +14,8 @@ main, handle, ) where -import Data.Text (Text) import qualified Data.Text as T +import Data.Text (Text) import Options.Applicative 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 @@ -60,34 +60,44 @@ } commandsMessages :: [Text] -commandsMessages = map T.unlines [[ - "End: end the current game", +commandsMessages = map (T.intercalate "\n") [[ + "Usage: COMMAND ARG ..." + ], [ + "Available commands:", + " end - end the current game", + " help - help documents", + " quit - quit the current game", + " see - see a player's allegiance", + " start - start a new game", + " vote - vote against a player" + ], [ + "End:", "Usage: end", - "- Ends the current game." + " Ends the current game." ], [ - "Quit: quit the current game", + "Quit:", "Usage: quit", - "- Quit the current game." + " Quit the current game." ], [ - "See: see a player's allegiance", + "See:", "Usage: see PLAYER", - "- See a player's allegiance. A Seer may determine a player's allegiance once per day." + " See a player's allegiance. A Seer may determine a player's allegiance once per day." ], [ - "Start: start a new game", - "Usage: start [--extra-roles ROLE,...] PLAYER ...", - "- Starts a new game with the given players and extra roles. A game requires at least 7 players." + "Start:", + "Usage: start PLAYER ...", + " Starts a new game with the given players. A game requires at least 7 players." ], [ - "Vote: vote against a player", + "Vote:", "Usage: vote PLAYER", T.unwords [ - "- Vote against a player.", + " Vote against a player.", "A townsperson may vote at daytime to lynch someone", - "and a Werewolf may vote at nighttime to devour a Villager." + "and a Werewolf may vote at nighttime to kill a Villager." ] ]] descriptionMessages :: [Text] -descriptionMessages = map T.unlines [[ +descriptionMessages = map (T.intercalate "\n") [[ T.unwords [ "Deep in the American countryside,", "the little town of Millers Hollow has recently been infiltrated by Werewolves." @@ -103,12 +113,12 @@ ] ], [ "Objective of the Game:", - "For the Villagers: lynch all of the Werewolves.", - "For the Werewolves: devour all of the Villagers." + "For the Villagers: kill all of the Werewolves.", + "For the Werewolves: kill all of the Villagers." ]] rulesMessages :: [Text] -rulesMessages = map T.unlines [[ +rulesMessages = map (T.intercalate "\n") [[ T.unwords [ "Each night, the Werewolves bite, kill and devour one Villager.", "During the day they try to conceal their identity and vile deeds from the Villagers.", @@ -137,7 +147,7 @@ ]] helpMessages :: [Text] -helpMessages = map T.unlines [[ +helpMessages = map (T.intercalate "\n") [[ "Usage: help COMMAND" ], [ "Available commands:", 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 devourVoteCommand + else killVoteCommand ) callerName targetName case runExcept (runWriterT $ execStateT (apply command >> checkTurn >> checkGameOver) game) of diff --git a/app/Werewolf/Options.hs b/app/Werewolf/Options.hs --- a/app/Werewolf/Options.hs +++ b/app/Werewolf/Options.hs @@ -19,10 +19,10 @@ werewolfPrefs, werewolfInfo, werewolf, ) where -import Data.List.Extra -import Data.Text (Text) -import qualified Data.Text as T -import Data.Version (showVersion) +import Data.List.Extra +import Data.Text (Text) +import qualified Data.Text as T +import Data.Version (showVersion) import qualified Werewolf.Commands.Help as Help import qualified Werewolf.Commands.Interpret as Interpret 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 - devourVoteCommand, lynchVoteCommand, noopCommand, quitCommand, seeCommand, + killVoteCommand, lynchVoteCommand, noopCommand, quitCommand, seeCommand, ) where import Control.Lens hiding (only) @@ -37,23 +37,22 @@ data Command = Command { apply :: forall m . (MonadError [Message] m, MonadState Game m, MonadWriter [Message] m) => m () } -devourVoteCommand :: Text -> Text -> Command -devourVoteCommand callerName targetName = Command $ do - validatePlayer callerName callerName +killVoteCommand :: Text -> Text -> Command +killVoteCommand callerName targetName = Command $ do + validateArguments callerName targetName + + unlessM isWerewolvesTurn $ throwError [playerCannotDoThatMessage 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 - validatePlayer callerName callerName - unlessM isVillagersTurn $ throwError [playerCannotDoThatRightNowMessage callerName] + validateArguments callerName targetName + + unlessM isVillagersTurn $ throwError [playerCannotDoThatMessage callerName] whenJustM (getPlayerVote callerName) . const $ throwError [playerHasAlreadyVotedMessage callerName] - validatePlayer callerName targetName votes %= Map.insert callerName targetName @@ -62,8 +61,11 @@ quitCommand :: Text -> Command quitCommand callerName = Command $ do - validatePlayer callerName callerName + whenM isGameOver $ throwError [gameIsOverMessage callerName] + unlessM (doesPlayerExist callerName) $ throwError [playerDoesNotExistMessage callerName callerName] + whenM (isPlayerDead callerName) $ throwError [playerIsDeadMessage callerName] + caller <- uses players $ findByName_ callerName killPlayer caller @@ -74,16 +76,19 @@ seeCommand :: Text -> Text -> Command seeCommand callerName targetName = Command $ do - validatePlayer callerName callerName + validateArguments callerName targetName + + unlessM isSeersTurn $ throwError [playerCannotDoThatMessage 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 -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] +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] 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 @@ -101,22 +101,23 @@ advanceTurn Werewolves -> do - aliveWerewolves <- uses players (filterAlive . filterWerewolves) + werewolvesCount <- uses players (length . filterAlive . filterWerewolves) votes' <- use votes - when (length aliveWerewolves == Map.size votes') $ do - tell $ map (uncurry . playerMadeDevourVoteMessage $ map _name aliveWerewolves) (Map.toList votes') + when (werewolvesCount == Map.size votes') $ do + werewolfNames <- uses players (map _name . filterWerewolves) + tell $ map (uncurry $ playerMadeKillVoteMessage werewolfNames) (Map.toList votes') advanceTurn let mTargetName = only . last $ groupSortOn (length . flip elemIndices (Map.elems votes')) (nub $ Map.elems votes') case mTargetName of - Nothing -> tell [noPlayerDevouredMessage] + Nothing -> tell [noPlayerKilledMessage] Just targetName -> do target <- uses players (findByName_ targetName) killPlayer target - tell [playerDevouredMessage (target ^. name) (target ^. role . Role.name)] + tell [playerKilledMessage (target ^. name) (target ^. role . Role.name)] NoOne -> return () @@ -129,9 +130,7 @@ turn' <- use turn alivePlayers <- uses players filterAlive - let nextTurn = if length (nub $ map (_allegiance . _role) alivePlayers) <= 1 - then NoOne - else head . drop1 $ filter (turnAvailable $ map _role alivePlayers) (dropWhile (turn' /=) turnRotation) + let nextTurn = head . drop1 $ filter (turnAvailable $ map _role alivePlayers) (dropWhile (turn' /=) turnRotation) tell $ turnMessages nextTurn alivePlayers diff --git a/src/Game/Werewolf/Game.hs b/src/Game/Werewolf/Game.hs --- a/src/Game/Werewolf/Game.hs +++ b/src/Game/Werewolf/Game.hs @@ -34,7 +34,7 @@ import Data.Text (Text) import Game.Werewolf.Player -import Game.Werewolf.Role hiding (Villagers, Werewolves) +import Game.Werewolf.Role hiding (Villagers, Werewolves) data Game = Game { _turn :: Turn 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,31 +27,16 @@ Message(..), publicMessage, privateMessage, - -- ** Generic messages - newGameMessages, turnMessages, nightFallsMessage, gameOverMessage, playerQuitMessage, - - -- ** 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, + -- ** Game messages + newGameMessages, nightFallsMessage, turnMessages, seersTurnMessages, villagersTurnMessage, + werewolvesTurnMessages, playerSeenMessage, playerMadeKillVoteMessage, playerKilledMessage, + noPlayerKilledMessage, playerMadeLynchVoteMessage, playerLynchedMessage, noPlayerLynchedMessage, + playerQuitMessage, gameOverMessage, - -- ** Werewolves turn error messages - playerCannotDevourAnotherWerewolf, + -- ** Error messages + roleDoesNotExistMessage, playerDoesNotExistMessage, playerCannotDoThatMessage, + playerCannotDoThatRightNowMessage, gameIsOverMessage, playerIsDeadMessage, + playerHasAlreadySeenMessage, playerHasAlreadyVotedMessage, targetIsDeadMessage, ) where import Control.Lens @@ -61,7 +46,7 @@ #if !MIN_VERSION_aeson(0,10,0) import Data.Aeson.Types #endif -import Data.List +import Data.List.Extra import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy.Encoding as T @@ -69,7 +54,7 @@ import Game.Werewolf.Game import Game.Werewolf.Player -import Game.Werewolf.Role (allegiance, description) +import Game.Werewolf.Role (Role, allegiance, description) import qualified Game.Werewolf.Role as Role import GHC.Generics @@ -123,11 +108,28 @@ privateMessage to = Message (Just to) newGameMessages :: Game -> [Message] -newGameMessages game = map (newPlayerMessage alivePlayers) alivePlayers ++ [nightFallsMessage] ++ turnMessages turn' alivePlayers +newGameMessages game = [playersInGameMessage players', rolesInGameMessage $ map _role players'] ++ map (newPlayerMessage players') players' ++ [nightFallsMessage] ++ turnMessages turn' players' where - turn' = game ^. turn - alivePlayers = filterAlive $ game ^. players + turn' = game ^. turn + players' = game ^. players +playersInGameMessage :: [Player] -> Message +playersInGameMessage players = publicMessage $ T.concat [ + "A new game of werewolf is starting with ", + T.intercalate ", " (map _name players), "!" + ] + +rolesInGameMessage :: [Role] -> Message +rolesInGameMessage roles = publicMessage $ T.concat [ + "The roles in play are ", + T.intercalate ", " $ map (\(role, count) -> + T.concat [role ^. Role.name, " (", T.pack $ show count, ")"]) + roleCounts, + "." + ] + where + roleCounts = map (\list -> (head list, length list)) (groupSortOn Role._name roles) + newPlayerMessage :: [Player] -> Player -> Message newPlayerMessage players player | isWerewolf player = privateMessage [player ^. name] $ T.unlines [T.concat ["You're a Werewolf", packMessage], player ^. role . description] @@ -137,31 +139,43 @@ | 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 _ = [] - -nightFallsMessage :: Message -nightFallsMessage = publicMessage "Night falls, the townsfolk are asleep." - -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."] - -playerQuitMessage :: Player -> Message -playerQuitMessage player = publicMessage $ T.unwords [player ^. name, "the", player ^. role . Role.name, "has quit!"] +turnMessages NoOne _ = undefined seersTurnMessages :: [Player] -> [Message] seersTurnMessages seers = publicMessage "The Seers wake up.":privateMessage (map _name seers) "Who's allegiance would you like to see?":[] +villagersTurnMessage :: Message +villagersTurnMessage = publicMessage "The sun rises. Everybody wakes up and opens their eyes..." + +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?" + ] + playerSeenMessage :: Text -> Player -> Message playerSeenMessage seerName target = privateMessage [seerName] $ T.concat [target ^. name, " is aligned with the ", T.pack . show $ target ^. role . allegiance, "."] -villagersTurnMessage :: Message -villagersTurnMessage = publicMessage "The sun rises. Everybody wakes up and opens their eyes..." +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?" + playerMadeLynchVoteMessage :: Text -> Text -> Message playerMadeLynchVoteMessage voterName targetName = publicMessage $ T.concat [voterName, " voted to lynch ", targetName, "."] @@ -180,27 +194,15 @@ 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." -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?" - ] - -playerMadeDevourVoteMessage :: [Text] -> Text -> Text -> Message -playerMadeDevourVoteMessage to voterName targetName = privateMessage to $ T.concat [voterName, " voted to devour ", targetName, "."] - -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, "." - ] +playerQuitMessage :: Player -> Message +playerQuitMessage player = publicMessage $ T.unwords [player ^. name, "the", player ^. role . Role.name, "has quit!"] -noPlayerDevouredMessage :: Message -noPlayerDevouredMessage = publicMessage "Surprisingly you see everyone present at the town square. Perhaps the Werewolves have left Miller's Hollow?" +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."] -gameIsOverMessage :: Text -> Message -gameIsOverMessage name = privateMessage [name] "The game is over!" +roleDoesNotExistMessage :: Text -> Text -> Message +roleDoesNotExistMessage to name = privateMessage [to] $ T.unwords ["Role", name, "does not exist."] playerDoesNotExistMessage :: Text -> Text -> Message playerDoesNotExistMessage to name = privateMessage [to] $ T.unwords ["Player", name, "does not exist."] @@ -211,12 +213,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!" @@ -225,6 +227,3 @@ 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,16 +28,15 @@ allCommandTests :: [TestTree] allCommandTests = [ - 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: 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: lynch vote command errors when game is over" prop_lynchVoteCommandErrorsWhenGameIsOver, testProperty "PROP: lynch vote command errors when caller does not exist" prop_lynchVoteCommandErrorsWhenCallerDoesNotExist, @@ -52,7 +51,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 devour vote" prop_quitCommandClearsPlayersDevourVote, + testProperty "PROP: quit command clears players kill vote" prop_quitCommandClearsPlayersKillVote, 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, arbitraryDevourVoteCommand, arbitraryLynchVoteCommand, arbitraryQuitCommand, + arbitraryCommand, arbitraryKillVoteCommand, 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 -> arbitraryDevourVoteCommand game + Werewolves -> arbitraryKillVoteCommand game NoOne -> return noopCommand -arbitraryDevourVoteCommand :: Game -> Gen Command -arbitraryDevourVoteCommand game = do +arbitraryKillVoteCommand :: Game -> Gen Command +arbitraryKillVoteCommand game = do let applicableCallers = filter (flip Map.notMember (game ^. votes) . _name) (filterAlive . filterWerewolves $ game ^. players) - target <- suchThat (arbitraryPlayer game) $ not . isWerewolf + target <- arbitraryPlayer game if null applicableCallers then return noopCommand - else elements applicableCallers >>= \caller -> return $ devourVoteCommand (caller ^. name) (target ^. name) + else elements applicableCallers >>= \caller -> return $ killVoteCommand (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,14 +8,12 @@ {-# OPTIONS_HADDOCK hide, prune #-} module Game.Werewolf.Test.Command ( - -- * devourVoteCommand - prop_devourVoteCommandErrorsWhenGameIsOver, prop_devourVoteCommandErrorsWhenCallerDoesNotExist, - prop_devourVoteCommandErrorsWhenTargetDoesNotExist, - prop_devourVoteCommandErrorsWhenCallerIsDead, prop_devourVoteCommandErrorsWhenTargetIsDead, - prop_devourVoteCommandErrorsWhenNotWerewolvesTurn, - prop_devourVoteCommandErrorsWhenCallerNotWerewolf, - prop_devourVoteCommandErrorsWhenCallerHasVoted, prop_devourVoteCommandErrorsWhenTargetWerewolf, - prop_devourVoteCommandUpdatesVotes, + -- * killVoteCommand + prop_killVoteCommandErrorsWhenGameIsOver, prop_killVoteCommandErrorsWhenCallerDoesNotExist, + prop_killVoteCommandErrorsWhenTargetDoesNotExist, prop_killVoteCommandErrorsWhenCallerIsDead, + prop_killVoteCommandErrorsWhenTargetIsDead, prop_killVoteCommandErrorsWhenNotWerewolvesTurn, + prop_killVoteCommandErrorsWhenCallerNotWerewolf, prop_killVoteCommandErrorsWhenCallerHasVoted, + prop_killVoteCommandUpdatesVotes, -- * lynchVoteCommand prop_lynchVoteCommandErrorsWhenGameIsOver, prop_lynchVoteCommandErrorsWhenCallerDoesNotExist, @@ -26,7 +24,7 @@ -- * quitCommand prop_quitCommandErrorsWhenGameIsOver, prop_quitCommandErrorsWhenCallerDoesNotExist, prop_quitCommandErrorsWhenCallerIsDead, prop_quitCommandKillsPlayer, - prop_quitCommandClearsPlayersDevourVote, prop_quitCommandClearsPlayersLynchVote, + prop_quitCommandClearsPlayersKillVote, prop_quitCommandClearsPlayersLynchVote, prop_quitCommandClearsPlayersSee, -- * seeCommand @@ -49,65 +47,55 @@ import Test.QuickCheck -prop_devourVoteCommandErrorsWhenGameIsOver :: Game -> Property -prop_devourVoteCommandErrorsWhenGameIsOver game = - isGameOver game - ==> forAll (arbitraryDevourVoteCommand game) $ verbose_runCommandErrors game +prop_killVoteCommandErrorsWhenGameIsOver :: Game -> Property +prop_killVoteCommandErrorsWhenGameIsOver game = isGameOver game + ==> forAll (arbitraryKillVoteCommand game) $ verbose_runCommandErrors game -prop_devourVoteCommandErrorsWhenCallerDoesNotExist :: Game -> Player -> Property -prop_devourVoteCommandErrorsWhenCallerDoesNotExist game caller = - not (doesPlayerExist (caller ^. name) (game ^. players)) +prop_killVoteCommandErrorsWhenCallerDoesNotExist :: Game -> Player -> Property +prop_killVoteCommandErrorsWhenCallerDoesNotExist game caller = not (doesPlayerExist (caller ^. name) (game ^. players)) ==> forAll (arbitraryPlayer game) $ \target -> - verbose_runCommandErrors game (devourVoteCommand (caller ^. name) (target ^. name)) + verbose_runCommandErrors game (killVoteCommand (caller ^. name) (target ^. name)) -prop_devourVoteCommandErrorsWhenTargetDoesNotExist :: Game -> Player -> Property -prop_devourVoteCommandErrorsWhenTargetDoesNotExist game target = - not (doesPlayerExist (target ^. name) (game ^. players)) +prop_killVoteCommandErrorsWhenTargetDoesNotExist :: Game -> Player -> Property +prop_killVoteCommandErrorsWhenTargetDoesNotExist game target = not (doesPlayerExist (target ^. name) (game ^. players)) ==> forAll (arbitraryWerewolf game) $ \caller -> - verbose_runCommandErrors game (devourVoteCommand (caller ^. name) (target ^. name)) + verbose_runCommandErrors game (killVoteCommand (caller ^. name) (target ^. name)) -prop_devourVoteCommandErrorsWhenCallerIsDead :: Game -> Property -prop_devourVoteCommandErrorsWhenCallerIsDead game = +prop_killVoteCommandErrorsWhenCallerIsDead :: Game -> Property +prop_killVoteCommandErrorsWhenCallerIsDead game = forAll (arbitraryWerewolf game) $ \caller -> forAll (arbitraryPlayer game) $ \target -> - verbose_runCommandErrors (killPlayer game caller) (devourVoteCommand (caller ^. name) (target ^. name)) + verbose_runCommandErrors (killPlayer game caller) (killVoteCommand (caller ^. name) (target ^. name)) -prop_devourVoteCommandErrorsWhenTargetIsDead :: Game -> Property -prop_devourVoteCommandErrorsWhenTargetIsDead game = +prop_killVoteCommandErrorsWhenTargetIsDead :: Game -> Property +prop_killVoteCommandErrorsWhenTargetIsDead game = forAll (arbitraryWerewolf game) $ \caller -> forAll (arbitraryPlayer game) $ \target -> - verbose_runCommandErrors (killPlayer game target) (devourVoteCommand (caller ^. name) (target ^. name)) + verbose_runCommandErrors (killPlayer game target) (killVoteCommand (caller ^. name) (target ^. name)) -prop_devourVoteCommandErrorsWhenNotWerewolvesTurn :: Game -> Property -prop_devourVoteCommandErrorsWhenNotWerewolvesTurn game = +prop_killVoteCommandErrorsWhenNotWerewolvesTurn :: Game -> Property +prop_killVoteCommandErrorsWhenNotWerewolvesTurn game = not (isWerewolvesTurn game) - ==> forAll (arbitraryDevourVoteCommand game) $ verbose_runCommandErrors game + ==> forAll (arbitraryKillVoteCommand game) $ verbose_runCommandErrors game -prop_devourVoteCommandErrorsWhenCallerNotWerewolf :: Game -> Property -prop_devourVoteCommandErrorsWhenCallerNotWerewolf game = +prop_killVoteCommandErrorsWhenCallerNotWerewolf :: Game -> Property +prop_killVoteCommandErrorsWhenCallerNotWerewolf game = forAll (arbitraryPlayer game) $ \caller -> not (isWerewolf caller) ==> forAll (arbitraryPlayer game) $ \target -> - verbose_runCommandErrors game (devourVoteCommand (caller ^. name) (target ^. name)) + verbose_runCommandErrors game (killVoteCommand (caller ^. name) (target ^. name)) -prop_devourVoteCommandErrorsWhenCallerHasVoted :: Game -> Property -prop_devourVoteCommandErrorsWhenCallerHasVoted game = +prop_killVoteCommandErrorsWhenCallerHasVoted :: Game -> Property +prop_killVoteCommandErrorsWhenCallerHasVoted game = isWerewolvesTurn game ==> forAll (arbitraryWerewolf game) $ \caller -> forAll (arbitraryPlayer game) $ \target -> - not (isWerewolf target) - ==> let command = devourVoteCommand (caller ^. name) (target ^. name) + let command = killVoteCommand (caller ^. name) (target ^. name) in verbose_runCommandErrors (run_ (apply command) game) command -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 = +prop_killVoteCommandUpdatesVotes :: Game -> Property +prop_killVoteCommandUpdatesVotes game = isWerewolvesTurn game - ==> forAll (arbitraryDevourVoteCommand game) $ \command -> + ==> forAll (arbitraryKillVoteCommand game) $ \command -> Map.size (run_ (apply command) game ^. votes) == 1 prop_lynchVoteCommandErrorsWhenGameIsOver :: Game -> Property @@ -179,12 +167,11 @@ ==> forAll (arbitraryQuitCommand game) $ \command -> length (filterDead $ run_ (apply command) game ^. players) == 1 -prop_quitCommandClearsPlayersDevourVote :: Game -> Property -prop_quitCommandClearsPlayersDevourVote game = +prop_quitCommandClearsPlayersKillVote :: Game -> Property +prop_quitCommandClearsPlayersKillVote game = forAll (arbitraryWerewolf game') $ \caller -> forAll (arbitraryPlayer game') $ \target -> - not (isWerewolf target) - ==> let game'' = run_ (apply $ devourVoteCommand (caller ^. name) (target ^. name)) game' + let game'' = run_ (apply $ killVoteCommand (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.0.5 +version: 0.3.1.0 author: Henry J. Wylde maintainer: public@hjwylde.com