diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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* diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,20 +4,31 @@ [![Build Status](https://travis-ci.org/hjwylde/werewolf.svg?branch=master)](https://travis-ci.org/hjwylde/werewolf) [![Release](https://img.shields.io/github/release/hjwylde/werewolf.svg)](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) diff --git a/app/Werewolf/Command/Boot.hs b/app/Werewolf/Command/Boot.hs --- a/app/Werewolf/Command/Boot.hs +++ b/app/Werewolf/Command/Boot.hs @@ -25,6 +25,7 @@ import Data.Text (Text) import Game.Werewolf +import Game.Werewolf.Command.Global import Werewolf.Game import Werewolf.Messages diff --git a/app/Werewolf/Command/Choose.hs b/app/Werewolf/Command/Choose.hs --- a/app/Werewolf/Command/Choose.hs +++ b/app/Werewolf/Command/Choose.hs @@ -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 diff --git a/app/Werewolf/Command/Circle.hs b/app/Werewolf/Command/Circle.hs --- a/app/Werewolf/Command/Circle.hs +++ b/app/Werewolf/Command/Circle.hs @@ -25,6 +25,7 @@ import Data.Text (Text) import Game.Werewolf +import Game.Werewolf.Command.Status import Werewolf.Game import Werewolf.Messages diff --git a/app/Werewolf/Command/Heal.hs b/app/Werewolf/Command/Heal.hs --- a/app/Werewolf/Command/Heal.hs +++ b/app/Werewolf/Command/Heal.hs @@ -24,6 +24,7 @@ import Data.Text (Text) import Game.Werewolf +import Game.Werewolf.Command.Witch import Werewolf.Game import Werewolf.Messages diff --git a/app/Werewolf/Command/Help.hs b/app/Werewolf/Command/Help.hs --- a/app/Werewolf/Command/Help.hs +++ b/app/Werewolf/Command/Help.hs @@ -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:" diff --git a/app/Werewolf/Command/Pass.hs b/app/Werewolf/Command/Pass.hs --- a/app/Werewolf/Command/Pass.hs +++ b/app/Werewolf/Command/Pass.hs @@ -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 diff --git a/app/Werewolf/Command/Ping.hs b/app/Werewolf/Command/Ping.hs --- a/app/Werewolf/Command/Ping.hs +++ b/app/Werewolf/Command/Ping.hs @@ -22,6 +22,7 @@ import Data.Text (Text) import Game.Werewolf +import Game.Werewolf.Command.Status import Werewolf.Game import Werewolf.Messages diff --git a/app/Werewolf/Command/Poison.hs b/app/Werewolf/Command/Poison.hs --- a/app/Werewolf/Command/Poison.hs +++ b/app/Werewolf/Command/Poison.hs @@ -25,6 +25,7 @@ import Data.Text (Text) import Game.Werewolf +import Game.Werewolf.Command.Witch import Werewolf.Game import Werewolf.Messages diff --git a/app/Werewolf/Command/Protect.hs b/app/Werewolf/Command/Protect.hs --- a/app/Werewolf/Command/Protect.hs +++ b/app/Werewolf/Command/Protect.hs @@ -25,6 +25,7 @@ import Data.Text (Text) import Game.Werewolf +import Game.Werewolf.Command.Defender import Werewolf.Game import Werewolf.Messages diff --git a/app/Werewolf/Command/Quit.hs b/app/Werewolf/Command/Quit.hs --- a/app/Werewolf/Command/Quit.hs +++ b/app/Werewolf/Command/Quit.hs @@ -22,6 +22,7 @@ import Data.Text (Text) import Game.Werewolf +import Game.Werewolf.Command.Global import Werewolf.Game import Werewolf.Messages diff --git a/app/Werewolf/Command/Reveal.hs b/app/Werewolf/Command/Reveal.hs --- a/app/Werewolf/Command/Reveal.hs +++ b/app/Werewolf/Command/Reveal.hs @@ -24,6 +24,7 @@ import Data.Text (Text) import Game.Werewolf +import Game.Werewolf.Command.DevotedServant import Werewolf.Game import Werewolf.Messages diff --git a/app/Werewolf/Command/See.hs b/app/Werewolf/Command/See.hs --- a/app/Werewolf/Command/See.hs +++ b/app/Werewolf/Command/See.hs @@ -25,6 +25,7 @@ import Data.Text (Text) import Game.Werewolf +import Game.Werewolf.Command.Seer import Werewolf.Game import Werewolf.Messages diff --git a/app/Werewolf/Command/Start.hs b/app/Werewolf/Command/Start.hs --- a/app/Werewolf/Command/Start.hs +++ b/app/Werewolf/Command/Start.hs @@ -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 " " "-" diff --git a/app/Werewolf/Command/Status.hs b/app/Werewolf/Command/Status.hs --- a/app/Werewolf/Command/Status.hs +++ b/app/Werewolf/Command/Status.hs @@ -22,6 +22,7 @@ import Data.Text (Text) import Game.Werewolf +import Game.Werewolf.Command.Status import Werewolf.Game import Werewolf.Messages diff --git a/app/Werewolf/Command/Vote.hs b/app/Werewolf/Command/Vote.hs --- a/app/Werewolf/Command/Vote.hs +++ b/app/Werewolf/Command/Vote.hs @@ -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 diff --git a/app/Werewolf/Options.hs b/app/Werewolf/Options.hs --- a/app/Werewolf/Options.hs +++ b/app/Werewolf/Options.hs @@ -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 diff --git a/src/Game/Werewolf/Command.hs b/src/Game/Werewolf/Command.hs --- a/src/Game/Werewolf/Command.hs +++ b/src/Game/Werewolf/Command.hs @@ -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] diff --git a/src/Game/Werewolf/Command/Defender.hs b/src/Game/Werewolf/Command/Defender.hs new file mode 100644 --- /dev/null +++ b/src/Game/Werewolf/Command/Defender.hs @@ -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 diff --git a/src/Game/Werewolf/Command/DevotedServant.hs b/src/Game/Werewolf/Command/DevotedServant.hs new file mode 100644 --- /dev/null +++ b/src/Game/Werewolf/Command/DevotedServant.hs @@ -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 () diff --git a/src/Game/Werewolf/Command/Global.hs b/src/Game/Werewolf/Command/Global.hs new file mode 100644 --- /dev/null +++ b/src/Game/Werewolf/Command/Global.hs @@ -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 diff --git a/src/Game/Werewolf/Command/Scapegoat.hs b/src/Game/Werewolf/Command/Scapegoat.hs new file mode 100644 --- /dev/null +++ b/src/Game/Werewolf/Command/Scapegoat.hs @@ -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 diff --git a/src/Game/Werewolf/Command/Seer.hs b/src/Game/Werewolf/Command/Seer.hs new file mode 100644 --- /dev/null +++ b/src/Game/Werewolf/Command/Seer.hs @@ -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 diff --git a/src/Game/Werewolf/Command/Status.hs b/src/Game/Werewolf/Command/Status.hs new file mode 100644 --- /dev/null +++ b/src/Game/Werewolf/Command/Status.hs @@ -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 + ] diff --git a/src/Game/Werewolf/Command/Villager.hs b/src/Game/Werewolf/Command/Villager.hs new file mode 100644 --- /dev/null +++ b/src/Game/Werewolf/Command/Villager.hs @@ -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 diff --git a/src/Game/Werewolf/Command/Werewolf.hs b/src/Game/Werewolf/Command/Werewolf.hs new file mode 100644 --- /dev/null +++ b/src/Game/Werewolf/Command/Werewolf.hs @@ -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]] diff --git a/src/Game/Werewolf/Command/WildChild.hs b/src/Game/Werewolf/Command/WildChild.hs new file mode 100644 --- /dev/null +++ b/src/Game/Werewolf/Command/WildChild.hs @@ -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 diff --git a/src/Game/Werewolf/Command/Witch.hs b/src/Game/Werewolf/Command/Witch.hs new file mode 100644 --- /dev/null +++ b/src/Game/Werewolf/Command/Witch.hs @@ -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] diff --git a/src/Game/Werewolf/Command/WolfHound.hs b/src/Game/Werewolf/Command/WolfHound.hs new file mode 100644 --- /dev/null +++ b/src/Game/Werewolf/Command/WolfHound.hs @@ -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 diff --git a/src/Game/Werewolf/Engine.hs b/src/Game/Werewolf/Engine.hs --- a/src/Game/Werewolf/Engine.hs +++ b/src/Game/Werewolf/Engine.hs @@ -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, "."]] diff --git a/src/Game/Werewolf/Messages.hs b/src/Game/Werewolf/Messages.hs --- a/src/Game/Werewolf/Messages.hs +++ b/src/Game/Werewolf/Messages.hs @@ -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 diff --git a/src/Game/Werewolf/Response.hs b/src/Game/Werewolf/Response.hs --- a/src/Game/Werewolf/Response.hs +++ b/src/Game/Werewolf/Response.hs @@ -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. diff --git a/src/Game/Werewolf/Role.hs b/src/Game/Werewolf/Role.hs --- a/src/Game/Werewolf/Role.hs +++ b/src/Game/Werewolf/Role.hs @@ -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. diff --git a/test/app/Main.hs b/test/app/Main.hs --- a/test/app/Main.hs +++ b/test/app/Main.hs @@ -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 diff --git a/test/src/Game/Werewolf/Test/Arbitrary.hs b/test/src/Game/Werewolf/Test/Arbitrary.hs --- a/test/src/Game/Werewolf/Test/Arbitrary.hs +++ b/test/src/Game/Werewolf/Test/Arbitrary.hs @@ -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 diff --git a/test/src/Game/Werewolf/Test/Command/Choose.hs b/test/src/Game/Werewolf/Test/Command/Choose.hs --- a/test/src/Game/Werewolf/Test/Command/Choose.hs +++ b/test/src/Game/Werewolf/Test/Command/Choose.hs @@ -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 diff --git a/test/src/Game/Werewolf/Test/Command/Heal.hs b/test/src/Game/Werewolf/Test/Command/Heal.hs --- a/test/src/Game/Werewolf/Test/Command/Heal.hs +++ b/test/src/Game/Werewolf/Test/Command/Heal.hs @@ -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 diff --git a/test/src/Game/Werewolf/Test/Command/Pass.hs b/test/src/Game/Werewolf/Test/Command/Pass.hs --- a/test/src/Game/Werewolf/Test/Command/Pass.hs +++ b/test/src/Game/Werewolf/Test/Command/Pass.hs @@ -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 diff --git a/test/src/Game/Werewolf/Test/Command/Poison.hs b/test/src/Game/Werewolf/Test/Command/Poison.hs --- a/test/src/Game/Werewolf/Test/Command/Poison.hs +++ b/test/src/Game/Werewolf/Test/Command/Poison.hs @@ -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 diff --git a/test/src/Game/Werewolf/Test/Command/Protect.hs b/test/src/Game/Werewolf/Test/Command/Protect.hs --- a/test/src/Game/Werewolf/Test/Command/Protect.hs +++ b/test/src/Game/Werewolf/Test/Command/Protect.hs @@ -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 diff --git a/test/src/Game/Werewolf/Test/Command/Quit.hs b/test/src/Game/Werewolf/Test/Command/Quit.hs --- a/test/src/Game/Werewolf/Test/Command/Quit.hs +++ b/test/src/Game/Werewolf/Test/Command/Quit.hs @@ -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 diff --git a/test/src/Game/Werewolf/Test/Command/Reveal.hs b/test/src/Game/Werewolf/Test/Command/Reveal.hs --- a/test/src/Game/Werewolf/Test/Command/Reveal.hs +++ b/test/src/Game/Werewolf/Test/Command/Reveal.hs @@ -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 diff --git a/test/src/Game/Werewolf/Test/Command/See.hs b/test/src/Game/Werewolf/Test/Command/See.hs --- a/test/src/Game/Werewolf/Test/Command/See.hs +++ b/test/src/Game/Werewolf/Test/Command/See.hs @@ -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 diff --git a/test/src/Game/Werewolf/Test/Command/Vote.hs b/test/src/Game/Werewolf/Test/Command/Vote.hs --- a/test/src/Game/Werewolf/Test/Command/Vote.hs +++ b/test/src/Game/Werewolf/Test/Command/Vote.hs @@ -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 diff --git a/test/src/Game/Werewolf/Test/Engine.hs b/test/src/Game/Werewolf/Test/Engine.hs --- a/test/src/Game/Werewolf/Test/Engine.hs +++ b/test/src/Game/Werewolf/Test/Engine.hs @@ -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 = diff --git a/test/src/Game/Werewolf/Test/Game.hs b/test/src/Game/Werewolf/Test/Game.hs --- a/test/src/Game/Werewolf/Test/Game.hs +++ b/test/src/Game/Werewolf/Test/Game.hs @@ -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) diff --git a/test/src/Game/Werewolf/Test/Player.hs b/test/src/Game/Werewolf/Test/Player.hs --- a/test/src/Game/Werewolf/Test/Player.hs +++ b/test/src/Game/Werewolf/Test/Player.hs @@ -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 diff --git a/test/src/Game/Werewolf/Test/Util.hs b/test/src/Game/Werewolf/Test/Util.hs --- a/test/src/Game/Werewolf/Test/Util.hs +++ b/test/src/Game/Werewolf/Test/Util.hs @@ -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 diff --git a/werewolf.cabal b/werewolf.cabal --- a/werewolf.cabal +++ b/werewolf.cabal @@ -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.*,