werewolf 0.3.0.5 → 0.3.1.0
raw patch · 14 files changed
+196/−221 lines, 14 files
Files
- CHANGELOG.md +4/−28
- README.md +6/−6
- app/Main.hs +1/−1
- app/Werewolf/Commands/Help.hs +28/−18
- app/Werewolf/Commands/Vote.hs +1/−1
- app/Werewolf/Options.hs +4/−4
- src/Game/Werewolf/Command.hs +24/−19
- src/Game/Werewolf/Engine.hs +7/−8
- src/Game/Werewolf/Game.hs +1/−1
- src/Game/Werewolf/Response.hs +66/−67
- test/app/Main.hs +10/−11
- test/src/Game/Werewolf/Test/Arbitrary.hs +6/−6
- test/src/Game/Werewolf/Test/Command.hs +37/−50
- werewolf.cabal +1/−1
CHANGELOG.md view
@@ -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
README.md view
@@ -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."} ]}
app/Main.hs view
@@ -14,8 +14,8 @@ main, handle, ) where -import Data.Text (Text) import qualified Data.Text as T+import Data.Text (Text) import Options.Applicative
app/Werewolf/Commands/Help.hs view
@@ -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:",
app/Werewolf/Commands/Vote.hs view
@@ -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
app/Werewolf/Options.hs view
@@ -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
src/Game/Werewolf/Command.hs view
@@ -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]
src/Game/Werewolf/Engine.hs view
@@ -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
src/Game/Werewolf/Game.hs view
@@ -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
src/Game/Werewolf/Response.hs view
@@ -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!"
test/app/Main.hs view
@@ -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,
test/src/Game/Werewolf/Test/Arbitrary.hs view
@@ -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
test/src/Game/Werewolf/Test/Command.hs view
@@ -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 }
werewolf.cabal view
@@ -1,5 +1,5 @@ name: werewolf-version: 0.3.0.5+version: 0.3.1.0 author: Henry J. Wylde maintainer: public@hjwylde.com