werewolf 0.4.10.0 → 0.4.11.0
raw patch · 51 files changed
+1239/−854 lines, 51 filesdep ~aeson
Dependency ranges changed: aeson
Files
- CHANGELOG.md +62/−44
- LICENSE +3/−3
- README.md +37/−26
- app/Werewolf/Command/Boot.hs +1/−0
- app/Werewolf/Command/Choose.hs +6/−3
- app/Werewolf/Command/Circle.hs +1/−0
- app/Werewolf/Command/Heal.hs +1/−0
- app/Werewolf/Command/Help.hs +23/−24
- app/Werewolf/Command/Pass.hs +4/−2
- app/Werewolf/Command/Ping.hs +1/−0
- app/Werewolf/Command/Poison.hs +1/−0
- app/Werewolf/Command/Protect.hs +1/−0
- app/Werewolf/Command/Quit.hs +1/−0
- app/Werewolf/Command/Reveal.hs +1/−0
- app/Werewolf/Command/See.hs +1/−0
- app/Werewolf/Command/Start.hs +4/−1
- app/Werewolf/Command/Status.hs +1/−0
- app/Werewolf/Command/Vote.hs +4/−2
- app/Werewolf/Options.hs +3/−6
- src/Game/Werewolf/Command.hs +9/−281
- src/Game/Werewolf/Command/Defender.hs +37/−0
- src/Game/Werewolf/Command/DevotedServant.hs +71/−0
- src/Game/Werewolf/Command/Global.hs +49/−0
- src/Game/Werewolf/Command/Scapegoat.hs +40/−0
- src/Game/Werewolf/Command/Seer.hs +34/−0
- src/Game/Werewolf/Command/Status.hs +117/−0
- src/Game/Werewolf/Command/Villager.hs +37/−0
- src/Game/Werewolf/Command/Werewolf.hs +48/−0
- src/Game/Werewolf/Command/WildChild.hs +35/−0
- src/Game/Werewolf/Command/Witch.hs +61/−0
- src/Game/Werewolf/Command/WolfHound.hs +43/−0
- src/Game/Werewolf/Engine.hs +1/−2
- src/Game/Werewolf/Messages.hs +22/−13
- src/Game/Werewolf/Response.hs +4/−4
- src/Game/Werewolf/Role.hs +148/−112
- test/app/Main.hs +2/−1
- test/src/Game/Werewolf/Test/Arbitrary.hs +50/−44
- test/src/Game/Werewolf/Test/Command/Choose.hs +100/−100
- test/src/Game/Werewolf/Test/Command/Heal.hs +2/−3
- test/src/Game/Werewolf/Test/Command/Pass.hs +43/−43
- test/src/Game/Werewolf/Test/Command/Poison.hs +2/−3
- test/src/Game/Werewolf/Test/Command/Protect.hs +2/−3
- test/src/Game/Werewolf/Test/Command/Quit.hs +2/−3
- test/src/Game/Werewolf/Test/Command/Reveal.hs +2/−4
- test/src/Game/Werewolf/Test/Command/See.hs +2/−3
- test/src/Game/Werewolf/Test/Command/Vote.hs +83/−84
- test/src/Game/Werewolf/Test/Engine.hs +17/−25
- test/src/Game/Werewolf/Test/Game.hs +1/−2
- test/src/Game/Werewolf/Test/Player.hs +1/−2
- test/src/Game/Werewolf/Test/Util.hs +1/−3
- werewolf.cabal +17/−8
CHANGELOG.md view
@@ -1,14 +1,32 @@-## Changelog+# Changelog -#### Upcoming+### Upcoming -#### v0.4.10.0+### v0.4.11.0 *Minor* +* Replaced references to Millers Hollow with an original game description. ([#126](https://github.com/hjwylde/werewolf/issues/126))+* Updated the Simple Villager's description and rules. ([#135](https://github.com/hjwylde/werewolf/issues/135))+* Removed the advice field from Role. ([#134](https://github.com/hjwylde/werewolf/issues/134))+* Updated the Seer's description. ([#134](https://github.com/hjwylde/werewolf/issues/134))+* Updated the Simple Werewolf's description. ([#139](https://github.com/hjwylde/werewolf/issues/139))++*Revisions*++* Fixed a bug where extra roles with spaces in them weren't recognised.+* Fixed Devoted Servant messages to exclude her when joining the Werewolf pack.+* Fixed Devoted Servant help messages to include how to `pass`.+* Removed player cap of 24. ([#143](https://github.com/hjwylde/werewolf/issues/143))+* Fixed a bug where the Wild Child would receive role model died messages when dead. ([#145](https://github.com/hjwylde/werewolf/issues/145))++### v0.4.10.0++*Minor*+ * Added `boot` command. ([#14](https://github.com/hjwylde/werewolf/issues/14)) -#### v0.4.9.0+### v0.4.9.0 *Minor* @@ -19,7 +37,7 @@ * Added the Devoted Servant role. ([#47](https://github.com/hjwylde/werewolf/issues/47)) * Added `--force` flag to `end`. ([#77](https://github.com/hjwylde/werewolf/issues/77)) -#### v0.4.8.0+### v0.4.8.0 *Minor* @@ -33,7 +51,7 @@ * Changed the `status` and `ping` commands to tell the caller when the game is over. ([#89](https://github.com/hjwylde/werewolf/issues/89)) * Added roles in game to the `status` command. ([#93](https://github.com/hjwylde/werewolf/issues/93)) -#### v0.4.7.1+### v0.4.7.1 *Revisions* @@ -42,7 +60,7 @@ * Fixed Village Idiot text to have spaces around the name. ([#87](https://github.com/hjwylde/werewolf/issues/87)) * Fixed a bug where the Werewolves couldn't win if it was down to 1 Werewolf and the Village Idiot. ([#88](https://github.com/hjwylde/werewolf/issues/88)) -#### v0.4.7.0+### v0.4.7.0 *Revisions* @@ -55,14 +73,14 @@ * Moved Wolf-hound's turn to before the Seer's so that the Seer may see his allegiance properly. * Restricted specifying `Simple Villager` or `Simple Werewolf` as extra roles. -#### v0.4.6.1+### v0.4.6.1 *Revisions* * Fixed Village Idiot text to have spaces around the name. ([#87](https://github.com/hjwylde/werewolf/issues/87)) * Fixed a bug where the Werewolves couldn't win if it was down to 1 Werewolf and the Village Idiot. ([#88](https://github.com/hjwylde/werewolf/issues/88)) -#### v0.4.6.0+### v0.4.6.0 *Minor* @@ -78,7 +96,7 @@ * Fixed the Defender being unable to protect himself. * Restructured library modules to only export relevant functions. ([#11](https://github.com/hjwylde/werewolf/issues/11)) -#### v0.4.5.0+### v0.4.5.0 *Minor* @@ -94,14 +112,14 @@ * Renamed the devourVoteCommand and lynchVoteCommand to voteDevourCommand and voteLynchCommand. ([#49](https://github.com/hjwylde/werewolf/issues/49)) * Fixed `quit` to advance the stage when the only role for that stage has quit. -#### v0.4.4.1+### v0.4.4.1 *Revisions* * Fixed grammar for the `currentStageMessages`. ([#83](https://github.com/hjwylde/werewolf/issues/83)) * Fixed the `heal` command help message to not require a `PLAYER` argument. ([#82](https://github.com/hjwylde/werewolf/issues/82)) -#### v0.4.4.0+### v0.4.4.0 *Minor* @@ -115,82 +133,82 @@ * Fixed the `noPlayerDevouredMessage` to be displayed after sunrise. ([#80](https://github.com/hjwylde/werewolf/issues/80)) * Removed `Show` instance for `Command` and used `Blind`. ([#78](https://github.com/hjwylde/werewolf/issues/78)) -#### v0.4.3.2+### v0.4.3.2 *Revisions* * Fixed grammar for the `currentStageMessages`. ([#83](https://github.com/hjwylde/werewolf/issues/83)) * Fixed the `heal` command help message to not require a `PLAYER` argument. ([#82](https://github.com/hjwylde/werewolf/issues/82)) -#### v0.4.3.1+### v0.4.3.1 *Revisions* * Added missing module to Cabal file. -#### v0.4.3.0+### v0.4.3.0 *Minor* * Added the Defender role. ([#38](https://github.com/hjwylde/werewolf/issues/38)) -#### v0.4.2.3+### v0.4.2.3 *Revisions* * Fixed grammar for the `currentStageMessages`. ([#83](https://github.com/hjwylde/werewolf/issues/83)) * Fixed the `heal` command help message to not require a `PLAYER` argument. ([#82](https://github.com/hjwylde/werewolf/issues/82)) -#### v0.4.2.2+### v0.4.2.2 *Revisions* * Added missing module to Cabal file. -#### v0.4.2.1+### v0.4.2.1 *Revisions* * Fixed a bug causing the Witch being unable to heal themselves. ([#76](https://github.com/hjwylde/werewolf/issues/76)) -#### v0.4.2.0+### v0.4.2.0 *Minor* * Added the Villager-Villager role. ([#37](https://github.com/hjwylde/werewolf/issues/37)) -#### v0.4.1.3+### v0.4.1.3 *Revisions* * Fixed grammar for the `currentStageMessages`. ([#83](https://github.com/hjwylde/werewolf/issues/83)) * Fixed the `heal` command help message to not require a `PLAYER` argument. ([#82](https://github.com/hjwylde/werewolf/issues/82)) -#### v0.4.1.2+### v0.4.1.2 *Revisions* * Added missing module to Cabal file. -#### v0.4.1.1+### v0.4.1.1 *Revisions* * Fixed a bug causing the Witch being unable to heal themselves. ([#76](https://github.com/hjwylde/werewolf/issues/76)) -#### v0.4.1.0+### v0.4.1.0 *Minor* * Added the Witch role. ([#5](https://github.com/hjwylde/werewolf/issues/5)) -#### v0.4.0.1+### v0.4.0.1 *Revisions* * Fixed grammar for the `currentStageMessages`. ([#83](https://github.com/hjwylde/werewolf/issues/83)) -#### v0.4.0.0+### v0.4.0.0 *Major* @@ -205,7 +223,7 @@ * Added private pinging to the `ping` command. ([#69](https://github.com/hjwylde/werewolf/issues/69)) * Restricted `end` to players in the current game. ([#74](https://github.com/hjwylde/werewolf/issues/74)) -#### v0.3.4.0+### v0.3.4.0 *Minor* @@ -221,19 +239,19 @@ * Turned start of day and night into distinct turns. * Added private message to players when the game is over. ([#65](https://github.com/hjwylde/werewolf/issues/65)) -#### v0.3.3.2+### v0.3.3.2 *Revisions* * Fixed missing file in Cabal file. ([#18](https://github.com/hjwylde/werewolf/issues/18)) -#### v0.3.3.1+### v0.3.3.1 *Revisions* * Added `noIntersperse` to `interpret`. ([#60](https://github.com/hjwylde/werewolf/issues/60)) -#### v0.3.3.0+### v0.3.3.0 *Minor* @@ -244,7 +262,7 @@ * Added `--` to help description of `interpret`. ([#60](https://github.com/hjwylde/werewolf/issues/60)) -#### v0.3.2.0+### v0.3.2.0 *Minor* @@ -255,67 +273,67 @@ * Shrunk some of the help text to make it more readable. ([#25](https://github.com/hjwylde/werewolf/issues/25)) -#### v0.3.1.3+### 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+### v0.3.1.2 *Revisions* * Fixed dead werewolves being informed of votes. ([#24](https://github.com/hjwylde/werewolf/issues/24)) -#### v0.3.1.1+### v0.3.1.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.3.1.0+### v0.3.1.0 *Minor* * 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+### 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+### v0.3.0.4 *Revisions* * Fixed dead werewolves being informed of votes. ([#24](https://github.com/hjwylde/werewolf/issues/24)) -#### v0.3.0.3+### v0.3.0.3 *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.3.0.2+### v0.3.0.2 *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.3.0.1+### v0.3.0.1 *Revisions* * Fixed `interpret` to display the commands help messages when given invalid arguments. ([#22](https://github.com/hjwylde/werewolf/issues/22)) -#### v0.3.0.0+### v0.3.0.0 *Major* @@ -327,27 +345,27 @@ * 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+### v0.2.0.2 *Revisions* * Fixed dead werewolves being informed of votes. ([#24](https://github.com/hjwylde/werewolf/issues/24)) -#### v0.2.0.1+### 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+### v0.2.0.0 *Major* * Added the Seer role. ([#4](https://github.com/hjwylde/werewolf/issues/4)) * Removed the need to encode / decode to JSON for the state file. ([#9](https://github.com/hjwylde/werewolf/issues/9)) -#### v0.1.0.0+### v0.1.0.0 *Major*
LICENSE view
@@ -11,9 +11,9 @@ this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. -* The name of werewolf's contributors may be used to endorse or promote- products derived from this software without specific prior written- permission.+* Neither the name of werewolf nor werewolf's contributors may be used to+ endorse or promote products derived from this software without specific+ prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
README.md view
@@ -4,20 +4,31 @@ [](https://travis-ci.org/hjwylde/werewolf) [](https://github.com/hjwylde/werewolf/releases/latest) -A game engine for running werewolf in a chat client.-This engine is based off of [Werewolves of Millers Hollow](http://www.games-wiki.org/wiki/Werewolves_of_Millers_Hollow/).+A game engine for playing werewolf within a chat client.+This engine is based off of the party game Mafia, also known as Werewolf.+See the [Wikipedia article](https://en.wikipedia.org/wiki/Mafia_(party_game)) for a rundown on it's+ gameplay and history. +If you're here just to play werewolf, you may wish to skip straight to+ [chat interfaces](https://github.com/hjwylde/werewolf#chat-interfaces).++DISCLAIMER:+I recently asked the copyright owners of the Werewolves of Millers Hollow if I may have permission+ to use some content from the rule book, but they have said no.+I am currently working on removing all copyrighted material from the project.+ ### Game description -Deep in the American countryside, the little town of Millers Hollow has recently been infiltrated by- Werewolves.-Each night, murders are committed by the Villagers, who due to some mysterious phenomenon (possibly- the greenhouse effect) have become Werewolves.-It is now time to take control and eliminate this ancient evil, before the town loses its last few- inhabitants.+Long has the woods been home to wild creatures, both kind and cruel.+Most have faces and are known to the inhabitants of Fougères in Brittany, France; but no-one from+ the village has yet to lay eyes on the merciless Werewolf. +Each night Werewolves attack the village and devour the innocent.+For centuries no one knew how to fight this scourge, however recently a theory has taken ahold that+ maphaps the Werewolves walk among the Villagers themselves...+ Objective of the Game: -For the Angel: die in the first round. +For the Loners: complete their own objective. For the Villagers: lynch all of the Werewolves. For the Werewolves: devour all of the Villagers. @@ -27,10 +38,9 @@ **The Ambiguous:** -They could very well be allies of the village or become its enemies.-During the game, they can change sides or characters.+No-one knows the true nature of the Ambiguous, sometimes not even the Ambiguous themselves! -The Ambiguous must aid their side to achieve victory.+The Ambiguous are able to change allegiance throughout the game. * Devoted Servant * Wild-child@@ -38,18 +48,18 @@ **The Loners:** -Their past could no doubt reveal to us why they hate the inhabitants of Miller's Hollow.-One thing is known for sure: they really scare everyone!+The Loners look out for themselves and themselves alone. -The Loners have their own objectives, no matter which side they're on.+The Loners must complete their own objective. * Angel **The Villagers:** -Attached to the village's survival, the following characters defend its harmony with determination.-Faced with various menaces, they will be brought to eliminate those they suspect of being too- dangerous, even if that might be painful to them.+Fraught with fear of the unseen enemy, the Villagers must work together to determine the truth and+ eliminate the threat to Fougères.+The task before them will not be easy, but a certain few have learnt some tricks over the years that+ may turn out rather useful. The Villagers must lynch all of the Werewolves. @@ -64,7 +74,7 @@ **The Werewolves:** -They can be lethally dangerous and put in doubt the village's survival.+Hiding in plain sight, the Werewolves are not a small trifle. The Werewolves must devour all of the Villagers. @@ -92,7 +102,7 @@ ### Usage -This section covers how a chat client interacts with the werewolf game engine.+This section covers how a chat interface interacts with the werewolf game engine. All werewolf commands are designed to be run by a user from the chat client. E.g., to start a game:@@ -165,11 +175,11 @@ ``` Here the command was unsuccessful and an error message is sent to _@corge_.-Even though the command was unsuccessful, the chat client interface probably won't need to do- anything special.+Even though the command was unsuccessful, the chat interface probably won't need to do anything+ special. Relaying the error message back to the user should suffice. -Thus a chat client interface must implement the following:+Thus a chat interface must implement the following: * The ability to call werewolf commands. This includes passing the `--caller` option and arguments correctly. It is possible to only implement the `interpret` command, which interprets the caller's input.@@ -180,7 +190,8 @@ See `werewolf --help`. -#### Chat clients+#### Chat interfaces -**Coming soon:**-* Slack+Click through for instructions on how to run a chat interface and play werewolf.++* [Slack](https://github.com/hjwylde/werewolf-slack)
app/Werewolf/Command/Boot.hs view
@@ -25,6 +25,7 @@ import Data.Text (Text) import Game.Werewolf+import Game.Werewolf.Command.Global import Werewolf.Game import Werewolf.Messages
app/Werewolf/Command/Choose.hs view
@@ -28,6 +28,9 @@ import Data.Text (Text) import Game.Werewolf+import Game.Werewolf.Command.Scapegoat as Scapegoat+import Game.Werewolf.Command.WildChild as WildChild+import Game.Werewolf.Command.WolfHound as WolfHound import Werewolf.Game import Werewolf.Messages@@ -45,9 +48,9 @@ game <- readGame let command = case game ^. stage of- ScapegoatsTurn -> choosePlayersCommand callerName args- WildChildsTurn -> choosePlayerCommand callerName (head args)- WolfHoundsTurn -> chooseAllegianceCommand callerName (head args)+ ScapegoatsTurn -> Scapegoat.chooseCommand callerName args+ WildChildsTurn -> WildChild.chooseCommand callerName (head args)+ WolfHoundsTurn -> WolfHound.chooseCommand callerName (head args) -- TODO (hjw): throw an error _ -> undefined
app/Werewolf/Command/Circle.hs view
@@ -25,6 +25,7 @@ import Data.Text (Text) import Game.Werewolf+import Game.Werewolf.Command.Status import Werewolf.Game import Werewolf.Messages
app/Werewolf/Command/Heal.hs view
@@ -24,6 +24,7 @@ import Data.Text (Text) import Game.Werewolf+import Game.Werewolf.Command.Witch import Werewolf.Game import Werewolf.Messages
app/Werewolf/Command/Help.hs view
@@ -81,7 +81,7 @@ ] , [ "Status commands:" , "- `ping` ping the status of the current game publicly"- , "- `status` get the status of the current game"+ , "- `status` get the status of the current game privately" , "- `circle [-a | --include-dead]` get the game circle" ] , [ "Standard commands:"@@ -94,6 +94,7 @@ , whenPlayerHasRole callerName mGame devotedServantRole [ "Devoted Servant commands:" , "- `reveal`"+ , "- `pass`" ] , whenPlayerHasRole callerName mGame scapegoatRole [ "Scapegoat commands:"@@ -123,30 +124,29 @@ roleMessage role = T.intercalate "\n" [ T.concat [role ^. Role.name, " (", T.pack . show $ role ^. balance, "):"] , role ^. description- , role ^. advice+ , role ^. rules ] rulesMessages :: Maybe Game -> [Text] rulesMessages mGame = 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."- , "The number of Werewolves in play depends upon"- , " the number of players and variants used in the game."+ [ "Each night, the Werewolves transform and subsequently assault and devour one Villager."+ , "After feasting their lycanthropic form subsides and they once again hide in plain sight." ] , T.unwords- [ "Each day,"- , "the survivors gather in the town square and try to discover who the Werewolves are."- , "This is done by studying the other player's social behaviours"- , "for hidden signs of lycanthropy."- , "After discussing and debating, the village votes to lynch a suspect,"- , "who is then hanged, burned and eliminated from the game."+ [ "Each day, after discovering the victim, the village gathers in the town square. In a"+ , "democratic fashion they then vote for whom they believe to be a Werewolf. The votee is"+ , "immediately tied to a pyre and burned alive in an attempt to rid them of any"+ , "lycanthropy." ]+ , T.unwords+ [ "The number of Werewolves in play depends upon the number of players and extra roles in"+ , "the game."+ ] ] , filter (/= "") [ T.concat- [ "Each player is informed of their role (see `help roles' for a list)"- , " at the start of the game."- , " A game begins at night and follows a standard cycle."+ [ "Each player is informed of their role (see `help roles' for a list) at the start of the"+ , "game. A game begins at night and follows a standard cycle." , whenRoleInPlay mGame angelRole " (N.B., when the Angel is in play the game begins with the village vote.)" ]@@ -165,6 +165,8 @@ , whenRoleInPlay mGame witchRole "- The Witch wakes up and may heal the victim and/or poison someone." , "- The village wakes up and find the victim."+ , whenRoleInPlay mGame bearTamerRole+ "- Ursus grunts if the Bear Tamer is next to a Werewolf." , "- The village votes to lynch a suspect." , whenRoleInPlay mGame devotedServantRole "- The Devoted Servant may choose whether to reveal themselves and take on the role of their master."@@ -182,17 +184,14 @@ helpMessages :: [Text] helpMessages = map (T.intercalate "\n") [ [ T.unwords- [ "Deep in the American countryside,"- , "the little town of Millers Hollow has recently been infiltrated by Werewolves."- ]- , T.unwords- [ "Each night, murders are committed by the Villagers,"- , "who due to some mysterious phenomenon (possibly the greenhouse effect)"- , "have become Werewolves."+ [ "Long has the woods been home to wild creatures, both kind and cruel. Most have faces and"+ , "are known to the inhabitants of Fougères in Brittany, France; but no-one from the"+ , "village has yet to lay eyes on the merciless Werewolf." ] , T.unwords- [ "It is now time to take control and eliminate this ancient evil,"- , "before the town loses its last few inhabitants."+ [ "Each night Werewolves attack the village and devour the innocent. For centuries no one"+ , "knew how to fight this scourge, however recently a theory has taken ahold that maphaps"+ , "the Werewolves walk among the Villagers themselves..." ] ] , [ "Help commands:"
app/Werewolf/Command/Pass.hs view
@@ -23,6 +23,8 @@ import Data.Text (Text) import Game.Werewolf+import Game.Werewolf.Command.DevotedServant as DevotedServant+import Game.Werewolf.Command.Witch as Witch import Werewolf.Game import Werewolf.Messages@@ -36,8 +38,8 @@ game <- readGame let command = case game ^. stage of- DevotedServantsTurn -> passDevotedServantsTurnCommand callerName- WitchsTurn -> passWitchsTurnCommand callerName+ DevotedServantsTurn -> DevotedServant.passCommand callerName+ WitchsTurn -> Witch.passCommand callerName -- TODO (hjw): throw an error _ -> undefined
app/Werewolf/Command/Ping.hs view
@@ -22,6 +22,7 @@ import Data.Text (Text) import Game.Werewolf+import Game.Werewolf.Command.Status import Werewolf.Game import Werewolf.Messages
app/Werewolf/Command/Poison.hs view
@@ -25,6 +25,7 @@ import Data.Text (Text) import Game.Werewolf+import Game.Werewolf.Command.Witch import Werewolf.Game import Werewolf.Messages
app/Werewolf/Command/Protect.hs view
@@ -25,6 +25,7 @@ import Data.Text (Text) import Game.Werewolf+import Game.Werewolf.Command.Defender import Werewolf.Game import Werewolf.Messages
app/Werewolf/Command/Quit.hs view
@@ -22,6 +22,7 @@ import Data.Text (Text) import Game.Werewolf+import Game.Werewolf.Command.Global import Werewolf.Game import Werewolf.Messages
app/Werewolf/Command/Reveal.hs view
@@ -24,6 +24,7 @@ import Data.Text (Text) import Game.Werewolf+import Game.Werewolf.Command.DevotedServant import Werewolf.Game import Werewolf.Messages
app/Werewolf/Command/See.hs view
@@ -25,6 +25,7 @@ import Data.Text (Text) import Game.Werewolf+import Game.Werewolf.Command.Seer import Werewolf.Game import Werewolf.Messages
app/Werewolf/Command/Start.hs view
@@ -11,6 +11,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} module Werewolf.Command.Start ( -- * Options@@ -80,4 +81,6 @@ Nothing -> throwError [roleDoesNotExistMessage callerName roleName] findByName :: Text -> Maybe Role-findByName name' = restrictedRoles ^? traverse . filtered ((name' ==) . T.toLower . view name)+findByName name' = restrictedRoles ^? traverse . filtered ((sanitise name' ==) . T.toLower . sanitise . view name)+ where+ sanitise = T.replace " " "-"
app/Werewolf/Command/Status.hs view
@@ -22,6 +22,7 @@ import Data.Text (Text) import Game.Werewolf+import Game.Werewolf.Command.Status import Werewolf.Game import Werewolf.Messages
app/Werewolf/Command/Vote.hs view
@@ -26,6 +26,8 @@ import Data.Text (Text) import Game.Werewolf+import Game.Werewolf.Command.Villager as Villager+import Game.Werewolf.Command.Werewolf as Werewolf import Werewolf.Game import Werewolf.Messages@@ -43,8 +45,8 @@ game <- readGame let command = case game ^. stage of- VillagesTurn -> voteLynchCommand callerName targetName- WerewolvesTurn -> voteDevourCommand callerName targetName+ VillagesTurn -> Villager.voteCommand callerName targetName+ WerewolvesTurn -> Werewolf.voteCommand callerName targetName -- TODO (hjw): throw an error _ -> undefined
app/Werewolf/Options.hs view
@@ -79,12 +79,9 @@ , help "Show this binary's version" ] - header' = header "A game engine for running werewolf in a chat client."- progDesc' = progDesc $ unwords- [ "This engine is based off of Werewolves of Millers Hollow"- , "(http://www.games-wiki.org/wiki/Werewolves_of_Millers_Hollow/)."- , "See https://github.com/hjwylde/werewolf for help on writing chat interfaces."- ]+ header' = header "A game engine for running werewolf within a chat client."+ progDesc' = progDesc+ "This engine is based off of the party game Mafia, also known as Werewolf." -- | An options parser. werewolf :: Parser Options
src/Game/Werewolf/Command.hs view
@@ -11,7 +11,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} module Game.Werewolf.Command (@@ -19,302 +18,31 @@ Command(..), -- ** Instances- bootCommand, chooseAllegianceCommand, choosePlayerCommand, choosePlayersCommand, circleCommand,- healCommand, noopCommand, passDevotedServantsTurnCommand, passWitchsTurnCommand, pingCommand,- poisonCommand, protectCommand, quitCommand, revealCommand, seeCommand, statusCommand,- voteDevourCommand, voteLynchCommand,+ noopCommand,++ -- ** Validation+ validatePlayer, ) where -import Control.Lens import Control.Monad.Except import Control.Monad.Extra import Control.Monad.State hiding (state) import Control.Monad.Writer -import Data.List-import qualified Data.Map as Map-import Data.Maybe-import Data.Text (Text)-import qualified Data.Text as T+import Data.Text (Text) -import Game.Werewolf.Game hiding (doesPlayerExist, getPendingVoters, getVoteResult,- killPlayer)-import Game.Werewolf.Messages-import Game.Werewolf.Player-import Game.Werewolf.Response-import Game.Werewolf.Role hiding (name)-import qualified Game.Werewolf.Role as Role-import Game.Werewolf.Util+import Game.Werewolf.Game hiding (doesPlayerExist, getPendingVoters, getVoteResult, killPlayer)+import Game.Werewolf.Messages+import Game.Werewolf.Response+import Game.Werewolf.Util data Command = Command { apply :: forall m . (MonadError [Message] m, MonadState Game m, MonadWriter [Message] m) => m () } -bootCommand :: Text -> Text -> Command-bootCommand callerName targetName = Command $ do- validatePlayer callerName callerName- validatePlayer callerName targetName- whenM (uses (boots . at targetName) $ elem callerName . maybe [] id) $- throwError [playerHasAlreadyVotedToBootMessage callerName targetName]-- boots %= Map.insertWith (++) targetName [callerName]-- tell [playerVotedToBootMessage callerName targetName]--chooseAllegianceCommand :: Text -> Text -> Command-chooseAllegianceCommand callerName allegianceName = Command $ do- validatePlayer callerName callerName- unlessM (isPlayerWolfHound callerName) $ throwError [playerCannotDoThatMessage callerName]- unlessM isWolfHoundsTurn $ throwError [playerCannotDoThatRightNowMessage callerName]- when (isNothing mAllegiance) $ throwError [allegianceDoesNotExistMessage callerName allegianceName]-- allegianceChosen .= mAllegiance- where- mAllegiance = case T.toLower allegianceName of- "villagers" -> Just Villagers- "werewolves" -> Just Werewolves- _ -> Nothing--choosePlayerCommand :: Text -> Text -> Command-choosePlayerCommand callerName targetName = Command $ do- validatePlayer callerName callerName- unlessM (isPlayerWildChild callerName) $ throwError [playerCannotDoThatMessage callerName]- unlessM isWildChildsTurn $ throwError [playerCannotDoThatRightNowMessage callerName]- when (callerName == targetName) $ throwError [playerCannotChooseSelfMessage callerName]- validatePlayer callerName targetName-- roleModel .= Just targetName--choosePlayersCommand :: Text -> [Text] -> Command-choosePlayersCommand callerName targetNames = Command $ do- whenM isGameOver $ throwError [gameIsOverMessage callerName]- unlessM (doesPlayerExist callerName) $ throwError [playerDoesNotExistMessage callerName callerName]- unlessM (isPlayerScapegoat callerName) $ throwError [playerCannotDoThatMessage callerName]- unlessM isScapegoatsTurn $ throwError [playerCannotDoThatRightNowMessage callerName]- when (null targetNames) $ throwError [playerMustChooseAtLeastOneTargetMessage callerName]- when (callerName `elem` targetNames) $ throwError [playerCannotChooseSelfMessage callerName]- forM_ targetNames $ validatePlayer callerName- whenM (use villageIdiotRevealed &&^ anyM isPlayerVillageIdiot targetNames) $- throwError [playerCannotChooseVillageIdiotMessage callerName]-- allowedVoters .= targetNames- scapegoatBlamed .= False--circleCommand :: Text -> Bool -> Command-circleCommand callerName includeDead = Command $ do- players' <- toListOf (players . traverse . if includeDead then id else alive) <$> get-- tell [circleMessage callerName players']--healCommand :: Text -> Command-healCommand callerName = Command $ do- validateWitchsCommand callerName- whenM (use healUsed) $ throwError [playerHasAlreadyHealedMessage callerName]- whenM (hasn't (events . traverse . _DevourEvent) <$> get) $ throwError [playerCannotDoThatRightNowMessage callerName]-- heal .= True- healUsed .= True- noopCommand :: Command noopCommand = Command $ return () -passDevotedServantsTurnCommand :: Text -> Command-passDevotedServantsTurnCommand callerName = Command $ do- validateDevotedServantsCommand callerName-- passes %= nub . cons callerName--passWitchsTurnCommand :: Text -> Command-passWitchsTurnCommand callerName = Command $ do- validateWitchsCommand callerName-- passes %= nub . cons callerName--pingCommand :: Text -> Command-pingCommand callerName = Command $ use stage >>= \stage' -> case stage' of- DefendersTurn -> do- defender <- findPlayerBy_ role defenderRole-- tell [pingRoleMessage $ defenderRole ^. Role.name]- tell [pingPlayerMessage $ defender ^. name]- DevotedServantsTurn -> do- devotedServant <- findPlayerBy_ role devotedServantRole-- tell [pingRoleMessage $ devotedServantRole ^. Role.name]- tell [pingPlayerMessage $ devotedServant ^. name]- GameOver -> tell [gameIsOverMessage callerName]- Lynching -> return ()- ScapegoatsTurn -> do- scapegoat <- findPlayerBy_ role scapegoatRole-- tell [pingRoleMessage $ scapegoatRole ^. Role.name]- tell [pingPlayerMessage $ scapegoat ^. name]- SeersTurn -> do- seer <- findPlayerBy_ role seerRole-- tell [pingRoleMessage $ seerRole ^. Role.name]- tell [pingPlayerMessage $ seer ^. name]- Sunrise -> return ()- Sunset -> return ()- UrsussGrunt -> return ()- VillagesTurn -> do- allowedVoterNames <- use allowedVoters- pendingVoterNames <- toListOf names <$> getPendingVoters-- tell [waitingOnMessage Nothing $ allowedVoterNames `intersect` pendingVoterNames]- tell $ map pingPlayerMessage (allowedVoterNames `intersect` pendingVoterNames)- WerewolvesTurn -> do- pendingVoters <- getPendingVoters-- tell [pingRoleMessage "Werewolves"]- tell $ map pingPlayerMessage (pendingVoters ^.. werewolves . name)- WildChildsTurn -> do- wildChild <- findPlayerBy_ role wildChildRole-- tell [pingRoleMessage $ wildChildRole ^. Role.name]- tell [pingPlayerMessage $ wildChild ^. name]- WitchsTurn -> do- witch <- findPlayerBy_ role witchRole-- tell [pingRoleMessage $ witchRole ^. Role.name]- tell [pingPlayerMessage $ witch ^. name]- WolfHoundsTurn -> do- wolfHound <- findPlayerBy_ role wolfHoundRole-- tell [pingRoleMessage $ wolfHoundRole ^. Role.name]- tell [pingPlayerMessage $ wolfHound ^. name]--poisonCommand :: Text -> Text -> Command-poisonCommand callerName targetName = Command $ do- validateWitchsCommand callerName- whenM (use poisonUsed) $ throwError [playerHasAlreadyPoisonedMessage callerName]- validatePlayer callerName targetName- whenM (has (events . traverse . _DevourEvent . only targetName) <$> get) $ throwError [playerCannotDoThatMessage callerName]-- poison .= Just targetName- poisonUsed .= True--protectCommand :: Text -> Text -> Command-protectCommand callerName targetName = Command $ do- validatePlayer callerName callerName- unlessM (isPlayerDefender callerName) $ throwError [playerCannotDoThatMessage callerName]- unlessM isDefendersTurn $ throwError [playerCannotDoThatRightNowMessage callerName]- validatePlayer callerName targetName- whenM (has (priorProtect . traverse . only targetName) <$> get) $ throwError [playerCannotProtectSamePlayerTwiceInARowMessage callerName]-- priorProtect .= Just targetName- protect .= Just targetName--quitCommand :: Text -> Command-quitCommand callerName = Command $ do- validatePlayer callerName callerName-- caller <- findPlayerBy_ name callerName-- tell [playerQuitMessage caller]-- removePlayer callerName--revealCommand :: Text -> Command-revealCommand callerName = Command $ do- validateDevotedServantsCommand callerName-- target <- head <$> getVoteResult-- let targetRole = target ^. role- let targetName = target ^. name-- setPlayerRole callerName targetRole- setPlayerRole targetName devotedServantRole-- tell [devotedServantRevealedMessage callerName]-- resetRole targetRole- where- resetRole role- | role == simpleWerewolfRole = do- aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get-- tell $ devotedServantJoinedPackMessages callerName aliveWerewolfNames- | role == villageIdiotRole = villageIdiotRevealed .= False- | role == wildChildRole = roleModel .= Nothing- | role == witchRole = healUsed .= False >> poisonUsed .= False- | role == wolfHoundRole = allegianceChosen .= Nothing- | otherwise = return ()--seeCommand :: Text -> Text -> Command-seeCommand callerName targetName = Command $ do- validatePlayer callerName callerName- unlessM (isPlayerSeer callerName) $ throwError [playerCannotDoThatMessage callerName]- unlessM isSeersTurn $ throwError [playerCannotDoThatRightNowMessage callerName]- validatePlayer callerName targetName-- see .= Just targetName--statusCommand :: Text -> Command-statusCommand callerName = Command $ use stage >>= \stage' -> case stage' of- GameOver -> tell [gameIsOverMessage callerName]- Lynching -> return ()- Sunrise -> return ()- Sunset -> return ()- UrsussGrunt -> return ()- VillagesTurn -> do- allowedVoterNames <- use allowedVoters- pendingVoterNames <- toListOf names <$> getPendingVoters-- tell . standardStatusMessages stage' =<< use players- tell [waitingOnMessage (Just callerName) (allowedVoterNames `intersect` pendingVoterNames)]- WerewolvesTurn -> do- pendingVoterNames <- toListOf (werewolves . name) <$> getPendingVoters-- tell . standardStatusMessages stage' =<< use players- whenM (doesPlayerExist callerName &&^ isPlayerWerewolf callerName) $- tell [waitingOnMessage (Just callerName) pendingVoterNames]- _ -> tell . standardStatusMessages stage' =<< use players- where- standardStatusMessages stage players =- currentStageMessages callerName stage ++- [ rolesInGameMessage (Just callerName) (players ^.. roles)- , playersInGameMessage callerName players- ]--voteDevourCommand :: Text -> Text -> Command-voteDevourCommand callerName targetName = Command $ do- validatePlayer callerName callerName- unlessM (isPlayerWerewolf callerName) $ throwError [playerCannotDoThatMessage callerName]- unlessM isWerewolvesTurn $ throwError [playerCannotDoThatRightNowMessage callerName]- whenM (isJust <$> getPlayerVote callerName) $ throwError [playerHasAlreadyVotedMessage callerName]- validatePlayer callerName targetName- whenM (isPlayerWerewolf targetName) $ throwError [playerCannotDevourAnotherWerewolfMessage callerName]-- votes %= Map.insert callerName targetName-- aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get-- tell [playerMadeDevourVoteMessage werewolfName callerName targetName | werewolfName <- aliveWerewolfNames \\ [callerName]]--voteLynchCommand :: Text -> Text -> Command-voteLynchCommand callerName targetName = Command $ do- validatePlayer callerName callerName- whenM (uses allowedVoters (callerName `notElem`)) $ throwError [playerCannotDoThatMessage callerName]- unlessM isVillagesTurn $ throwError [playerCannotDoThatRightNowMessage callerName]- whenM (isJust <$> getPlayerVote callerName) $ throwError [playerHasAlreadyVotedMessage callerName]- validatePlayer callerName targetName-- votes %= 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]--validateDevotedServantsCommand :: (MonadError [Message] m, MonadState Game m) => Text -> m ()-validateDevotedServantsCommand callerName = do- validatePlayer callerName callerName- unlessM (isPlayerDevotedServant callerName) $ throwError [playerCannotDoThatMessage callerName]- unlessM isDevotedServantsTurn $ throwError [playerCannotDoThatRightNowMessage callerName]--validateWitchsCommand :: (MonadError [Message] m, MonadState Game m) => Text -> m ()-validateWitchsCommand callerName = do- validatePlayer callerName callerName- unlessM (isPlayerWitch callerName) $ throwError [playerCannotDoThatMessage callerName]- unlessM isWitchsTurn $ throwError [playerCannotDoThatRightNowMessage callerName]
+ src/Game/Werewolf/Command/Defender.hs view
@@ -0,0 +1,37 @@+{-|+Module : Game.Werewolf.Command.Defender+Description : Defender commands.++Copyright : (c) Henry J. Wylde, 2016+License : BSD3+Maintainer : public@hjwylde.com++Defender commands.+-}++module Game.Werewolf.Command.Defender (+ -- * Commands+ protectCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.State hiding (state)++import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Messages+import Game.Werewolf.Util++protectCommand :: Text -> Text -> Command+protectCommand callerName targetName = Command $ do+ validatePlayer callerName callerName+ unlessM (isPlayerDefender callerName) $ throwError [playerCannotDoThatMessage callerName]+ unlessM isDefendersTurn $ throwError [playerCannotDoThatRightNowMessage callerName]+ validatePlayer callerName targetName+ whenM (has (priorProtect . traverse . only targetName) <$> get) $ throwError [playerCannotProtectSamePlayerTwiceInARowMessage callerName]++ priorProtect .= Just targetName+ protect .= Just targetName
+ src/Game/Werewolf/Command/DevotedServant.hs view
@@ -0,0 +1,71 @@+{-|+Module : Game.Werewolf.Command.DevotedServant+Description : Devoted Servant commands.++Copyright : (c) Henry J. Wylde, 2016+License : BSD3+Maintainer : public@hjwylde.com++Devoted Servant commands.+-}++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Game.Werewolf.Command.DevotedServant (+ -- * Commands+ passCommand, revealCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.State hiding (state)+import Control.Monad.Writer++import Data.List+import Data.Text (Text)++import Game.Werewolf hiding (getVoteResult)+import Game.Werewolf.Messages+import Game.Werewolf.Util++passCommand :: Text -> Command+passCommand callerName = Command $ do+ validateCommand callerName++ passes %= nub . cons callerName++revealCommand :: Text -> Command+revealCommand callerName = Command $ do+ validateCommand callerName++ target <- head <$> getVoteResult++ let targetRole = target ^. role+ let targetName = target ^. name++ setPlayerRole callerName targetRole+ setPlayerRole targetName devotedServantRole++ tell [devotedServantRevealedMessage callerName]++ resetRole callerName targetRole++validateCommand :: (MonadError [Message] m, MonadState Game m) => Text -> m ()+validateCommand callerName = do+ validatePlayer callerName callerName+ unlessM (isPlayerDevotedServant callerName) $ throwError [playerCannotDoThatMessage callerName]+ unlessM isDevotedServantsTurn $ throwError [playerCannotDoThatRightNowMessage callerName]++resetRole :: (MonadState Game m, MonadWriter [Message] m) => Text -> Role -> m ()+resetRole callerName role+ | role == simpleWerewolfRole = do+ aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get++ tell $ devotedServantJoinedPackMessages callerName (aliveWerewolfNames \\ [callerName])+ | role == villageIdiotRole = villageIdiotRevealed .= False+ | role == wildChildRole = roleModel .= Nothing+ | role == witchRole = healUsed .= False >> poisonUsed .= False+ | role == wolfHoundRole = allegianceChosen .= Nothing+ | otherwise = return ()
+ src/Game/Werewolf/Command/Global.hs view
@@ -0,0 +1,49 @@+{-|+Module : Game.Werewolf.Command.Global+Description : Global commands.++Copyright : (c) Henry J. Wylde, 2016+License : BSD3+Maintainer : public@hjwylde.com++Global commands.+-}++module Game.Werewolf.Command.Global (+ -- * Commands+ bootCommand, quitCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.Writer++import qualified Data.Map as Map+import Data.Maybe+import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Messages+import Game.Werewolf.Util++bootCommand :: Text -> Text -> Command+bootCommand callerName targetName = Command $ do+ validatePlayer callerName callerName+ validatePlayer callerName targetName+ whenM (uses (boots . at targetName) $ elem callerName . fromMaybe []) $+ throwError [playerHasAlreadyVotedToBootMessage callerName targetName]++ boots %= Map.insertWith (++) targetName [callerName]++ tell [playerVotedToBootMessage callerName targetName]++quitCommand :: Text -> Command+quitCommand callerName = Command $ do+ validatePlayer callerName callerName++ caller <- findPlayerBy_ name callerName++ tell [playerQuitMessage caller]++ removePlayer callerName
+ src/Game/Werewolf/Command/Scapegoat.hs view
@@ -0,0 +1,40 @@+{-|+Module : Game.Werewolf.Command.Scapegoat+Description : Scapegoat commands.++Copyright : (c) Henry J. Wylde, 2016+License : BSD3+Maintainer : public@hjwylde.com++Scapegoat commands.+-}++module Game.Werewolf.Command.Scapegoat (+ -- * Commands+ chooseCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra++import Data.Text (Text)++import Game.Werewolf hiding (doesPlayerExist)+import Game.Werewolf.Messages+import Game.Werewolf.Util++chooseCommand :: Text -> [Text] -> Command+chooseCommand callerName targetNames = Command $ do+ whenM isGameOver $ throwError [gameIsOverMessage callerName]+ unlessM (doesPlayerExist callerName) $ throwError [playerDoesNotExistMessage callerName callerName]+ unlessM (isPlayerScapegoat callerName) $ throwError [playerCannotDoThatMessage callerName]+ unlessM isScapegoatsTurn $ throwError [playerCannotDoThatRightNowMessage callerName]+ when (null targetNames) $ throwError [playerMustChooseAtLeastOneTargetMessage callerName]+ when (callerName `elem` targetNames) $ throwError [playerCannotChooseSelfMessage callerName]+ forM_ targetNames $ validatePlayer callerName+ whenM (use villageIdiotRevealed &&^ anyM isPlayerVillageIdiot targetNames) $+ throwError [playerCannotChooseVillageIdiotMessage callerName]++ allowedVoters .= targetNames+ scapegoatBlamed .= False
+ src/Game/Werewolf/Command/Seer.hs view
@@ -0,0 +1,34 @@+{-|+Module : Game.Werewolf.Command.Seer+Description : Seer commands.++Copyright : (c) Henry J. Wylde, 2016+License : BSD3+Maintainer : public@hjwylde.com++Seer commands.+-}++module Game.Werewolf.Command.Seer (+ -- * Commands+ seeCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra++import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Messages+import Game.Werewolf.Util++seeCommand :: Text -> Text -> Command+seeCommand callerName targetName = Command $ do+ validatePlayer callerName callerName+ unlessM (isPlayerSeer callerName) $ throwError [playerCannotDoThatMessage callerName]+ unlessM isSeersTurn $ throwError [playerCannotDoThatRightNowMessage callerName]+ validatePlayer callerName targetName++ see .= Just targetName
+ src/Game/Werewolf/Command/Status.hs view
@@ -0,0 +1,117 @@+{-|+Module : Game.Werewolf.Command.Status+Description : Status commands.++Copyright : (c) Henry J. Wylde, 2016+License : BSD3+Maintainer : public@hjwylde.com++Status commands.+-}++{-# LANGUAGE OverloadedStrings #-}++module Game.Werewolf.Command.Status (+ -- * Commands+ circleCommand, pingCommand, statusCommand,+) where++import Control.Lens+import Control.Monad.Extra+import Control.Monad.State hiding (state)+import Control.Monad.Writer++import Data.List+import Data.Text (Text)++import Game.Werewolf hiding (doesPlayerExist, getPendingVoters)+import Game.Werewolf.Messages+import qualified Game.Werewolf.Role as Role+import Game.Werewolf.Util++circleCommand :: Text -> Bool -> Command+circleCommand callerName includeDead = Command $ do+ players' <- toListOf (players . traverse . if includeDead then id else alive) <$> get++ tell [circleMessage callerName players']++pingCommand :: Text -> Command+pingCommand callerName = Command $ use stage >>= \stage' -> case stage' of+ DefendersTurn -> do+ defender <- findPlayerBy_ role defenderRole++ tell [pingRoleMessage $ defenderRole ^. Role.name]+ tell [pingPlayerMessage $ defender ^. name]+ DevotedServantsTurn -> do+ devotedServant <- findPlayerBy_ role devotedServantRole++ tell [pingRoleMessage $ devotedServantRole ^. Role.name]+ tell [pingPlayerMessage $ devotedServant ^. name]+ GameOver -> tell [gameIsOverMessage callerName]+ Lynching -> return ()+ ScapegoatsTurn -> do+ scapegoat <- findPlayerBy_ role scapegoatRole++ tell [pingRoleMessage $ scapegoatRole ^. Role.name]+ tell [pingPlayerMessage $ scapegoat ^. name]+ SeersTurn -> do+ seer <- findPlayerBy_ role seerRole++ tell [pingRoleMessage $ seerRole ^. Role.name]+ tell [pingPlayerMessage $ seer ^. name]+ Sunrise -> return ()+ Sunset -> return ()+ UrsussGrunt -> return ()+ VillagesTurn -> do+ allowedVoterNames <- use allowedVoters+ pendingVoterNames <- toListOf names <$> getPendingVoters++ tell [waitingOnMessage Nothing $ allowedVoterNames `intersect` pendingVoterNames]+ tell $ map pingPlayerMessage (allowedVoterNames `intersect` pendingVoterNames)+ WerewolvesTurn -> do+ pendingVoters <- getPendingVoters++ tell [pingRoleMessage "Werewolves"]+ tell $ map pingPlayerMessage (pendingVoters ^.. werewolves . name)+ WildChildsTurn -> do+ wildChild <- findPlayerBy_ role wildChildRole++ tell [pingRoleMessage $ wildChildRole ^. Role.name]+ tell [pingPlayerMessage $ wildChild ^. name]+ WitchsTurn -> do+ witch <- findPlayerBy_ role witchRole++ tell [pingRoleMessage $ witchRole ^. Role.name]+ tell [pingPlayerMessage $ witch ^. name]+ WolfHoundsTurn -> do+ wolfHound <- findPlayerBy_ role wolfHoundRole++ tell [pingRoleMessage $ wolfHoundRole ^. Role.name]+ tell [pingPlayerMessage $ wolfHound ^. name]++statusCommand :: Text -> Command+statusCommand callerName = Command $ use stage >>= \stage' -> case stage' of+ GameOver -> tell [gameIsOverMessage callerName]+ Lynching -> return ()+ Sunrise -> return ()+ Sunset -> return ()+ UrsussGrunt -> return ()+ VillagesTurn -> do+ allowedVoterNames <- use allowedVoters+ pendingVoterNames <- toListOf names <$> getPendingVoters++ tell . standardStatusMessages stage' =<< use players+ tell [waitingOnMessage (Just callerName) (allowedVoterNames `intersect` pendingVoterNames)]+ WerewolvesTurn -> do+ pendingVoterNames <- toListOf (werewolves . name) <$> getPendingVoters++ tell . standardStatusMessages stage' =<< use players+ whenM (doesPlayerExist callerName &&^ isPlayerWerewolf callerName) $+ tell [waitingOnMessage (Just callerName) pendingVoterNames]+ _ -> tell . standardStatusMessages stage' =<< use players+ where+ standardStatusMessages stage players =+ currentStageMessages callerName stage +++ [ rolesInGameMessage (Just callerName) (players ^.. roles)+ , playersInGameMessage callerName players+ ]
+ src/Game/Werewolf/Command/Villager.hs view
@@ -0,0 +1,37 @@+{-|+Module : Game.Werewolf.Command.Villager+Description : Villager commands.++Copyright : (c) Henry J. Wylde, 2016+License : BSD3+Maintainer : public@hjwylde.com++Villager commands.+-}++module Game.Werewolf.Command.Villager (+ -- * Commands+ voteCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra++import qualified Data.Map as Map+import Data.Maybe+import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Messages+import Game.Werewolf.Util++voteCommand :: Text -> Text -> Command+voteCommand callerName targetName = Command $ do+ validatePlayer callerName callerName+ whenM (uses allowedVoters (callerName `notElem`)) $ throwError [playerCannotDoThatMessage callerName]+ unlessM isVillagesTurn $ throwError [playerCannotDoThatRightNowMessage callerName]+ whenM (isJust <$> getPlayerVote callerName) $ throwError [playerHasAlreadyVotedMessage callerName]+ validatePlayer callerName targetName++ votes %= Map.insert callerName targetName
+ src/Game/Werewolf/Command/Werewolf.hs view
@@ -0,0 +1,48 @@+{-|+Module : Game.Werewolf.Command.Werewolf+Description : Werewolf commands.++Copyright : (c) Henry J. Wylde, 2016+License : BSD3+Maintainer : public@hjwylde.com++Werewolf commands.+-}++module Game.Werewolf.Command.Werewolf (+ -- * Commands+ voteCommand,++ -- ** Validation+ validatePlayer,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.State hiding (state)+import Control.Monad.Writer++import Data.List+import qualified Data.Map as Map+import Data.Maybe+import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Messages+import Game.Werewolf.Util++voteCommand :: Text -> Text -> Command+voteCommand callerName targetName = Command $ do+ validatePlayer callerName callerName+ unlessM (isPlayerWerewolf callerName) $ throwError [playerCannotDoThatMessage callerName]+ unlessM isWerewolvesTurn $ throwError [playerCannotDoThatRightNowMessage callerName]+ whenM (isJust <$> getPlayerVote callerName) $ throwError [playerHasAlreadyVotedMessage callerName]+ validatePlayer callerName targetName+ whenM (isPlayerWerewolf targetName) $ throwError [playerCannotDevourAnotherWerewolfMessage callerName]++ votes %= Map.insert callerName targetName++ aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get++ tell [playerMadeDevourVoteMessage werewolfName callerName targetName | werewolfName <- aliveWerewolfNames \\ [callerName]]
+ src/Game/Werewolf/Command/WildChild.hs view
@@ -0,0 +1,35 @@+{-|+Module : Game.Werewolf.Command.WildChild+Description : Wild-child commands.++Copyright : (c) Henry J. Wylde, 2016+License : BSD3+Maintainer : public@hjwylde.com++Wild-child commands.+-}++module Game.Werewolf.Command.WildChild (+ -- * Commands+ chooseCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra++import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Messages+import Game.Werewolf.Util++chooseCommand :: Text -> Text -> Command+chooseCommand callerName targetName = Command $ do+ validatePlayer callerName callerName+ unlessM (isPlayerWildChild callerName) $ throwError [playerCannotDoThatMessage callerName]+ unlessM isWildChildsTurn $ throwError [playerCannotDoThatRightNowMessage callerName]+ when (callerName == targetName) $ throwError [playerCannotChooseSelfMessage callerName]+ validatePlayer callerName targetName++ roleModel .= Just targetName
+ src/Game/Werewolf/Command/Witch.hs view
@@ -0,0 +1,61 @@+{-|+Module : Game.Werewolf.Command.Witch+Description : Witch commands.++Copyright : (c) Henry J. Wylde, 2016+License : BSD3+Maintainer : public@hjwylde.com++Witch commands.+-}++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Game.Werewolf.Command.Witch (+ -- * Commands+ healCommand, passCommand, poisonCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra+import Control.Monad.State hiding (state)++import Data.List+import Data.Text (Text)++import Game.Werewolf+import Game.Werewolf.Messages+import Game.Werewolf.Util++healCommand :: Text -> Command+healCommand callerName = Command $ do+ validateCommand callerName+ whenM (use healUsed) $ throwError [playerHasAlreadyHealedMessage callerName]+ whenM (hasn't (events . traverse . _DevourEvent) <$> get) $ throwError [playerCannotDoThatRightNowMessage callerName]++ heal .= True+ healUsed .= True++passCommand :: Text -> Command+passCommand callerName = Command $ do+ validateCommand callerName++ passes %= nub . cons callerName++poisonCommand :: Text -> Text -> Command+poisonCommand callerName targetName = Command $ do+ validateCommand callerName+ whenM (use poisonUsed) $ throwError [playerHasAlreadyPoisonedMessage callerName]+ validatePlayer callerName targetName+ whenM (has (events . traverse . _DevourEvent . only targetName) <$> get) $ throwError [playerCannotDoThatMessage callerName]++ poison .= Just targetName+ poisonUsed .= True++validateCommand :: (MonadError [Message] m, MonadState Game m) => Text -> m ()+validateCommand callerName = do+ validatePlayer callerName callerName+ unlessM (isPlayerWitch callerName) $ throwError [playerCannotDoThatMessage callerName]+ unlessM isWitchsTurn $ throwError [playerCannotDoThatRightNowMessage callerName]
+ src/Game/Werewolf/Command/WolfHound.hs view
@@ -0,0 +1,43 @@+{-|+Module : Game.Werewolf.Command.WolfHound+Description : Wolf-hound commands.++Copyright : (c) Henry J. Wylde, 2016+License : BSD3+Maintainer : public@hjwylde.com++Wolf-hound commands.+-}++{-# LANGUAGE OverloadedStrings #-}++module Game.Werewolf.Command.WolfHound (+ -- * Commands+ chooseCommand,+) where++import Control.Lens+import Control.Monad.Except+import Control.Monad.Extra++import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as T++import Game.Werewolf+import Game.Werewolf.Messages+import Game.Werewolf.Util++chooseCommand :: Text -> Text -> Command+chooseCommand callerName allegianceName = Command $ do+ validatePlayer callerName callerName+ unlessM (isPlayerWolfHound callerName) $ throwError [playerCannotDoThatMessage callerName]+ unlessM isWolfHoundsTurn $ throwError [playerCannotDoThatRightNowMessage callerName]+ when (isNothing mAllegiance) $ throwError [allegianceDoesNotExistMessage callerName allegianceName]++ allegianceChosen .= mAllegiance+ where+ mAllegiance = case T.toLower allegianceName of+ "villagers" -> Just Villagers+ "werewolves" -> Just Werewolves+ _ -> Nothing
src/Game/Werewolf/Engine.hs view
@@ -124,7 +124,7 @@ whenJustM (use roleModel) $ \roleModelsName -> do wildChild <- findPlayerBy_ role wildChildRole - whenM (isPlayerDead roleModelsName &&^ return (is villager wildChild)) $ do+ whenM (isPlayerDead roleModelsName &&^ return (is alive wildChild) &&^ return (is villager wildChild)) $ do aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get setPlayerAllegiance (wildChild ^. name) Werewolves@@ -255,7 +255,6 @@ startGame callerName players = do when (playerNames /= nub playerNames) $ throwError [privateMessage callerName "Player names must be unique."] when (length players < 7) $ throwError [privateMessage callerName "Must have at least 7 players."]- when (length players > 24) $ throwError [privateMessage callerName "Cannot have more than 24 players."] forM_ restrictedRoles $ \role' -> when (length (players ^.. traverse . filteredBy role role') > 1) $ throwError [privateMessage callerName $ T.concat ["Cannot have more than 1 ", role' ^. Role.name, "."]]
src/Game/Werewolf/Messages.hs view
@@ -10,7 +10,7 @@ defines suite of messages used throughout the werewolf game, including both game play messages and binary errors. -@werewolf@ was designed to be ambivalent to the calling chat client. The response-message structure+@werewolf@ was designed to be ambivalent to the playing chat client. The response-message structure reflects this by staying away from anything that could be construed as client-specific. This includes features such as emoji support. -}@@ -131,6 +131,7 @@ newPlayerMessage player = privateMessage (player ^. name) $ T.intercalate "\n" [ T.concat ["You're ", article playerRole, " ", playerRole ^. Role.name, "."] , playerRole ^. description+ , playerRole ^. rules ] where playerRole = player ^. role@@ -184,7 +185,9 @@ devotedServantsTurnMessages to victimsName = [ publicMessage "The Devoted Servant ponders." , privateMessage to $ T.concat- ["Would you like to `reveal` yourself and take on ", victimsName, "'s role?"]+ [ "Would you like to `reveal` yourself and take on ", victimsName, "'s role?"+ , " (Or you can type `pass`.)"+ ] ] scapegoatsTurnMessages :: Text -> [Message]@@ -236,7 +239,7 @@ werewolvesTurnMessages :: [Text] -> [Message] werewolvesTurnMessages tos =- publicMessage "The Werewolves wake up, recognise one another and choose a new victim."+ publicMessage "The Werewolves wake up, transform and choose a new victim." : groupMessages tos "Whom would you like to `vote` to devour?" wildChildsTurnMessages :: Text -> [Message]@@ -365,7 +368,7 @@ playerBootedMessage :: Player -> Message playerBootedMessage player = publicMessage $ T.unwords- [ playerName, article playerRole, playerRole ^. Role.name+ [ playerName, "the", playerRole ^. Role.name , "has been booted from the game!" ] where@@ -458,7 +461,7 @@ ursusGruntsMessage :: Message ursusGruntsMessage = publicMessage $ T.unwords [ "Ursus wakes from his slumber, disturbed and on edge."- , "He loudly grunts as if he smells danger."+ , "He loudly grunts as he smells danger." ] playerCannotProtectSamePlayerTwiceInARowMessage :: Text -> Message@@ -467,22 +470,28 @@ devotedServantRevealedMessage :: Text -> Message devotedServantRevealedMessage devotedServantsName = publicMessage $ T.unwords- [ devotedServantsName, " the stands up in horror."+ [ devotedServantsName, "stands up in horror." , "Determined to not let their master's abilities be lost forever," , "she selflessly takes on their role." ] devotedServantJoinedPackMessages :: Text -> [Text] -> [Message] devotedServantJoinedPackMessages devotedServantsName werewolfNames =- -- TODO (hjw): what if the pack's empty?- privateMessage devotedServantsName (T.unwords- [ "Upon learning your master was a Werewolf, you head towards the woods to learn more about his home and family."- , "As you enter you see his pack", T.intercalate ", " werewolfNames- , "waiting for you."- ])+ privateMessage devotedServantsName (T.unwords $ masterWasWerewolfMessage:packMessages) : groupMessages werewolfNames (T.unwords [ devotedServantsName, "heads towards the woods in search of his master's home and family." ])+ where+ masterWasWerewolfMessage = T.unwords+ [ "Upon learning your master was a Werewolf,"+ , "you head towards the woods to learn more about his home and family."+ ]+ packMessages+ | null werewolfNames = []+ | otherwise = [T.unwords+ [ "As you enter you see his pack", T.intercalate ", " werewolfNames+ , "waiting for you."+ ]] scapegoatChoseAllowedVotersMessage :: [Text] -> Message scapegoatChoseAllowedVotersMessage allowedVoters = publicMessage $ T.unwords@@ -571,7 +580,7 @@ noPlayerDevouredMessage :: Message noPlayerDevouredMessage = publicMessage $ T.unwords [ "Surprisingly you see everyone present at the town square."- , "Perhaps the Werewolves have left Miller's Hollow?"+ , "Perhaps the Werewolves have left Fougères?" ] playerCannotDevourAnotherWerewolfMessage :: Text -> Message
src/Game/Werewolf/Response.hs view
@@ -9,7 +9,7 @@ A response is used as a return result of calling the @werewolf@ binary. Each response has a list of associated messages. -@werewolf@ was designed to be ambivalent to the calling chat client. The response-message structure+@werewolf@ was designed to be ambivalent to the playing chat client. The response-message structure reflects this by staying away from anything that could be construed as client-specific. This includes features such as emoji support. -}@@ -48,9 +48,9 @@ -- | When a user sends a command to the @werewolf@ binary, a response is always returned. ----- The chat client interface should then relay any @messages@ from the response. Whether or not--- the command was valid (indicated by the @ok@ flag) is often irrelevant as the returned--- @messages@ will include errors to the user.+-- The chat interface should then relay any @messages@ from the response. Whether or not the+-- command was valid (indicated by the @ok@ flag) is often irrelevant as the returned @messages@+-- will include errors to the user. data Response = Response { ok :: Bool -- ^ Boolean flag to indicate success. , messages :: [Message] -- ^ List of messages.
src/Game/Werewolf/Role.hs view
@@ -21,7 +21,7 @@ module Game.Werewolf.Role ( -- * Role Role,- name, allegiance, balance, description, advice,+ name, allegiance, balance, description, rules, Allegiance(..), _Angel, _Villagers, _Werewolves,@@ -31,31 +31,29 @@ allAllegiances, -- *** The Ambiguous- -- | They could very well be allies of the village or become its enemies. During the game, they- -- can change sides or characters.+ -- | No-one knows the true nature of the Ambiguous, sometimes not even the Ambiguous themselves! --- -- The Ambiguous must aid their side to achieve victory.+ -- The Ambiguous are able to change allegiance throughout the game. devotedServantRole, wildChildRole, wolfHoundRole, -- *** The Loners- -- | Their past could no doubt reveal to us why they hate the inhabitants of Miller's Hollow.- -- One thing is known for sure: they really scare everyone!- --- -- The Loners have their own objectives, no matter which side they're on.+ -- | The Loners look out for themselves and themselves alone.++ -- The Loners must complete their own objective. angelRole, -- *** The Villagers- -- | Attached to the village's survival, the following characters defend its harmony with- -- determination. Faced with various menaces, they will be brought to eliminate those they- -- suspect of being too dangerous, even if that might be painful to them.- --+ -- | Fraught with fear of the unseen enemy, the Villagers must work together to determine the+ -- truth and eliminate the threat to Fougères. The task before them will not be easy, but a+ -- certain few have learnt some tricks over the years that may turn out rather useful.+ -- The Villagers must lynch all of the Werewolves. bearTamerRole, defenderRole, scapegoatRole, seerRole, simpleVillagerRole, villageIdiotRole, villagerVillagerRole, witchRole, -- *** The Werewolves- -- | They can be lethally dangerous and put in doubt the village's survival.- --+ -- | Hiding in plain sight, the Werewolves are not a small trifle.+ -- The Werewolves must devour all of the Villagers. simpleWerewolfRole, @@ -86,7 +84,7 @@ , _allegiance :: Allegiance , _balance :: Int , _description :: Text- , _advice :: Text+ , _rules :: Text } deriving (Read, Show) -- | The Loner allegiances are seldom used, rather they are present for correctness.@@ -136,23 +134,25 @@ -- /masters? Don't rejoice too fast, as the devouring ambition within her could spell the end of/ -- /the village!/ ----- Before the revelation of the card of the player eliminated by the village's vote, she can--- reveal herself by showing her card and taking on the role of the eliminated player.+-- Before the revelation of the card of the player eliminated by the village's vote, the Devoted+-- Servant can reveal herself by showing her card and taking on the role of the eliminated player.+-- Upon taking on her master's role, any special abilities are reset and any first turns are+-- replayed. devotedServantRole :: Role devotedServantRole = Role { _name = "Devoted Servant" , _allegiance = Villagers- , _balance = 1+ , _balance = 2 , _description = T.unwords [ "Who could dream of a better servant than one willing to give up her life for that of her"- , "masters?"- , "Don't rejoice too fast,"- , "as the devouring ambition within her could spell the end of the village!"+ , "masters? Don't rejoice too fast, as the devouring ambition within her could spell the"+ , "end of the village!" ]- , _advice = T.unwords- [ "Think twice before trying to take on the role of a Werewolf."- , "If people strongly believed your master as such,"- , "then they will be quick to point fingers at you too!"+ , _rules = T.unwords+ [ "Before the revelation of the card of the player eliminated by the village's vote, the"+ , "Devoted Servant can reveal herself by showing her card and taking on the role of the"+ , "eliminated player. Upon taking on her master's role, any special abilities are reset and"+ , "any first turns are replayed." ] } @@ -175,22 +175,22 @@ , _allegiance = Villagers , _balance = -1 , _description = T.unwords- [ "Abandoned in the woods by his parents at a young age, he was raised by wolves."- , "As soon as he learned how to walk on all fours,"- , "the Wild-child began to wander around Miller's Hollow."- , "One day, fascinated by an inhabitant of the village who was walking upright"- , "with grace and presence, he made them his secret role model."- , "He then decided to integrate himself into the community of Miller's Hollow and entered,"- , "worried, in the village."- , "The community was moved by his frailty, adopted him, and welcomed him in their fold."- , "What will become of him: honest Villager or terrible Werewolf?"- , "For all of his life,"- , "the heart of the Wild-child will swing between these two alternatives."- , "May his model confirm him in his newfound humanity."+ [ "Abandoned in the woods by his parents at a young age, he was raised by wolves. As soon"+ , "as he learned how to walk on all fours, the Wild-child began to wander around Miller's"+ , "Hollow. One day, fascinated by an inhabitant of the village who was walking upright"+ , "with grace and presence, he made them his secret role model. He then decided to"+ , "integrate himself into the community of Miller's Hollow and entered, worried, in the"+ , "village. The community was moved by his frailty, adopted him, and welcomed him in their"+ , "fold. What will become of him: honest Villager or terrible Werewolf? For all of his"+ , "life, the heart of the Wild-child will swing between these two alternatives. May his"+ , "model confirm him in his newfound humanity." ]- , _advice = T.unwords- [ "Nothing is keeping you from taking part in the elimination of your role model,"- , "if you so wish..."+ , _rules = T.unwords+ [ "On the first night, the Wild-child may choose a player to become his role model. If"+ , "during the game the chosen player is eliminated, the Wild-child becomes a Werewolf. He"+ , "will then wake up the next night with his peers and will devour with them each night"+ , "until the end of the game. However for as long as the Wild-child's role model is alive,"+ , "he remains a Villager." ] } @@ -199,22 +199,23 @@ -- /companions. In any case, only the Wolf-hound can decide if he'll obey his human and civilized/ -- /master or if he'll listen to the call of wild nature buried within him./ ----- On the first night, he chooses if he wants to be a Simple Villager or Werewolf. The choice is--- final.+-- On the first night, the Wolf-hound chooses if he wants to be a Simple Villager or Werewolf. The+-- choice is final. wolfHoundRole :: Role wolfHoundRole = Role { _name = "Wolf-hound" , _allegiance = Villagers , _balance = -1 , _description = T.unwords- [ "All dogs know in the depths of their soul that their ancestors were wolves"- , "and that it's mankind who has kept them in the state of childishness and fear,"- , "the faithful and generous companions."- , "In any case, only the Wolf-hound can decide if he'll obey his human and civilized master"- , "or if he'll listen to the call of wild nature buried within him."+ [ "All dogs know in the depths of their soul that their ancestors were wolves and that it's"+ , "mankind who has kept them in the state of childishness and fear, the faithful and"+ , "generous companions. In any case, only the Wolf-hound can decide if he'll obey his human"+ , "and civilized master or if he'll listen to the call of wild nature buried within him." ]- , _advice =- "The choice of being a Simple Villager or Werewolf is final, so decide carefully!"+ , _rules = T.unwords+ [ "On the first night, the Wolf-hound chooses if he wants to be a Simple Villager or"+ , "Werewolf. The choice is final."+ ] } -- | /The muddy life of a village infested with evil creatures repulses him; he wishes to believe/@@ -231,14 +232,19 @@ , _allegiance = Angel , _balance = 0 , _description = T.unwords- [ "The muddy life of a village infested with evil creatures repulses him;"- , "he wishes to believe he's the victim of a terrible nightmare,"- , "in order to finally wake up in his comfortable bed."+ [ "The muddy life of a village infested with evil creatures repulses him; he wishes to"+ , "believe he's the victim of a terrible nightmare, in order to finally wake up in his"+ , "comfortable bed." ]- , _advice = T.unwords- [ "It's going to take all your guile and wits to con the village into eliminating you."- , "Pretending to be a Werewolf is one tactic, but if it doesn't work then you may have just"- , "dug yourself a hole for the rest of the game..."+ , _rules = T.intercalate "\n"+ [ T.unwords+ [ "When the Angel is in play, the game always begins with the village's debate followed"+ , "by an elimination vote, and then the first night."+ ]+ , T.unwords+ [ "The Angel wins if he manages to get eliminated on the first round (day or night). If"+ , "he fails, then he becomes a Simple Villager for the rest of the game."+ ] ] } @@ -257,20 +263,25 @@ , _allegiance = Villagers , _balance = 2 , _description = T.unwords- [ "Ah! How sweet it is, in my memory, the sound of chains slipping onto the cobblestones"- , "of the \"Three Road\" plaza, accompanied by the grunting of Ursus."- , "Ah! How long ago it was that Titan, the Bear Tamer, would lead his companion in a ballet"- , "so gravious that we'd cry every summer in Miller's Hollow."- , "Ursus even had the oh-so-previous ability to detect lycanthropes hidden near him."+ [ "Ah! How sweet it is, in my memory, the sound of chains slipping onto the cobblestones of"+ , "the \"Three Road\" plaza, accompanied by the grunting of Ursus. Ah! How long ago it was"+ , "that Titan, the Bear Tamer, would lead his companion in a ballet so gravious that we'd"+ , "cry every summer in Miller's Hollow. Ursus even had the oh-so-previous ability to detect"+ , "lycanthropes hidden near him." ]- , _advice =- "Aren't you lucky to have a companion with a strong nose. Just don't let him wander off!"+ , _rules = T.unwords+ [ "Each morning, right after the revelation of any possible nocturnal victims, if at least"+ , "one Werewolf is or ends up directly next to the Bear Tamer, then Ursus grunts to"+ , "indicate danger to all of the other players."+ ] } -- | /This character can save the Villagers from the bite of the Werewolves./ -- -- Each night the Defender is called before the Werewolves to select a player deserving of his -- protection. That player is safe during the night (and only that night) against the Werewolves.+--+-- The Defender may not protect the same person two nights in a row. defenderRole :: Role defenderRole = Role { _name = "Defender"@@ -278,9 +289,13 @@ , _balance = 2 , _description = "This character can save the Villagers from the bite of the Werewolves."- , _advice = T.unwords- [ "Be careful: you can protect yourself,"- , "but you're not allowed to protect the same player two nights in a row."+ , _rules = T.intercalate "\n"+ [ T.unwords+ [ "Each night the Defender is called before the Werewolves to select a player deserving"+ , "of his protection. That player is safe during the night (and only that night)"+ , "against the Werewolves."+ ]+ , "The Defender may not protect the same person two nights in a row." ] } @@ -297,53 +312,61 @@ , _allegiance = Villagers , _balance = 0 , _description = T.unwords- [ "It's sad to say, but in Miller's Hollow, when something doesn't go right"- , "it's always him who unjustly suffers the consequences."+ [ "It's sad to say, but in Miller's Hollow, when something doesn't go right it's always him"+ , "who unjustly suffers the consequences." ]- , _advice = T.unwords- [ "Cross your fingers that the votes don't end up tied."- , "If you do so happen to be that unlucky,"- , "then be wary of whom you allow to vote on the next day."- , "If you choose only one player and the Werewolves devour them in the night,"- , "then there will be no village vote."+ , _rules = T.intercalate "\n"+ [ T.unwords+ [ "If the village's vote ends in a tie, it's the Scapegoat who is eliminated instead of"+ , "no-one."+ ]+ , T.unwords+ [ "In this event, the Scapegoat has one last task to complete: he must choose whom is"+ , "permitted to vote or not on the next day."+ ] ] } --- | /A fortunate teller by other names, with the ability to see into fellow townsfolk and/--- /determine their allegiance./+-- | /Frequently misunderstood and thought to be a fortune teller, the Seer has the ability to see/+-- /into fellow townsfolk and determine their true nature. This ability to see is not given out/+-- /lightly, for certain it is a gift! Visions will always be true, but only for the present as/+-- /not even the Seer knowns what the future holds./ ----- Each night the Seer sees the allegiance of a player of her choice.+-- Each night the Seer sees the allegiance of a player of their choice. seerRole :: Role seerRole = Role { _name = "Seer" , _allegiance = Villagers , _balance = 2 , _description = T.unwords- [ "A fortunate teller by other names, with the ability to see into fellow"- , "townsfolk and determine their allegiance."- ]- , _advice = T.unwords- [ "You should help the other Villagers,"- , "but try to remain discreet so as to not arouse suspicion from any of the Werewolves."+ [ "Frequently misunderstood and thought to be a fortune teller, the Seer has the ability to"+ , "see into fellow townsfolk and determine their true nature. This ability to see is not"+ , "given out lightly, for certain it is a gift! Visions will always be true, but only for"+ , "the present as not even the Seer knowns what the future holds." ]+ , _rules = "Each night the Seer sees the allegiance of a player of their choice." } --- | /A simple, ordinary townsperson in every way. Their only weapons are the ability to analyze/--- /behaviour to identify Werewolves, and the strength of their conviction to prevent the/--- /execution of the innocents like themselves./+-- | /A simple, ordinary townsperson in every way. Some may be cobblers, others bakers or even/+-- /nobles. No matter their differences though, the plight of Werewolves in Fougères unites them/+-- /in this unfortunate time./+--+-- A Simple Villager has no special abilities, they must use their guile to determine whom among+-- them is not who they say they are. simpleVillagerRole :: Role simpleVillagerRole = Role { _name = "Simple Villager" , _allegiance = Villagers , _balance = 1 , _description = T.unwords- [ "A simple, ordinary townsperson in every way."- , "Their only weapons are the ability to analyze behaviour to identify Werewolves,"- , "and the strength of their conviction to prevent"- , "the execution of the innocents like themselves."+ [ "A simple, ordinary townsperson in every way. Some may be cobblers, others bakers or even"+ , "nobles. No matter their differences though, the plight of Werewolves in Fougères unites"+ , "them in this unfortunate time." ]- , _advice =- "Bluffing can be a good technique, but you had better be convincing about what you say."+ , _rules = T.unwords+ [ "A Simple Villager has no special abilities, they must use their guile to determine whom"+ , "among them is not who they say they are."+ ] } -- | /What is a village without an idiot? He does pretty much nothing important, but he's so/@@ -360,12 +383,19 @@ , _allegiance = Villagers , _balance = 0 , _description = T.unwords- [ "What is a village without an idiot?"- , "He does pretty much nothing important,"- , "but he's so charming that no one would want to hurt him."+ [ "What is a village without an idiot? He does pretty much nothing important, but he's so"+ , "charming that no one would want to hurt him." ]- , _advice =- "Hah! As if advice would do you any good..."+ , _rules = T.intercalate "\n"+ [ T.unwords+ [ "If the village votes against the Village Idiot, his identity is revealed. At that"+ , "moment the Villagers understand their mistake and immediately let him be."+ ]+ , T.unwords+ [ "The Village Idiot continues to play but may no longer vote, as what would the vote"+ , "of an idiot be worth?"+ ]+ ] } -- | /This person has a soul as clear and transparent as the water from a mountain stream. They/@@ -381,10 +411,13 @@ , _balance = 2 , _description = T.unwords [ "This person has a soul as clear and transparent as the water from a mountain stream."- , "They will deserve the attentive ear of their peers"- , "and will make their word decisive in crucial moments."+ , "They will deserve the attentive ear of their peers and will make their word decisive in"+ , "crucial moments." ]- , _advice = "You'll make friends quickly, but be wary about whom you trust."+ , _rules = T.unwords+ [ "When the game begins, the village is told the identity of the Villager-Villager, thus"+ , "ensuring certainty that its owner is truly an innocent Villager."+ ] } -- | /She knows how to brew two extremely powerful potions: a healing potion, to resurrect the/@@ -398,18 +431,20 @@ , _allegiance = Villagers , _balance = 3 , _description = T.unwords- [ "She knows how to brew two extremely powerful potions:"- , "a healing potion, to resurrect the player devoured by the Werewolves,"- , "and a poison potion, used at night to eliminate a player."+ [ "She knows how to brew two extremely powerful potions: a healing potion, to resurrect the"+ , "player devoured by the Werewolves, and a poison potion, used at night to eliminate a"+ , "player." ]- , _advice = T.unwords- [ "Each potion may only be used once per game,"- , "but there are no restrictions on using both of your potions in the same night."+ , _rules = T.unwords+ [ "The Witch is called after the Werewolves. She is allowed to use both potions in the same"+ , "night and is also allowed to heal herself." ] } --- | /Each night they devour a Villager. During the day they try to hide their nocturnal identity/--- /to avoid mob justice./+-- | /It's difficult to tell, but a Werewolf is merely a Villager underneath; unfortunately one/+-- /that has been afflicted with lycanthropy and consequently transforms each night into a/+-- /fearsome lupine. Not all hope is yet lost, some Villagers would like to try and cure the/+-- /curse of lycanthropy. Perhaps one day this dream will be realised./ -- -- A Werewolf may never devour another Werewolf. simpleWerewolfRole :: Role@@ -418,11 +453,12 @@ , _allegiance = Werewolves , _balance = -4 , _description = T.unwords- [ "Each night they devour a Villager."- , "During the day they try to hide their nocturnal identity to avoid mob justice."+ [ "It's difficult to tell, but a Werewolf is merely a Villager underneath; unfortunately"+ , "one that has been afflicted with lycanthropy and consequently transforms each night into"+ , "a fearsome lupine. Not all hope is yet lost, some Villagers would like to try and cure"+ , "the curse of lycanthropy. Perhaps one day this dream will be realised." ]- , _advice =- "Voting to lynch your partner can be a good way to deflect suspicion from yourself."+ , _rules = "A Werewolf may never devour another Werewolf." } -- | The counter-part to 'isn't', but more general as it takes a 'Getting' instead.
test/app/Main.hs view
@@ -16,9 +16,10 @@ import Game.Werewolf.Test.Player import Test.Tasty+import Test.Tasty.QuickCheck main :: IO ()-main = defaultMain =<< tests+main = defaultMain . localOption (QuickCheckTests 20) =<< tests tests :: IO TestTree tests = return . testGroup "Tests" $ concat
test/src/Game/Werewolf/Test/Arbitrary.hs view
@@ -30,11 +30,11 @@ -- * Contextual arbitraries -- ** Command- arbitraryCommand, arbitraryChooseAllegianceCommand, arbitraryChoosePlayerCommand,- arbitraryChoosePlayersCommand, arbitraryHealCommand, arbitraryPassDevotedServantsTurnCommand,- arbitraryPassWitchsTurnCommand, arbitraryPoisonCommand, arbitraryProtectCommand,- arbitraryQuitCommand, arbitraryRevealCommand, arbitrarySeeCommand, arbitraryVoteDevourCommand,- arbitraryVoteLynchCommand,+ arbitraryCommand, arbitraryWolfHoundChooseCommand, arbitraryWildChildChooseCommand,+ arbitraryScapegoatChooseCommand, arbitraryHealCommand, arbitraryDevotedServantPassCommand,+ arbitraryWitchPassCommand, arbitraryPoisonCommand, arbitraryProtectCommand,+ arbitraryQuitCommand, arbitraryRevealCommand, arbitrarySeeCommand, arbitraryWerewolfVoteCommand,+ arbitraryVillagerVoteCommand, runArbitraryCommands, -- ** Player@@ -48,11 +48,17 @@ import Data.Text (Text) import qualified Data.Text as T -import Game.Werewolf.Command-import Game.Werewolf.Engine (checkStage)-import Game.Werewolf.Game-import Game.Werewolf.Player-import Game.Werewolf.Role hiding (name)+import Game.Werewolf+import Game.Werewolf.Command.Defender+import Game.Werewolf.Command.DevotedServant as DevotedServant+import Game.Werewolf.Command.Global+import Game.Werewolf.Command.Scapegoat as Scapegoat+import Game.Werewolf.Command.Seer+import Game.Werewolf.Command.Villager as Villager+import Game.Werewolf.Command.Werewolf as Werewolf+import Game.Werewolf.Command.WildChild as WildChild+import Game.Werewolf.Command.Witch as Witch+import Game.Werewolf.Command.WolfHound as WolfHound import Game.Werewolf.Test.Util import Prelude hiding (round)@@ -205,7 +211,7 @@ instance Arbitrary GameWithAllegianceChosen where arbitrary = do (GameAtWolfHoundsTurn game) <- arbitrary- (Blind command) <- arbitraryChooseAllegianceCommand game+ (Blind command) <- arbitraryWolfHoundChooseCommand game return $ GameWithAllegianceChosen (run_ (apply command) game) @@ -215,7 +221,7 @@ instance Arbitrary GameWithAllowedVoters where arbitrary = do (GameAtScapegoatsTurn game) <- arbitrary- (Blind command) <- arbitraryChoosePlayersCommand game+ (Blind command) <- arbitraryScapegoatChooseCommand game return $ GameWithAllowedVoters (run_ (apply command) game) @@ -315,7 +321,7 @@ instance Arbitrary GameWithPassAtDevotedServantsTurn where arbitrary = do (GameAtDevotedServantsTurn game) <- arbitrary- (Blind command) <- arbitraryPassDevotedServantsTurnCommand game+ (Blind command) <- arbitraryDevotedServantPassCommand game return $ GameWithPassAtDevotedServantsTurn (run_ (apply command) game) @@ -326,7 +332,7 @@ arbitrary = do game <- arbitrary let game' = game & stage .~ WitchsTurn- (Blind command) <- arbitraryPassWitchsTurnCommand game'+ (Blind command) <- arbitraryWitchPassCommand game' return $ GameWithPassAtWitchsTurn (run_ (apply command) game') @@ -368,7 +374,7 @@ instance Arbitrary GameWithRoleModel where arbitrary = do (GameAtWildChildsTurn game) <- arbitrary- (Blind command) <- arbitraryChoosePlayerCommand game+ (Blind command) <- arbitraryWildChildChooseCommand game let game' = run_ (apply command) game return $ GameWithRoleModel game'@@ -415,7 +421,7 @@ arbitraryPlayerSet :: Gen [Player] arbitraryPlayerSet = do- n <- choose (14, 24)+ n <- choose (14, 30) players <- nubOn (view name) <$> infiniteList let playersWithRestrictedRole = map (\role' -> players ^?! traverse . filteredBy role role') restrictedRoles@@ -429,46 +435,46 @@ arbitraryCommand game = case game ^. stage of DefendersTurn -> arbitraryProtectCommand game DevotedServantsTurn -> oneof- [ arbitraryPassDevotedServantsTurnCommand game+ [ arbitraryDevotedServantPassCommand game , arbitraryRevealCommand game ] GameOver -> return $ Blind noopCommand Lynching -> return $ Blind noopCommand- ScapegoatsTurn -> arbitraryChoosePlayersCommand game+ ScapegoatsTurn -> arbitraryScapegoatChooseCommand game SeersTurn -> arbitrarySeeCommand game Sunrise -> return $ Blind noopCommand Sunset -> return $ Blind noopCommand UrsussGrunt -> return $ Blind noopCommand- VillagesTurn -> arbitraryVoteLynchCommand game- WerewolvesTurn -> arbitraryVoteDevourCommand game- WildChildsTurn -> arbitraryChoosePlayerCommand game+ VillagesTurn -> arbitraryVillagerVoteCommand game+ WerewolvesTurn -> arbitraryWerewolfVoteCommand game+ WildChildsTurn -> arbitraryWildChildChooseCommand game WitchsTurn -> oneof [ arbitraryHealCommand game- , arbitraryPassWitchsTurnCommand game+ , arbitraryWitchPassCommand game , arbitraryPoisonCommand game ]- WolfHoundsTurn -> arbitraryChooseAllegianceCommand game+ WolfHoundsTurn -> arbitraryWolfHoundChooseCommand game -arbitraryChooseAllegianceCommand :: Game -> Gen (Blind Command)-arbitraryChooseAllegianceCommand game = do+arbitraryWolfHoundChooseCommand :: Game -> Gen (Blind Command)+arbitraryWolfHoundChooseCommand game = do let wolfHoundsName = game ^?! players . wolfHounds . name allegianceName <- elements $ map (T.pack . show) [Villagers, Werewolves] - return . Blind $ chooseAllegianceCommand wolfHoundsName allegianceName+ return . Blind $ WolfHound.chooseCommand wolfHoundsName allegianceName -arbitraryChoosePlayerCommand :: Game -> Gen (Blind Command)-arbitraryChoosePlayerCommand game = do+arbitraryWildChildChooseCommand :: Game -> Gen (Blind Command)+arbitraryWildChildChooseCommand game = do let wildChild = game ^?! players . wildChildren target <- suchThat (arbitraryPlayer game) (wildChild /=) - return . Blind $ choosePlayerCommand (wildChild ^. name) (target ^. name)+ return . Blind $ WildChild.chooseCommand (wildChild ^. name) (target ^. name) -arbitraryChoosePlayersCommand :: Game -> Gen (Blind Command)-arbitraryChoosePlayersCommand game = do+arbitraryScapegoatChooseCommand :: Game -> Gen (Blind Command)+arbitraryScapegoatChooseCommand game = do let scapegoatsName = game ^?! players . scapegoats . name (NonEmpty players') <- NonEmpty <$> sublistOf (game ^.. players . traverse . alive) - return . Blind $ choosePlayersCommand scapegoatsName (players' ^.. names)+ return . Blind $ Scapegoat.chooseCommand scapegoatsName (players' ^.. names) arbitraryHealCommand :: Game -> Gen (Blind Command) arbitraryHealCommand game = do@@ -478,17 +484,17 @@ then noopCommand else healCommand witchsName -arbitraryPassDevotedServantsTurnCommand :: Game -> Gen (Blind Command)-arbitraryPassDevotedServantsTurnCommand game = do+arbitraryDevotedServantPassCommand :: Game -> Gen (Blind Command)+arbitraryDevotedServantPassCommand game = do let devotedServantsName = game ^?! players . devotedServants . name - return . Blind $ passDevotedServantsTurnCommand devotedServantsName+ return . Blind $ DevotedServant.passCommand devotedServantsName -arbitraryPassWitchsTurnCommand :: Game -> Gen (Blind Command)-arbitraryPassWitchsTurnCommand game = do+arbitraryWitchPassCommand :: Game -> Gen (Blind Command)+arbitraryWitchPassCommand game = do let witchsName = game ^?! players . witches . name - return . Blind $ passWitchsTurnCommand witchsName+ return . Blind $ Witch.passCommand witchsName arbitraryPoisonCommand :: Game -> Gen (Blind Command) arbitraryPoisonCommand game = do@@ -533,25 +539,25 @@ then Blind noopCommand else Blind $ seeCommand seersName (target ^. name) -arbitraryVoteDevourCommand :: Game -> Gen (Blind Command)-arbitraryVoteDevourCommand game = do+arbitraryWerewolfVoteCommand :: Game -> Gen (Blind Command)+arbitraryWerewolfVoteCommand game = do let applicableCallerNames = getPendingVoters game ^.. werewolves . name target <- suchThat (arbitraryPlayer game) $ isn't werewolf if null applicableCallerNames then return $ Blind noopCommand else elements applicableCallerNames >>= \callerName ->- return . Blind $ voteDevourCommand callerName (target ^. name)+ return . Blind $ Werewolf.voteCommand callerName (target ^. name) -arbitraryVoteLynchCommand :: Game -> Gen (Blind Command)-arbitraryVoteLynchCommand game = do+arbitraryVillagerVoteCommand :: Game -> Gen (Blind Command)+arbitraryVillagerVoteCommand game = do let applicableCallerNames = (game ^. allowedVoters) `intersect` (getPendingVoters game ^.. names) target <- arbitraryPlayer game if null applicableCallerNames then return $ Blind noopCommand else elements applicableCallerNames >>= \callerName ->- return . Blind $ voteLynchCommand callerName (target ^. name)+ return . Blind $ Villager.voteCommand callerName (target ^. name) runArbitraryCommands :: Int -> Game -> Gen Game runArbitraryCommands n = iterateM n $ \game -> do
test/src/Game/Werewolf/Test/Command/Choose.hs view
@@ -18,10 +18,10 @@ import Data.Text (Text) import qualified Data.Text as T -import Game.Werewolf.Command-import Game.Werewolf.Game-import Game.Werewolf.Player-import Game.Werewolf.Role hiding (name)+import Game.Werewolf+import Game.Werewolf.Command.Scapegoat as Scapegoat+import Game.Werewolf.Command.WildChild as WildChild+import Game.Werewolf.Command.WolfHound as WolfHound import Game.Werewolf.Test.Arbitrary import Game.Werewolf.Test.Util @@ -30,208 +30,208 @@ allChooseCommandTests :: [TestTree] allChooseCommandTests =- [ testProperty "choose allegiance command errors when game is over" prop_chooseAllegianceCommandErrorsWhenGameIsOver- , testProperty "choose allegiance command errors when caller does not exist" prop_chooseAllegianceCommandErrorsWhenCallerDoesNotExist- , testProperty "choose allegiance command errors when caller is dead" prop_chooseAllegianceCommandErrorsWhenCallerIsDead- , testProperty "choose allegiance command errors when not wolf-hound's turn" prop_chooseAllegianceCommandErrorsWhenNotWolfHoundsTurn- , testProperty "choose allegiance command errors when caller not wolf-hound" prop_chooseAllegianceCommandErrorsWhenCallerNotWolfHound- , testProperty "choose allegiance command errors when allegiance does not exist" prop_chooseAllegianceCommandErrorsWhenAllegianceDoesNotExist- , testProperty "choose allegiance command sets allegiance chosen" prop_chooseAllegianceCommandSetsAllegianceChosen+ [ testProperty "wolf-hound choose command errors when game is over" prop_wolfHoundChooseCommandErrorsWhenGameIsOver+ , testProperty "wolf-hound choose command errors when caller does not exist" prop_wolfHoundChooseCommandErrorsWhenCallerDoesNotExist+ , testProperty "wolf-hound choose command errors when caller is dead" prop_wolfHoundChooseCommandErrorsWhenCallerIsDead+ , testProperty "wolf-hound choose command errors when not wolf-hound's turn" prop_wolfHoundChooseCommandErrorsWhenNotWolfHoundsTurn+ , testProperty "wolf-hound choose command errors when caller not wolf-hound" prop_wolfHoundChooseCommandErrorsWhenCallerNotWolfHound+ , testProperty "wolf-hound choose command errors when allegiance does not exist" prop_wolfHoundChooseCommandErrorsWhenAllegianceDoesNotExist+ , testProperty "wolf-hound choose command sets allegiance chosen" prop_wolfHoundChooseCommandSetsAllegianceChosen - , testProperty "choose player command errors when game is over" prop_choosePlayerCommandErrorsWhenGameIsOver- , testProperty "choose player command errors when caller does not exist" prop_choosePlayerCommandErrorsWhenCallerDoesNotExist- , testProperty "choose player command errors when target does not exist" prop_choosePlayerCommandErrorsWhenTargetDoesNotExist- , testProperty "choose player command errors when caller is dead" prop_choosePlayerCommandErrorsWhenCallerIsDead- , testProperty "choose player command errors when target is dead" prop_choosePlayerCommandErrorsWhenTargetIsDead- , testProperty "choose player command errors when target is caller" prop_choosePlayerCommandErrorsWhenTargetIsCaller- , testProperty "choose player command errors when not wild-child's turn" prop_choosePlayerCommandErrorsWhenNotWildChildsTurn- , testProperty "choose player command errors when caller not wild-child" prop_choosePlayerCommandErrorsWhenCallerNotWildChild- , testProperty "choose player command sets role model" prop_choosePlayerCommandSetsRoleModel+ , testProperty "wild-child choose command errors when game is over" prop_wildChildChooseCommandErrorsWhenGameIsOver+ , testProperty "wild-child choose command errors when caller does not exist" prop_wildChildChooseCommandErrorsWhenCallerDoesNotExist+ , testProperty "wild-child choose command errors when target does not exist" prop_wildChildChooseCommandErrorsWhenTargetDoesNotExist+ , testProperty "wild-child choose command errors when caller is dead" prop_wildChildChooseCommandErrorsWhenCallerIsDead+ , testProperty "wild-child choose command errors when target is dead" prop_wildChildChooseCommandErrorsWhenTargetIsDead+ , testProperty "wild-child choose command errors when target is caller" prop_wildChildChooseCommandErrorsWhenTargetIsCaller+ , testProperty "wild-child choose command errors when not wild-child's turn" prop_wildChildChooseCommandErrorsWhenNotWildChildsTurn+ , testProperty "wild-child choose command errors when caller not wild-child" prop_wildChildChooseCommandErrorsWhenCallerNotWildChild+ , testProperty "wild-child choose command sets role model" prop_wildChildChooseCommandSetsRoleModel - , testProperty "choose players command errors when game is over" prop_choosePlayersCommandErrorsWhenGameIsOver- , testProperty "choose players command errors when caller does not exist" prop_choosePlayersCommandErrorsWhenCallerDoesNotExist- , testProperty "choose players command errors when any target does not exist" prop_choosePlayersCommandErrorsWhenAnyTargetDoesNotExist- , testProperty "choose players command errors when any target is dead" prop_choosePlayersCommandErrorsWhenAnyTargetIsDead- , testProperty "choose players command errors when not scapegoat's turn" prop_choosePlayersCommandErrorsWhenNotScapegoatsTurn- , testProperty "choose players command errors when caller not scapegoat" prop_choosePlayersCommandErrorsWhenCallerNotScapegoat- , testProperty "choose players command sets allowed voters" prop_choosePlayersCommandSetsAllowedVoters- , testProperty "choose players command resets scapegoat blamed" prop_choosePlayersCommandResetsScapegoatBlamed+ , testProperty "scapegoat choose command errors when game is over" prop_scapegoatChooseCommandErrorsWhenGameIsOver+ , testProperty "scapegoat choose command errors when caller does not exist" prop_scapegoatChooseCommandErrorsWhenCallerDoesNotExist+ , testProperty "scapegoat choose command errors when any target does not exist" prop_scapegoatChooseCommandErrorsWhenAnyTargetDoesNotExist+ , testProperty "scapegoat choose command errors when any target is dead" prop_scapegoatChooseCommandErrorsWhenAnyTargetIsDead+ , testProperty "scapegoat choose command errors when not scapegoat's turn" prop_scapegoatChooseCommandErrorsWhenNotScapegoatsTurn+ , testProperty "scapegoat choose command errors when caller not scapegoat" prop_scapegoatChooseCommandErrorsWhenCallerNotScapegoat+ , testProperty "scapegoat choose command sets allowed voters" prop_scapegoatChooseCommandSetsAllowedVoters+ , testProperty "scapegoat choose command resets scapegoat blamed" prop_scapegoatChooseCommandResetsScapegoatBlamed ] -prop_chooseAllegianceCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_chooseAllegianceCommandErrorsWhenGameIsOver (GameAtGameOver game) =- forAll (arbitraryChooseAllegianceCommand game) $ verbose_runCommandErrors game . getBlind+prop_wolfHoundChooseCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property+prop_wolfHoundChooseCommandErrorsWhenGameIsOver (GameAtGameOver game) =+ forAll (arbitraryWolfHoundChooseCommand game) $ verbose_runCommandErrors game . getBlind -prop_chooseAllegianceCommandErrorsWhenCallerDoesNotExist :: GameAtWolfHoundsTurn -> Player -> Allegiance -> Property-prop_chooseAllegianceCommandErrorsWhenCallerDoesNotExist (GameAtWolfHoundsTurn game) caller allegiance = do- let command = chooseAllegianceCommand (caller ^. name) (T.pack $ show allegiance)+prop_wolfHoundChooseCommandErrorsWhenCallerDoesNotExist :: GameAtWolfHoundsTurn -> Player -> Allegiance -> Property+prop_wolfHoundChooseCommandErrorsWhenCallerDoesNotExist (GameAtWolfHoundsTurn game) caller allegiance = do+ let command = WolfHound.chooseCommand (caller ^. name) (T.pack $ show allegiance) not (doesPlayerExist (caller ^. name) game) ==> verbose_runCommandErrors game command -prop_chooseAllegianceCommandErrorsWhenCallerIsDead :: GameAtWolfHoundsTurn -> Allegiance -> Property-prop_chooseAllegianceCommandErrorsWhenCallerIsDead (GameAtWolfHoundsTurn game) allegiance = do+prop_wolfHoundChooseCommandErrorsWhenCallerIsDead :: GameAtWolfHoundsTurn -> Allegiance -> Property+prop_wolfHoundChooseCommandErrorsWhenCallerIsDead (GameAtWolfHoundsTurn game) allegiance = do let wolfHound = game ^?! players . wolfHounds let game' = killPlayer (wolfHound ^. name) game- let command = chooseAllegianceCommand (wolfHound ^. name) (T.pack $ show allegiance)+ let command = WolfHound.chooseCommand (wolfHound ^. name) (T.pack $ show allegiance) verbose_runCommandErrors game' command -prop_chooseAllegianceCommandErrorsWhenNotWolfHoundsTurn :: Game -> Property-prop_chooseAllegianceCommandErrorsWhenNotWolfHoundsTurn game =+prop_wolfHoundChooseCommandErrorsWhenNotWolfHoundsTurn :: Game -> Property+prop_wolfHoundChooseCommandErrorsWhenNotWolfHoundsTurn game = hasn't (stage . _WolfHoundsTurn) game- ==> forAll (arbitraryChooseAllegianceCommand game) $ verbose_runCommandErrors game . getBlind+ ==> forAll (arbitraryWolfHoundChooseCommand game) $ verbose_runCommandErrors game . getBlind -prop_chooseAllegianceCommandErrorsWhenCallerNotWolfHound :: GameAtWolfHoundsTurn -> Allegiance -> Property-prop_chooseAllegianceCommandErrorsWhenCallerNotWolfHound (GameAtWolfHoundsTurn game) allegiance =+prop_wolfHoundChooseCommandErrorsWhenCallerNotWolfHound :: GameAtWolfHoundsTurn -> Allegiance -> Property+prop_wolfHoundChooseCommandErrorsWhenCallerNotWolfHound (GameAtWolfHoundsTurn game) allegiance = forAll (suchThat (arbitraryPlayer game) (isn't wolfHound)) $ \caller -> do- let command = chooseAllegianceCommand (caller ^. name) (T.pack $ show allegiance)+ let command = WolfHound.chooseCommand (caller ^. name) (T.pack $ show allegiance) verbose_runCommandErrors game command -prop_chooseAllegianceCommandErrorsWhenAllegianceDoesNotExist :: GameAtWolfHoundsTurn -> Text -> Property-prop_chooseAllegianceCommandErrorsWhenAllegianceDoesNotExist (GameAtWolfHoundsTurn game) allegiance = do+prop_wolfHoundChooseCommandErrorsWhenAllegianceDoesNotExist :: GameAtWolfHoundsTurn -> Text -> Property+prop_wolfHoundChooseCommandErrorsWhenAllegianceDoesNotExist (GameAtWolfHoundsTurn game) allegiance = do let wolfHound = game ^?! players . wolfHounds- let command = chooseAllegianceCommand (wolfHound ^. name) allegiance+ let command = WolfHound.chooseCommand (wolfHound ^. name) allegiance allegiance `notElem` ["Villagers", "Werewolves"] ==> verbose_runCommandErrors game command -prop_chooseAllegianceCommandSetsAllegianceChosen :: GameAtWolfHoundsTurn -> Property-prop_chooseAllegianceCommandSetsAllegianceChosen (GameAtWolfHoundsTurn game) = do+prop_wolfHoundChooseCommandSetsAllegianceChosen :: GameAtWolfHoundsTurn -> Property+prop_wolfHoundChooseCommandSetsAllegianceChosen (GameAtWolfHoundsTurn game) = do let wolfHoundsName = game ^?! players . wolfHounds . name forAll (elements [Villagers, Werewolves]) $ \allegiance' -> do- let command = chooseAllegianceCommand wolfHoundsName (T.pack $ show allegiance')+ let command = WolfHound.chooseCommand wolfHoundsName (T.pack $ show allegiance') let game' = run_ (apply command) game fromJust (game' ^. allegianceChosen) === allegiance' -prop_choosePlayerCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_choosePlayerCommandErrorsWhenGameIsOver (GameAtGameOver game) =- forAll (arbitraryChoosePlayerCommand game) $ verbose_runCommandErrors game . getBlind+prop_wildChildChooseCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property+prop_wildChildChooseCommandErrorsWhenGameIsOver (GameAtGameOver game) =+ forAll (arbitraryWildChildChooseCommand game) $ verbose_runCommandErrors game . getBlind -prop_choosePlayerCommandErrorsWhenCallerDoesNotExist :: GameAtWildChildsTurn -> Player -> Property-prop_choosePlayerCommandErrorsWhenCallerDoesNotExist (GameAtWildChildsTurn game) caller =+prop_wildChildChooseCommandErrorsWhenCallerDoesNotExist :: GameAtWildChildsTurn -> Player -> Property+prop_wildChildChooseCommandErrorsWhenCallerDoesNotExist (GameAtWildChildsTurn game) caller = forAll (arbitraryPlayer game) $ \target -> do- let command = choosePlayerCommand (caller ^. name) (target ^. name)+ let command = WildChild.chooseCommand (caller ^. name) (target ^. name) not (doesPlayerExist (caller ^. name) game) ==> verbose_runCommandErrors game command -prop_choosePlayerCommandErrorsWhenTargetDoesNotExist :: GameAtWildChildsTurn -> Player -> Property-prop_choosePlayerCommandErrorsWhenTargetDoesNotExist (GameAtWildChildsTurn game) target = do+prop_wildChildChooseCommandErrorsWhenTargetDoesNotExist :: GameAtWildChildsTurn -> Player -> Property+prop_wildChildChooseCommandErrorsWhenTargetDoesNotExist (GameAtWildChildsTurn game) target = do let wildChild = game ^?! players . wildChildren- let command = choosePlayerCommand (wildChild ^. name) (target ^. name)+ let command = WildChild.chooseCommand (wildChild ^. name) (target ^. name) not (doesPlayerExist (target ^. name) game) ==> verbose_runCommandErrors game command -prop_choosePlayerCommandErrorsWhenCallerIsDead :: GameAtWildChildsTurn -> Property-prop_choosePlayerCommandErrorsWhenCallerIsDead (GameAtWildChildsTurn game) = do+prop_wildChildChooseCommandErrorsWhenCallerIsDead :: GameAtWildChildsTurn -> Property+prop_wildChildChooseCommandErrorsWhenCallerIsDead (GameAtWildChildsTurn game) = do let wildChild = game ^?! players . wildChildren let game' = killPlayer (wildChild ^. name) game forAll (arbitraryPlayer game') $ \target -> do- let command = choosePlayerCommand (wildChild ^. name) (target ^. name)+ let command = WildChild.chooseCommand (wildChild ^. name) (target ^. name) verbose_runCommandErrors game' command -prop_choosePlayerCommandErrorsWhenTargetIsDead :: GameAtWildChildsTurn -> Property-prop_choosePlayerCommandErrorsWhenTargetIsDead (GameAtWildChildsTurn game) = do+prop_wildChildChooseCommandErrorsWhenTargetIsDead :: GameAtWildChildsTurn -> Property+prop_wildChildChooseCommandErrorsWhenTargetIsDead (GameAtWildChildsTurn game) = do let wildChild = game ^?! players . wildChildren forAll (arbitraryPlayer game) $ \target -> do let game' = killPlayer (target ^. name) game- let command = choosePlayerCommand (wildChild ^. name) (target ^. name)+ let command = WildChild.chooseCommand (wildChild ^. name) (target ^. name) verbose_runCommandErrors game' command -prop_choosePlayerCommandErrorsWhenTargetIsCaller :: GameAtWildChildsTurn -> Property-prop_choosePlayerCommandErrorsWhenTargetIsCaller (GameAtWildChildsTurn game) = do+prop_wildChildChooseCommandErrorsWhenTargetIsCaller :: GameAtWildChildsTurn -> Property+prop_wildChildChooseCommandErrorsWhenTargetIsCaller (GameAtWildChildsTurn game) = do let wildChild = game ^?! players . wildChildren- let command = choosePlayerCommand (wildChild ^. name) (wildChild ^. name)+ let command = WildChild.chooseCommand (wildChild ^. name) (wildChild ^. name) verbose_runCommandErrors game command -prop_choosePlayerCommandErrorsWhenNotWildChildsTurn :: Game -> Property-prop_choosePlayerCommandErrorsWhenNotWildChildsTurn game =+prop_wildChildChooseCommandErrorsWhenNotWildChildsTurn :: Game -> Property+prop_wildChildChooseCommandErrorsWhenNotWildChildsTurn game = hasn't (stage . _WildChildsTurn) game- ==> forAll (arbitraryChoosePlayerCommand game) $ verbose_runCommandErrors game . getBlind+ ==> forAll (arbitraryWildChildChooseCommand game) $ verbose_runCommandErrors game . getBlind -prop_choosePlayerCommandErrorsWhenCallerNotWildChild :: GameAtWildChildsTurn -> Property-prop_choosePlayerCommandErrorsWhenCallerNotWildChild (GameAtWildChildsTurn game) =+prop_wildChildChooseCommandErrorsWhenCallerNotWildChild :: GameAtWildChildsTurn -> Property+prop_wildChildChooseCommandErrorsWhenCallerNotWildChild (GameAtWildChildsTurn game) = forAll (suchThat (arbitraryPlayer game) (isn't wildChild)) $ \caller -> forAll (arbitraryPlayer game) $ \target -> do- let command = choosePlayerCommand (caller ^. name) (target ^. name)+ let command = WildChild.chooseCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game command -prop_choosePlayerCommandSetsRoleModel :: GameAtWildChildsTurn -> Property-prop_choosePlayerCommandSetsRoleModel (GameAtWildChildsTurn game) = do+prop_wildChildChooseCommandSetsRoleModel :: GameAtWildChildsTurn -> Property+prop_wildChildChooseCommandSetsRoleModel (GameAtWildChildsTurn game) = do let wildChild = game ^?! players . wildChildren forAll (suchThat (arbitraryPlayer game) (wildChild /=)) $ \target -> do- let command = choosePlayerCommand (wildChild ^. name) (target ^. name)+ let command = WildChild.chooseCommand (wildChild ^. name) (target ^. name) let game' = run_ (apply command) game fromJust (game' ^. roleModel) === target ^. name -prop_choosePlayersCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_choosePlayersCommandErrorsWhenGameIsOver (GameAtGameOver game) =- forAll (arbitraryChoosePlayersCommand game) $ verbose_runCommandErrors game . getBlind+prop_scapegoatChooseCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property+prop_scapegoatChooseCommandErrorsWhenGameIsOver (GameAtGameOver game) =+ forAll (arbitraryScapegoatChooseCommand game) $ verbose_runCommandErrors game . getBlind -prop_choosePlayersCommandErrorsWhenCallerDoesNotExist :: GameAtScapegoatsTurn -> Player -> Property-prop_choosePlayersCommandErrorsWhenCallerDoesNotExist (GameAtScapegoatsTurn game) caller =+prop_scapegoatChooseCommandErrorsWhenCallerDoesNotExist :: GameAtScapegoatsTurn -> Player -> Property+prop_scapegoatChooseCommandErrorsWhenCallerDoesNotExist (GameAtScapegoatsTurn game) caller = forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) -> do- let command = choosePlayersCommand (caller ^. name) (targets ^.. names)+ let command = Scapegoat.chooseCommand (caller ^. name) (targets ^.. names) not (doesPlayerExist (caller ^. name) game) ==> verbose_runCommandErrors game command -prop_choosePlayersCommandErrorsWhenAnyTargetDoesNotExist :: GameAtScapegoatsTurn -> Player -> Property-prop_choosePlayersCommandErrorsWhenAnyTargetDoesNotExist (GameAtScapegoatsTurn game) target = do+prop_scapegoatChooseCommandErrorsWhenAnyTargetDoesNotExist :: GameAtScapegoatsTurn -> Player -> Property+prop_scapegoatChooseCommandErrorsWhenAnyTargetDoesNotExist (GameAtScapegoatsTurn game) target = do let scapegoat = game ^?! players . scapegoats- let command = choosePlayersCommand (scapegoat ^. name) [target ^. name]+ let command = Scapegoat.chooseCommand (scapegoat ^. name) [target ^. name] not (doesPlayerExist (target ^. name) game) ==> verbose_runCommandErrors game command -prop_choosePlayersCommandErrorsWhenAnyTargetIsDead :: GameAtScapegoatsTurn -> Property-prop_choosePlayersCommandErrorsWhenAnyTargetIsDead (GameAtScapegoatsTurn game) = do+prop_scapegoatChooseCommandErrorsWhenAnyTargetIsDead :: GameAtScapegoatsTurn -> Property+prop_scapegoatChooseCommandErrorsWhenAnyTargetIsDead (GameAtScapegoatsTurn game) = do let scapegoat = game ^?! players . scapegoats forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) -> forAll (elements targets) $ \target -> do let game' = killPlayer (target ^. name) game- let command = choosePlayersCommand (scapegoat ^. name) (targets ^.. names)+ let command = Scapegoat.chooseCommand (scapegoat ^. name) (targets ^.. names) verbose_runCommandErrors game' command -prop_choosePlayersCommandErrorsWhenNotScapegoatsTurn :: Game -> Property-prop_choosePlayersCommandErrorsWhenNotScapegoatsTurn game =+prop_scapegoatChooseCommandErrorsWhenNotScapegoatsTurn :: Game -> Property+prop_scapegoatChooseCommandErrorsWhenNotScapegoatsTurn game = hasn't (stage . _ScapegoatsTurn) game- ==> forAll (arbitraryChoosePlayersCommand game) $ verbose_runCommandErrors game . getBlind+ ==> forAll (arbitraryScapegoatChooseCommand game) $ verbose_runCommandErrors game . getBlind -prop_choosePlayersCommandErrorsWhenCallerNotScapegoat :: GameAtScapegoatsTurn -> Property-prop_choosePlayersCommandErrorsWhenCallerNotScapegoat (GameAtScapegoatsTurn game) =+prop_scapegoatChooseCommandErrorsWhenCallerNotScapegoat :: GameAtScapegoatsTurn -> Property+prop_scapegoatChooseCommandErrorsWhenCallerNotScapegoat (GameAtScapegoatsTurn game) = forAll (suchThat (arbitraryPlayer game) (isn't scapegoat)) $ \caller -> forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) -> do- let command = choosePlayersCommand (caller ^. name) (targets ^.. names)+ let command = Scapegoat.chooseCommand (caller ^. name) (targets ^.. names) verbose_runCommandErrors game command -prop_choosePlayersCommandSetsAllowedVoters :: GameAtScapegoatsTurn -> Property-prop_choosePlayersCommandSetsAllowedVoters (GameAtScapegoatsTurn game) = do+prop_scapegoatChooseCommandSetsAllowedVoters :: GameAtScapegoatsTurn -> Property+prop_scapegoatChooseCommandSetsAllowedVoters (GameAtScapegoatsTurn game) = do let scapegoat = game ^?! players . scapegoats forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) -> do- let command = choosePlayersCommand (scapegoat ^. name) (targets ^.. names)+ let command = Scapegoat.chooseCommand (scapegoat ^. name) (targets ^.. names) let game' = run_ (apply command) game game' ^. allowedVoters === targets ^.. names -prop_choosePlayersCommandResetsScapegoatBlamed :: GameAtScapegoatsTurn -> Property-prop_choosePlayersCommandResetsScapegoatBlamed (GameAtScapegoatsTurn game) = do- forAll (arbitraryChoosePlayersCommand game) $ \(Blind command) ->+prop_scapegoatChooseCommandResetsScapegoatBlamed :: GameAtScapegoatsTurn -> Property+prop_scapegoatChooseCommandResetsScapegoatBlamed (GameAtScapegoatsTurn game) = do+ forAll (arbitraryScapegoatChooseCommand game) $ \(Blind command) -> not $ run_ (apply command) game ^. scapegoatBlamed
test/src/Game/Werewolf/Test/Command/Heal.hs view
@@ -14,9 +14,8 @@ import Control.Lens hiding (elements, isn't) -import Game.Werewolf.Command-import Game.Werewolf.Game-import Game.Werewolf.Player+import Game.Werewolf+import Game.Werewolf.Command.Witch import Game.Werewolf.Test.Arbitrary import Game.Werewolf.Test.Util
test/src/Game/Werewolf/Test/Command/Pass.hs view
@@ -14,9 +14,9 @@ import Control.Lens hiding (elements, isn't) -import Game.Werewolf.Command-import Game.Werewolf.Game-import Game.Werewolf.Player+import Game.Werewolf+import Game.Werewolf.Command.DevotedServant as DevotedServant+import Game.Werewolf.Command.Witch as Witch import Game.Werewolf.Test.Arbitrary import Game.Werewolf.Test.Util @@ -25,73 +25,73 @@ allPassCommandTests :: [TestTree] allPassCommandTests =- [ testProperty "pass devoted servant's turn command errors when game is over" prop_passDevotedServantsTurnCommandErrorsWhenGameIsOver- , testProperty "pass devoted servant's turn command errors when caller does not exist" prop_passDevotedServantsTurnCommandErrorsWhenCallerDoesNotExist- , testProperty "pass devoted servant's turn command errors when caller is dead" prop_passDevotedServantsTurnCommandErrorsWhenCallerIsDead- , testProperty "pass devoted servant's turn command errors when not devoted servant's turn" prop_passDevotedServantsTurnCommandErrorsWhenNotDevotedServantsTurn- , testProperty "pass devoted servant's turn command updates passes" prop_passDevotedServantsTurnCommandUpdatesPasses+ [ testProperty "devoted servant pass command errors when game is over" prop_devotedServantPassCommandErrorsWhenGameIsOver+ , testProperty "devoted servant pass command errors when caller does not exist" prop_devotedServantPassCommandErrorsWhenCallerDoesNotExist+ , testProperty "devoted servant pass command errors when caller is dead" prop_devotedServantPassCommandErrorsWhenCallerIsDead+ , testProperty "devoted servant pass command errors when not devoted servant's turn" prop_devotedServantPassCommandErrorsWhenNotDevotedServantsTurn+ , testProperty "devoted servant pass command updates passes" prop_devotedServantPassCommandUpdatesPasses - , testProperty "pass witch's turn command errors when game is over" prop_passWitchsTurnCommandErrorsWhenGameIsOver- , testProperty "pass witch's turn command errors when caller does not exist" prop_passWitchsTurnCommandErrorsWhenCallerDoesNotExist- , testProperty "pass witch's turn command errors when caller is dead" prop_passWitchsTurnCommandErrorsWhenCallerIsDead- , testProperty "pass witch's turn command errors when not witch's turn" prop_passWitchsTurnCommandErrorsWhenNotWitchsTurn- , testProperty "pass witch's turn command updates passes" prop_passWitchsTurnCommandUpdatesPasses+ , testProperty "witch pass command errors when game is over" prop_witchPassCommandErrorsWhenGameIsOver+ , testProperty "witch pass command errors when caller does not exist" prop_witchPassCommandErrorsWhenCallerDoesNotExist+ , testProperty "witch pass command errors when caller is dead" prop_witchPassCommandErrorsWhenCallerIsDead+ , testProperty "witch pass command errors when not witch's turn" prop_witchPassCommandErrorsWhenNotWitchsTurn+ , testProperty "witch pass command updates passes" prop_witchPassCommandUpdatesPasses ] -prop_passDevotedServantsTurnCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_passDevotedServantsTurnCommandErrorsWhenGameIsOver (GameAtGameOver game) =- forAll (arbitraryPassDevotedServantsTurnCommand game) $ verbose_runCommandErrors game . getBlind+prop_devotedServantPassCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property+prop_devotedServantPassCommandErrorsWhenGameIsOver (GameAtGameOver game) =+ forAll (arbitraryDevotedServantPassCommand game) $ verbose_runCommandErrors game . getBlind -prop_passDevotedServantsTurnCommandErrorsWhenCallerDoesNotExist :: GameAtDevotedServantsTurn -> Player -> Property-prop_passDevotedServantsTurnCommandErrorsWhenCallerDoesNotExist (GameAtDevotedServantsTurn game) caller =+prop_devotedServantPassCommandErrorsWhenCallerDoesNotExist :: GameAtDevotedServantsTurn -> Player -> Property+prop_devotedServantPassCommandErrorsWhenCallerDoesNotExist (GameAtDevotedServantsTurn game) caller = not (doesPlayerExist (caller ^. name) game)- ==> verbose_runCommandErrors game (passDevotedServantsTurnCommand (caller ^. name))+ ==> verbose_runCommandErrors game (DevotedServant.passCommand (caller ^. name)) -prop_passDevotedServantsTurnCommandErrorsWhenCallerIsDead :: GameAtDevotedServantsTurn -> Property-prop_passDevotedServantsTurnCommandErrorsWhenCallerIsDead (GameAtDevotedServantsTurn game) = do+prop_devotedServantPassCommandErrorsWhenCallerIsDead :: GameAtDevotedServantsTurn -> Property+prop_devotedServantPassCommandErrorsWhenCallerIsDead (GameAtDevotedServantsTurn game) = do let devotedServantsName = game ^?! players . devotedServants . name let game' = killPlayer devotedServantsName game- let command = passDevotedServantsTurnCommand devotedServantsName+ let command = DevotedServant.passCommand devotedServantsName verbose_runCommandErrors game' command -prop_passDevotedServantsTurnCommandErrorsWhenNotDevotedServantsTurn :: Game -> Property-prop_passDevotedServantsTurnCommandErrorsWhenNotDevotedServantsTurn game =+prop_devotedServantPassCommandErrorsWhenNotDevotedServantsTurn :: Game -> Property+prop_devotedServantPassCommandErrorsWhenNotDevotedServantsTurn game = hasn't (stage . _DevotedServantsTurn) game- ==> forAll (arbitraryPassDevotedServantsTurnCommand game) $ verbose_runCommandErrors game . getBlind+ ==> forAll (arbitraryDevotedServantPassCommand game) $ verbose_runCommandErrors game . getBlind -prop_passDevotedServantsTurnCommandUpdatesPasses :: GameAtDevotedServantsTurn -> Property-prop_passDevotedServantsTurnCommandUpdatesPasses (GameAtDevotedServantsTurn game) =- forAll (arbitraryPassDevotedServantsTurnCommand game) $ \(Blind command) -> do+prop_devotedServantPassCommandUpdatesPasses :: GameAtDevotedServantsTurn -> Property+prop_devotedServantPassCommandUpdatesPasses (GameAtDevotedServantsTurn game) =+ forAll (arbitraryDevotedServantPassCommand game) $ \(Blind command) -> do let game' = run_ (apply command) game length (game' ^. passes) == 1 -prop_passWitchsTurnCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_passWitchsTurnCommandErrorsWhenGameIsOver (GameAtGameOver game) =- forAll (arbitraryPassWitchsTurnCommand game) $ verbose_runCommandErrors game . getBlind+prop_witchPassCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property+prop_witchPassCommandErrorsWhenGameIsOver (GameAtGameOver game) =+ forAll (arbitraryWitchPassCommand game) $ verbose_runCommandErrors game . getBlind -prop_passWitchsTurnCommandErrorsWhenCallerDoesNotExist :: GameAtWitchsTurn -> Player -> Property-prop_passWitchsTurnCommandErrorsWhenCallerDoesNotExist (GameAtWitchsTurn game) caller =+prop_witchPassCommandErrorsWhenCallerDoesNotExist :: GameAtWitchsTurn -> Player -> Property+prop_witchPassCommandErrorsWhenCallerDoesNotExist (GameAtWitchsTurn game) caller = not (doesPlayerExist (caller ^. name) game)- ==> verbose_runCommandErrors game (passWitchsTurnCommand (caller ^. name))+ ==> verbose_runCommandErrors game (Witch.passCommand (caller ^. name)) -prop_passWitchsTurnCommandErrorsWhenCallerIsDead :: GameAtWitchsTurn -> Property-prop_passWitchsTurnCommandErrorsWhenCallerIsDead (GameAtWitchsTurn game) = do+prop_witchPassCommandErrorsWhenCallerIsDead :: GameAtWitchsTurn -> Property+prop_witchPassCommandErrorsWhenCallerIsDead (GameAtWitchsTurn game) = do let witchsName = game ^?! players . witches . name let game' = killPlayer witchsName game- let command = passWitchsTurnCommand witchsName+ let command = Witch.passCommand witchsName verbose_runCommandErrors game' command -prop_passWitchsTurnCommandErrorsWhenNotWitchsTurn :: Game -> Property-prop_passWitchsTurnCommandErrorsWhenNotWitchsTurn game =+prop_witchPassCommandErrorsWhenNotWitchsTurn :: Game -> Property+prop_witchPassCommandErrorsWhenNotWitchsTurn game = hasn't (stage . _WitchsTurn) game- ==> forAll (arbitraryPassWitchsTurnCommand game) $ verbose_runCommandErrors game . getBlind+ ==> forAll (arbitraryWitchPassCommand game) $ verbose_runCommandErrors game . getBlind -prop_passWitchsTurnCommandUpdatesPasses :: GameAtWitchsTurn -> Property-prop_passWitchsTurnCommandUpdatesPasses (GameAtWitchsTurn game) =- forAll (arbitraryPassWitchsTurnCommand game) $ \(Blind command) -> do+prop_witchPassCommandUpdatesPasses :: GameAtWitchsTurn -> Property+prop_witchPassCommandUpdatesPasses (GameAtWitchsTurn game) =+ forAll (arbitraryWitchPassCommand game) $ \(Blind command) -> do let game' = run_ (apply command) game length (game' ^. passes) == 1
test/src/Game/Werewolf/Test/Command/Poison.hs view
@@ -16,9 +16,8 @@ import Data.Maybe -import Game.Werewolf.Command-import Game.Werewolf.Game-import Game.Werewolf.Player+import Game.Werewolf+import Game.Werewolf.Command.Witch import Game.Werewolf.Test.Arbitrary import Game.Werewolf.Test.Util
test/src/Game/Werewolf/Test/Command/Protect.hs view
@@ -16,9 +16,8 @@ import Data.Maybe -import Game.Werewolf.Command-import Game.Werewolf.Game-import Game.Werewolf.Player+import Game.Werewolf+import Game.Werewolf.Command.Defender import Game.Werewolf.Test.Arbitrary import Game.Werewolf.Test.Util
test/src/Game/Werewolf/Test/Command/Quit.hs view
@@ -16,9 +16,8 @@ import Data.Maybe -import Game.Werewolf.Command-import Game.Werewolf.Game-import Game.Werewolf.Player+import Game.Werewolf+import Game.Werewolf.Command.Global import Game.Werewolf.Test.Arbitrary import Game.Werewolf.Test.Util
test/src/Game/Werewolf/Test/Command/Reveal.hs view
@@ -16,11 +16,9 @@ import Data.Maybe -import Game.Werewolf.Game+import Game.Werewolf+import Game.Werewolf.Command.DevotedServant import Game.Werewolf.Test.Arbitrary-import Game.Werewolf.Player-import Game.Werewolf.Role hiding (name)-import Game.Werewolf.Command import Game.Werewolf.Test.Util import Test.Tasty
test/src/Game/Werewolf/Test/Command/See.hs view
@@ -16,9 +16,8 @@ import Data.Maybe -import Game.Werewolf.Command-import Game.Werewolf.Game-import Game.Werewolf.Player+import Game.Werewolf+import Game.Werewolf.Command.Seer import Game.Werewolf.Test.Arbitrary import Game.Werewolf.Test.Util
test/src/Game/Werewolf/Test/Command/Vote.hs view
@@ -16,10 +16,9 @@ import qualified Data.Map as Map -import Game.Werewolf.Command-import Game.Werewolf.Engine (checkStage)-import Game.Werewolf.Game-import Game.Werewolf.Player+import Game.Werewolf+import Game.Werewolf.Command.Villager as Villager+import Game.Werewolf.Command.Werewolf as Werewolf import Game.Werewolf.Test.Arbitrary import Game.Werewolf.Test.Util @@ -28,174 +27,174 @@ allVoteCommandTests :: [TestTree] allVoteCommandTests =- [ testProperty "vote devour command errors when game is over" prop_voteDevourCommandErrorsWhenGameIsOver- , testProperty "vote devour command errors when caller does not exist" prop_voteDevourCommandErrorsWhenCallerDoesNotExist- , testProperty "vote devour command errors when target does not exist" prop_voteDevourCommandErrorsWhenTargetDoesNotExist- , testProperty "vote devour command errors when caller is dead" prop_voteDevourCommandErrorsWhenCallerIsDead- , testProperty "vote devour command errors when target is dead" prop_voteDevourCommandErrorsWhenTargetIsDead- , testProperty "vote devour command errors when not werewolves turn" prop_voteDevourCommandErrorsWhenNotWerewolvesTurn- , testProperty "vote devour command errors when caller not werewolf" prop_voteDevourCommandErrorsWhenCallerNotWerewolf- , testProperty "vote devour command errors when caller has voted" prop_voteDevourCommandErrorsWhenCallerHasVoted- , testProperty "vote devour command errors when target werewolf" prop_voteDevourCommandErrorsWhenTargetWerewolf- , testProperty "vote devour command updates votes" prop_voteDevourCommandUpdatesVotes+ [ testProperty "werewolf vote command errors when game is over" prop_werewolfVoteCommandErrorsWhenGameIsOver+ , testProperty "werewolf vote command errors when caller does not exist" prop_werewolfVoteCommandErrorsWhenCallerDoesNotExist+ , testProperty "werewolf vote command errors when target does not exist" prop_werewolfVoteCommandErrorsWhenTargetDoesNotExist+ , testProperty "werewolf vote command errors when caller is dead" prop_werewolfVoteCommandErrorsWhenCallerIsDead+ , testProperty "werewolf vote command errors when target is dead" prop_werewolfVoteCommandErrorsWhenTargetIsDead+ , testProperty "werewolf vote command errors when not werewolves turn" prop_werewolfVoteCommandErrorsWhenNotWerewolvesTurn+ , testProperty "werewolf vote command errors when caller not werewolf" prop_werewolfVoteCommandErrorsWhenCallerNotWerewolf+ , testProperty "werewolf vote command errors when caller has voted" prop_werewolfVoteCommandErrorsWhenCallerHasVoted+ , testProperty "werewolf vote command errors when target werewolf" prop_werewolfVoteCommandErrorsWhenTargetWerewolf+ , testProperty "werewolf vote command updates votes" prop_werewolfVoteCommandUpdatesVotes - , testProperty "vote lynch command errors when game is over" prop_voteLynchCommandErrorsWhenGameIsOver- , testProperty "vote lynch command errors when caller does not exist" prop_voteLynchCommandErrorsWhenCallerDoesNotExist- , testProperty "vote lynch command errors when target does not exist" prop_voteLynchCommandErrorsWhenTargetDoesNotExist- , testProperty "vote lynch command errors when caller is dead" prop_voteLynchCommandErrorsWhenCallerIsDead- , testProperty "vote lynch command errors when target is dead" prop_voteLynchCommandErrorsWhenTargetIsDead- , testProperty "vote lynch command errors when not villages turn" prop_voteLynchCommandErrorsWhenNotVillagesTurn- , testProperty "vote lynch command errors when caller has voted" prop_voteLynchCommandErrorsWhenCallerHasVoted- , testProperty "vote lynch command errors when caller is not in allowed voters" prop_voteLynchCommandErrorsWhenCallerIsNotInAllowedVoters- , testProperty "vote lynch command errors when caller is known village idiot" prop_voteLynchCommandErrorsWhenCallerIsKnownVillageIdiot- , testProperty "vote lynch command updates votes" prop_voteLynchCommandUpdatesVotes+ , testProperty "villager vote command errors when game is over" prop_villagerVoteCommandErrorsWhenGameIsOver+ , testProperty "villager vote command errors when caller does not exist" prop_villagerVoteCommandErrorsWhenCallerDoesNotExist+ , testProperty "villager vote command errors when target does not exist" prop_villagerVoteCommandErrorsWhenTargetDoesNotExist+ , testProperty "villager vote command errors when caller is dead" prop_villagerVoteCommandErrorsWhenCallerIsDead+ , testProperty "villager vote command errors when target is dead" prop_villagerVoteCommandErrorsWhenTargetIsDead+ , testProperty "villager vote command errors when not villages turn" prop_villagerVoteCommandErrorsWhenNotVillagesTurn+ , testProperty "villager vote command errors when caller has voted" prop_villagerVoteCommandErrorsWhenCallerHasVoted+ , testProperty "villager vote command errors when caller is not in allowed voters" prop_villagerVoteCommandErrorsWhenCallerIsNotInAllowedVoters+ , testProperty "villager vote command errors when caller is known village idiot" prop_villagerVoteCommandErrorsWhenCallerIsKnownVillageIdiot+ , testProperty "villager vote command updates votes" prop_villagerVoteCommandUpdatesVotes ] -prop_voteDevourCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_voteDevourCommandErrorsWhenGameIsOver (GameAtGameOver game) =- forAll (arbitraryVoteDevourCommand game) $ verbose_runCommandErrors game . getBlind+prop_werewolfVoteCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property+prop_werewolfVoteCommandErrorsWhenGameIsOver (GameAtGameOver game) =+ forAll (arbitraryWerewolfVoteCommand game) $ verbose_runCommandErrors game . getBlind -prop_voteDevourCommandErrorsWhenCallerDoesNotExist :: GameAtWerewolvesTurn -> Player -> Property-prop_voteDevourCommandErrorsWhenCallerDoesNotExist (GameAtWerewolvesTurn game) caller =+prop_werewolfVoteCommandErrorsWhenCallerDoesNotExist :: GameAtWerewolvesTurn -> Player -> Property+prop_werewolfVoteCommandErrorsWhenCallerDoesNotExist (GameAtWerewolvesTurn game) caller = not (doesPlayerExist (caller ^. name) game) ==> forAll (arbitraryPlayer game) $ \target -> do- let command = voteDevourCommand (caller ^. name) (target ^. name)+ let command = Werewolf.voteCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game command -prop_voteDevourCommandErrorsWhenTargetDoesNotExist :: GameAtWerewolvesTurn -> Player -> Property-prop_voteDevourCommandErrorsWhenTargetDoesNotExist (GameAtWerewolvesTurn game) target =+prop_werewolfVoteCommandErrorsWhenTargetDoesNotExist :: GameAtWerewolvesTurn -> Player -> Property+prop_werewolfVoteCommandErrorsWhenTargetDoesNotExist (GameAtWerewolvesTurn game) target = not (doesPlayerExist (target ^. name) game) ==> forAll (arbitraryWerewolf game) $ \caller -> do- let command = voteDevourCommand (caller ^. name) (target ^. name)+ let command = Werewolf.voteCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game command -prop_voteDevourCommandErrorsWhenCallerIsDead :: GameAtWerewolvesTurn -> Property-prop_voteDevourCommandErrorsWhenCallerIsDead (GameAtWerewolvesTurn game) =+prop_werewolfVoteCommandErrorsWhenCallerIsDead :: GameAtWerewolvesTurn -> Property+prop_werewolfVoteCommandErrorsWhenCallerIsDead (GameAtWerewolvesTurn game) = forAll (arbitraryWerewolf game) $ \caller -> forAll (arbitraryPlayer game) $ \target -> do let game' = killPlayer (caller ^. name) game- let command = voteDevourCommand (caller ^. name) (target ^. name)+ let command = Werewolf.voteCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game' command -prop_voteDevourCommandErrorsWhenTargetIsDead :: GameAtWerewolvesTurn -> Property-prop_voteDevourCommandErrorsWhenTargetIsDead (GameAtWerewolvesTurn game) =+prop_werewolfVoteCommandErrorsWhenTargetIsDead :: GameAtWerewolvesTurn -> Property+prop_werewolfVoteCommandErrorsWhenTargetIsDead (GameAtWerewolvesTurn game) = forAll (arbitraryWerewolf game) $ \caller -> forAll (arbitraryPlayer game) $ \target -> do let game' = killPlayer (target ^. name) game- let command = voteDevourCommand (caller ^. name) (target ^. name)+ let command = Werewolf.voteCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game' command -prop_voteDevourCommandErrorsWhenNotWerewolvesTurn :: Game -> Property-prop_voteDevourCommandErrorsWhenNotWerewolvesTurn game =+prop_werewolfVoteCommandErrorsWhenNotWerewolvesTurn :: Game -> Property+prop_werewolfVoteCommandErrorsWhenNotWerewolvesTurn game = hasn't (stage . _WerewolvesTurn) game- ==> forAll (arbitraryVoteDevourCommand game) $ verbose_runCommandErrors game . getBlind+ ==> forAll (arbitraryWerewolfVoteCommand game) $ verbose_runCommandErrors game . getBlind -prop_voteDevourCommandErrorsWhenCallerNotWerewolf :: GameAtWerewolvesTurn -> Property-prop_voteDevourCommandErrorsWhenCallerNotWerewolf (GameAtWerewolvesTurn game) =+prop_werewolfVoteCommandErrorsWhenCallerNotWerewolf :: GameAtWerewolvesTurn -> Property+prop_werewolfVoteCommandErrorsWhenCallerNotWerewolf (GameAtWerewolvesTurn game) = forAll (suchThat (arbitraryPlayer game) (isn't werewolf)) $ \caller -> forAll (arbitraryPlayer game) $ \target -> do- let command = voteDevourCommand (caller ^. name) (target ^. name)+ let command = Werewolf.voteCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game command -prop_voteDevourCommandErrorsWhenCallerHasVoted :: GameWithDevourVotes -> Property-prop_voteDevourCommandErrorsWhenCallerHasVoted (GameWithDevourVotes game) =+prop_werewolfVoteCommandErrorsWhenCallerHasVoted :: GameWithDevourVotes -> Property+prop_werewolfVoteCommandErrorsWhenCallerHasVoted (GameWithDevourVotes game) = forAll (arbitraryWerewolf game) $ \caller -> forAll (suchThat (arbitraryPlayer game) (isn't werewolf)) $ \target -> do- let command = voteDevourCommand (caller ^. name) (target ^. name)+ let command = Werewolf.voteCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game command -prop_voteDevourCommandErrorsWhenTargetWerewolf :: GameAtWerewolvesTurn -> Property-prop_voteDevourCommandErrorsWhenTargetWerewolf (GameAtWerewolvesTurn game) =+prop_werewolfVoteCommandErrorsWhenTargetWerewolf :: GameAtWerewolvesTurn -> Property+prop_werewolfVoteCommandErrorsWhenTargetWerewolf (GameAtWerewolvesTurn game) = forAll (arbitraryPlayer game) $ \caller -> forAll (arbitraryWerewolf game) $ \target ->- verbose_runCommandErrors game (voteDevourCommand (caller ^. name) (target ^. name))+ verbose_runCommandErrors game (Werewolf.voteCommand (caller ^. name) (target ^. name)) -prop_voteDevourCommandUpdatesVotes :: GameAtWerewolvesTurn -> Property-prop_voteDevourCommandUpdatesVotes (GameAtWerewolvesTurn game) =- forAll (arbitraryVoteDevourCommand game) $ \(Blind command) -> do+prop_werewolfVoteCommandUpdatesVotes :: GameAtWerewolvesTurn -> Property+prop_werewolfVoteCommandUpdatesVotes (GameAtWerewolvesTurn game) =+ forAll (arbitraryWerewolfVoteCommand game) $ \(Blind command) -> do let game' = run_ (apply command) game Map.size (game' ^. votes) == 1 -prop_voteLynchCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property-prop_voteLynchCommandErrorsWhenGameIsOver (GameAtGameOver game) =- forAll (arbitraryVoteLynchCommand game) $ verbose_runCommandErrors game . getBlind+prop_villagerVoteCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property+prop_villagerVoteCommandErrorsWhenGameIsOver (GameAtGameOver game) =+ forAll (arbitraryVillagerVoteCommand game) $ verbose_runCommandErrors game . getBlind -prop_voteLynchCommandErrorsWhenCallerDoesNotExist :: GameAtVillagesTurn -> Player -> Property-prop_voteLynchCommandErrorsWhenCallerDoesNotExist (GameAtVillagesTurn game) caller =+prop_villagerVoteCommandErrorsWhenCallerDoesNotExist :: GameAtVillagesTurn -> Player -> Property+prop_villagerVoteCommandErrorsWhenCallerDoesNotExist (GameAtVillagesTurn game) caller = not (doesPlayerExist (caller ^. name) game) ==> forAll (arbitraryPlayer game) $ \target -> do- let command = voteLynchCommand (caller ^. name) (target ^. name)+ let command = Villager.voteCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game command -prop_voteLynchCommandErrorsWhenTargetDoesNotExist :: GameAtVillagesTurn -> Player -> Property-prop_voteLynchCommandErrorsWhenTargetDoesNotExist (GameAtVillagesTurn game) target =+prop_villagerVoteCommandErrorsWhenTargetDoesNotExist :: GameAtVillagesTurn -> Player -> Property+prop_villagerVoteCommandErrorsWhenTargetDoesNotExist (GameAtVillagesTurn game) target = not (doesPlayerExist (target ^. name) game) ==> forAll (arbitraryPlayer game) $ \caller -> do- let command = voteLynchCommand (caller ^. name) (target ^. name)+ let command = Villager.voteCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game command -prop_voteLynchCommandErrorsWhenCallerIsDead :: GameAtVillagesTurn -> Property-prop_voteLynchCommandErrorsWhenCallerIsDead (GameAtVillagesTurn game) =+prop_villagerVoteCommandErrorsWhenCallerIsDead :: GameAtVillagesTurn -> Property+prop_villagerVoteCommandErrorsWhenCallerIsDead (GameAtVillagesTurn game) = forAll (arbitraryPlayer game) $ \caller -> forAll (arbitraryPlayer game) $ \target -> do let game' = killPlayer (caller ^. name) game- let command = voteLynchCommand (caller ^. name) (target ^. name)+ let command = Villager.voteCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game' command -prop_voteLynchCommandErrorsWhenTargetIsDead :: GameAtVillagesTurn -> Property-prop_voteLynchCommandErrorsWhenTargetIsDead (GameAtVillagesTurn game) =+prop_villagerVoteCommandErrorsWhenTargetIsDead :: GameAtVillagesTurn -> Property+prop_villagerVoteCommandErrorsWhenTargetIsDead (GameAtVillagesTurn game) = forAll (arbitraryPlayer game) $ \caller -> forAll (arbitraryPlayer game) $ \target -> do let game' = killPlayer (target ^. name) game- let command = voteLynchCommand (caller ^. name) (target ^. name)+ let command = Villager.voteCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game' command -prop_voteLynchCommandErrorsWhenNotVillagesTurn :: Game -> Property-prop_voteLynchCommandErrorsWhenNotVillagesTurn game =+prop_villagerVoteCommandErrorsWhenNotVillagesTurn :: Game -> Property+prop_villagerVoteCommandErrorsWhenNotVillagesTurn game = hasn't (stage . _VillagesTurn) game- ==> forAll (arbitraryVoteLynchCommand game) $ verbose_runCommandErrors game . getBlind+ ==> forAll (arbitraryVillagerVoteCommand game) $ verbose_runCommandErrors game . getBlind -prop_voteLynchCommandErrorsWhenCallerHasVoted :: GameWithLynchVotes -> Property-prop_voteLynchCommandErrorsWhenCallerHasVoted (GameWithLynchVotes game) =+prop_villagerVoteCommandErrorsWhenCallerHasVoted :: GameWithLynchVotes -> Property+prop_villagerVoteCommandErrorsWhenCallerHasVoted (GameWithLynchVotes game) = forAll (arbitraryPlayer game) $ \caller -> forAll (arbitraryPlayer game) $ \target -> do- let command = voteLynchCommand (caller ^. name) (target ^. name)+ let command = Villager.voteCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game command -prop_voteLynchCommandErrorsWhenCallerIsNotInAllowedVoters :: GameWithAllowedVoters -> Property-prop_voteLynchCommandErrorsWhenCallerIsNotInAllowedVoters (GameWithAllowedVoters game) =+prop_villagerVoteCommandErrorsWhenCallerIsNotInAllowedVoters :: GameWithAllowedVoters -> Property+prop_villagerVoteCommandErrorsWhenCallerIsNotInAllowedVoters (GameWithAllowedVoters game) = forAll (suchThat (arbitraryPlayer game') (`notElem` getAllowedVoters game')) $ \caller -> forAll (arbitraryPlayer game') $ \target -> do- let command = voteLynchCommand (caller ^. name) (target ^. name)+ let command = Villager.voteCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game' command where game' = run_ checkStage game -prop_voteLynchCommandErrorsWhenCallerIsKnownVillageIdiot :: GameWithVillageIdiotRevealedAtVillagesTurn -> Property-prop_voteLynchCommandErrorsWhenCallerIsKnownVillageIdiot (GameWithVillageIdiotRevealedAtVillagesTurn game) =+prop_villagerVoteCommandErrorsWhenCallerIsKnownVillageIdiot :: GameWithVillageIdiotRevealedAtVillagesTurn -> Property+prop_villagerVoteCommandErrorsWhenCallerIsKnownVillageIdiot (GameWithVillageIdiotRevealedAtVillagesTurn game) = forAll (arbitraryPlayer game) $ \target -> do- let command = voteLynchCommand (caller ^. name) (target ^. name)+ let command = Villager.voteCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game command where caller = game ^?! players . villageIdiots -prop_voteLynchCommandUpdatesVotes :: GameAtVillagesTurn -> Property-prop_voteLynchCommandUpdatesVotes (GameAtVillagesTurn game) =- forAll (arbitraryVoteLynchCommand game) $ \(Blind command) -> do+prop_villagerVoteCommandUpdatesVotes :: GameAtVillagesTurn -> Property+prop_villagerVoteCommandUpdatesVotes (GameAtVillagesTurn game) =+ forAll (arbitraryVillagerVoteCommand game) $ \(Blind command) -> do let game' = run_ (apply command) game Map.size (game' ^. votes) == 1
test/src/Game/Werewolf/Test/Engine.hs view
@@ -21,11 +21,10 @@ import qualified Data.Map as Map import Data.Maybe -import Game.Werewolf.Command-import Game.Werewolf.Engine-import Game.Werewolf.Game-import Game.Werewolf.Player-import Game.Werewolf.Role hiding (name)+import Game.Werewolf+import Game.Werewolf.Command.DevotedServant+import Game.Werewolf.Command.Global+import Game.Werewolf.Command.Villager import Game.Werewolf.Test.Arbitrary import Game.Werewolf.Test.Util @@ -117,7 +116,6 @@ , testProperty "start game uses given players" prop_startGameUsesGivenPlayers , testProperty "start game errors unless unique player names" prop_startGameErrorsUnlessUniquePlayerNames , testProperty "start game errors when less than 7 players" prop_startGameErrorsWhenLessThan7Players- , testProperty "start game errors when more than 24 players" prop_startGameErrorsWhenMoreThan24Players , testProperty "start game errors when more than 1 of a restricted role" prop_startGameErrorsWhenMoreThan1OfARestrictedRole ] @@ -151,7 +149,7 @@ prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty :: GameAtWitchsTurn -> Property prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty (GameAtWitchsTurn game) =- forAll (arbitraryPassWitchsTurnCommand game') $ \(Blind passWitchsTurnCommand) -> do+ forAll (arbitraryWitchPassCommand game') $ \(Blind passWitchsTurnCommand) -> do hasn't (stage . _VillagesTurn) (run_ (apply passWitchsTurnCommand >> checkStage) game') where game' = game & allowedVoters .~ []@@ -221,7 +219,7 @@ prop_checkLynchingLynchesNoOneWhenTargetIsVillageIdiot :: GameAtVillagesTurn -> Bool prop_checkLynchingLynchesNoOneWhenTargetIsVillageIdiot (GameAtVillagesTurn game) = do- let game' = foldr (\player -> run_ (apply $ voteLynchCommand (player ^. name) (villageIdiot ^. name))) game (game ^. players)+ let game' = foldr (\player -> run_ (apply $ voteCommand (player ^. name) (villageIdiot ^. name))) game (game ^. players) none (is dead) (run_ checkStage game' ^. players) where@@ -293,10 +291,10 @@ prop_checkSunsetSetsWildChildsAllegianceWhenRoleModelDead :: GameWithRoleModelAtVillagesTurn -> Property prop_checkSunsetSetsWildChildsAllegianceWhenRoleModelDead (GameWithRoleModelAtVillagesTurn game) = do- let game' = foldr (\player -> run_ (apply $ voteLynchCommand (player ^. name) (roleModel' ^. name))) game (game ^. players)+ let game' = foldr (\player -> run_ (apply $ voteCommand (player ^. name) (roleModel' ^. name))) game (game ^. players) let devotedServantsName = game ^?! players . devotedServants . name- let command = passDevotedServantsTurnCommand devotedServantsName+ let command = passCommand devotedServantsName isn't angel roleModel' && isn't devotedServant roleModel' && isn't villageIdiot roleModel' ==> is werewolf $ run_ (checkStage >> apply command >> checkStage) game' ^?! players . wildChildren@@ -378,7 +376,7 @@ prop_checkWildChildsTurnAdvancesToDefendersTurn :: GameAtWildChildsTurn -> Property prop_checkWildChildsTurnAdvancesToDefendersTurn (GameAtWildChildsTurn game) =- forAll (arbitraryChoosePlayerCommand game) $ \(Blind command) ->+ forAll (arbitraryWildChildChooseCommand game) $ \(Blind command) -> has (stage . _DefendersTurn) (run_ (apply command >> checkStage) game) prop_checkWildChildsTurnAdvancesWhenNoWildChild :: GameAtWildChildsTurn -> Bool@@ -394,7 +392,7 @@ prop_checkWitchsTurnAdvancesToVillagesTurn :: GameAtWitchsTurn -> Property prop_checkWitchsTurnAdvancesToVillagesTurn (GameAtWitchsTurn game) =- forAll (arbitraryPassWitchsTurnCommand game) $ \(Blind command) ->+ forAll (arbitraryWitchPassCommand game) $ \(Blind command) -> has (stage . _VillagesTurn) (run_ (apply command >> checkStage) game) prop_checkWitchsTurnAdvancesWhenNoWitch :: GameAtWitchsTurn -> Bool@@ -406,17 +404,17 @@ prop_checkWitchsTurnHealsDevoureeWhenHealed :: GameWithHeal -> Property prop_checkWitchsTurnHealsDevoureeWhenHealed (GameWithHeal game) =- forAll (arbitraryPassWitchsTurnCommand game) $ \(Blind command) ->+ forAll (arbitraryWitchPassCommand game) $ \(Blind command) -> none (is dead) (run_ (apply command >> checkStage) game ^. players) prop_checkWitchsTurnKillsOnePlayerWhenPoisoned :: GameWithPoison -> Property prop_checkWitchsTurnKillsOnePlayerWhenPoisoned (GameWithPoison game) =- forAll (arbitraryPassWitchsTurnCommand game) $ \(Blind command) ->+ forAll (arbitraryWitchPassCommand game) $ \(Blind command) -> length (run_ (apply command >> checkStage) game ^.. players . traverse . dead) == 1 prop_checkWitchsTurnDoesNothingWhenPassed :: GameAtWitchsTurn -> Property prop_checkWitchsTurnDoesNothingWhenPassed (GameAtWitchsTurn game) =- forAll (arbitraryPassWitchsTurnCommand game) $ \(Blind command) ->+ forAll (arbitraryWitchPassCommand game) $ \(Blind command) -> none (is dead) $ run_ (apply command >> checkStage) game ^. players prop_checkWitchsTurnDoesNothingUnlessActionedOrPassed :: GameAtWitchsTurn -> Bool@@ -425,22 +423,22 @@ prop_checkWitchsTurnResetsHeal :: GameWithHeal -> Property prop_checkWitchsTurnResetsHeal (GameWithHeal game) =- forAll (arbitraryPassWitchsTurnCommand game) $ \(Blind command) ->+ forAll (arbitraryWitchPassCommand game) $ \(Blind command) -> not $ run_ (apply command >> checkStage) game ^. heal prop_checkWitchsTurnResetsPoison :: GameWithPoison -> Property prop_checkWitchsTurnResetsPoison (GameWithPoison game) =- forAll (arbitraryPassWitchsTurnCommand game) $ \(Blind command) ->+ forAll (arbitraryWitchPassCommand game) $ \(Blind command) -> isNothing $ run_ (apply command >> checkStage) game ^. poison prop_checkWitchsTurnClearsPasses :: GameAtWitchsTurn -> Property prop_checkWitchsTurnClearsPasses (GameAtWitchsTurn game) =- forAll (arbitraryPassWitchsTurnCommand game) $ \(Blind command) ->+ forAll (arbitraryWitchPassCommand game) $ \(Blind command) -> null $ run_ (apply command >> checkStage) game ^. passes prop_checkWolfHoundsTurnAdvancesToSeersTurn :: GameAtWolfHoundsTurn -> Property prop_checkWolfHoundsTurnAdvancesToSeersTurn (GameAtWolfHoundsTurn game) =- forAll (arbitraryChooseAllegianceCommand game) $ \(Blind command) ->+ forAll (arbitraryWolfHoundChooseCommand game) $ \(Blind command) -> has (stage . _SeersTurn) (run_ (apply command >> checkStage) game) prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound :: GameAtWolfHoundsTurn -> Bool@@ -507,12 +505,6 @@ prop_startGameErrorsWhenLessThan7Players players = length players < 7 ==> isLeft . runExcept . runWriterT $ startGame "" players--prop_startGameErrorsWhenMoreThan24Players :: Property-prop_startGameErrorsWhenMoreThan24Players =- forAll (resize 30 $ listOf arbitrary) $ \players ->- length players > 24- ==> isLeft . runExcept . runWriterT $ startGame "" players prop_startGameErrorsWhenMoreThan1OfARestrictedRole :: [Player] -> Property prop_startGameErrorsWhenMoreThan1OfARestrictedRole players =
test/src/Game/Werewolf/Test/Game.hs view
@@ -14,8 +14,7 @@ import Data.Maybe -import Game.Werewolf.Game-import Game.Werewolf.Player+import Game.Werewolf import Game.Werewolf.Test.Arbitrary () import Prelude hiding (round)
test/src/Game/Werewolf/Test/Player.hs view
@@ -14,8 +14,7 @@ import Data.Text -import Game.Werewolf.Player-import Game.Werewolf.Role+import Game.Werewolf import Game.Werewolf.Test.Arbitrary () import Test.Tasty
test/src/Game/Werewolf/Test/Util.hs view
@@ -16,9 +16,7 @@ import Data.Either.Extra -import Game.Werewolf.Command-import Game.Werewolf.Game-import Game.Werewolf.Response+import Game.Werewolf import Test.QuickCheck
werewolf.cabal view
@@ -1,14 +1,12 @@ name: werewolf-version: 0.4.10.0+version: 0.4.11.0 author: Henry J. Wylde maintainer: public@hjwylde.com homepage: https://github.com/hjwylde/werewolf -synopsis: A game engine for running werewolf in a chat client-description: This engine is based off of Werewolves of Millers Hollow- (http://www.games-wiki.org/wiki/Werewolves_of_Millers_Hollow/).- See https://github.com/hjwylde/werewolf for help on writing chat interfaces.+synopsis: A game engine for playing werewolf within a chat client+description: This engine is based off of the party game Mafia, also known as Werewolf. license: BSD3 license-file: LICENSE@@ -28,6 +26,7 @@ hs-source-dirs: app/ ghc-options: -threaded -with-rtsopts=-N other-modules:+ Paths_werewolf Werewolf.Command.Boot Werewolf.Command.Choose Werewolf.Command.Circle@@ -50,7 +49,6 @@ Werewolf.Messages Werewolf.Options Werewolf.Version- Paths_werewolf default-language: Haskell2010 other-extensions:@@ -58,7 +56,7 @@ MultiParamTypeClasses, OverloadedStrings build-depends:- aeson >= 0.8 && < 0.11,+ aeson >= 0.8 && < 0.12, base >= 4.8 && < 5, directory == 1.2.*, extra == 1.4.*,@@ -77,6 +75,17 @@ exposed-modules: Game.Werewolf Game.Werewolf.Command+ Game.Werewolf.Command.Defender+ Game.Werewolf.Command.DevotedServant+ Game.Werewolf.Command.Global+ Game.Werewolf.Command.Scapegoat+ Game.Werewolf.Command.Seer+ Game.Werewolf.Command.Status+ Game.Werewolf.Command.Villager+ Game.Werewolf.Command.Werewolf+ Game.Werewolf.Command.WildChild+ Game.Werewolf.Command.Witch+ Game.Werewolf.Command.WolfHound Game.Werewolf.Engine Game.Werewolf.Game Game.Werewolf.Player@@ -96,7 +105,7 @@ Rank2Types, TemplateHaskell build-depends:- aeson >= 0.8 && < 0.11,+ aeson >= 0.8 && < 0.12, base >= 4.8 && < 5, containers == 0.5.*, directory == 1.2.*,