werewolf 0.3.1.2 → 0.3.1.3
raw patch · 11 files changed
+175/−134 lines, 11 files
Files
- CHANGELOG.md +14/−0
- README.md +6/−6
- app/Werewolf/Commands/Help.hs +3/−3
- app/Werewolf/Commands/Vote.hs +1/−1
- src/Game/Werewolf/Command.hs +19/−24
- src/Game/Werewolf/Engine.hs +3/−3
- src/Game/Werewolf/Response.hs +61/−43
- test/app/Main.hs +11/−10
- test/src/Game/Werewolf/Test/Arbitrary.hs +6/−6
- test/src/Game/Werewolf/Test/Command.hs +50/−37
- werewolf.cabal +1/−1
CHANGELOG.md view
@@ -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
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: 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."} ]}
app/Werewolf/Commands/Help.hs view
@@ -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]
app/Werewolf/Commands/Vote.hs view
@@ -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
src/Game/Werewolf/Command.hs view
@@ -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]
src/Game/Werewolf/Engine.hs view
@@ -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 ()
src/Game/Werewolf/Response.hs view
@@ -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!"
test/app/Main.hs view
@@ -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,
test/src/Game/Werewolf/Test/Arbitrary.hs view
@@ -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
test/src/Game/Werewolf/Test/Command.hs view
@@ -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 }
werewolf.cabal view
@@ -1,5 +1,5 @@ name: werewolf-version: 0.3.1.2+version: 0.3.1.3 author: Henry J. Wylde maintainer: public@hjwylde.com