werewolf 0.4.11.0 → 0.4.12.0
raw patch · 18 files changed
+256/−232 lines, 18 files
Files
- CHANGELOG.md +18/−4
- README.md +5/−3
- app/Werewolf/Command/Help.hs +4/−4
- src/Game/Werewolf/Command/DevotedServant.hs +1/−1
- src/Game/Werewolf/Command/Scapegoat.hs +2/−2
- src/Game/Werewolf/Command/Status.hs +2/−2
- src/Game/Werewolf/Engine.hs +13/−13
- src/Game/Werewolf/Game.hs +28/−28
- src/Game/Werewolf/Messages.hs +24/−24
- src/Game/Werewolf/Player.hs +36/−36
- src/Game/Werewolf/Role.hs +67/−59
- src/Game/Werewolf/Util.hs +8/−8
- test/src/Game/Werewolf/Test/Arbitrary.hs +25/−25
- test/src/Game/Werewolf/Test/Command/Reveal.hs +5/−5
- test/src/Game/Werewolf/Test/Command/Vote.hs +4/−4
- test/src/Game/Werewolf/Test/Engine.hs +9/−9
- test/src/Game/Werewolf/Test/Game.hs +4/−4
- werewolf.cabal +1/−1
CHANGELOG.md view
@@ -2,23 +2,37 @@ ### Upcoming +### v0.4.12.0++*Minor*++* Renamed the Bear Tamer to Druid. ([#131](https://github.com/hjwylde/werewolf/issues/131))+* Renamed the Village Idiot to Jester. ([#136](https://github.com/hjwylde/werewolf/issues/136))++*Revisions*++* Updated the Witch's description and rules. ([#138](https://github.com/hjwylde/werewolf/issues/138))+* Updated the Scapegoat's description. ([#133](https://github.com/hjwylde/werewolf/issues/133))+* Updated the Druid's description and rules. ([#131](https://github.com/hjwylde/werewolf/issues/131))+* Updated the Jester's description and rules. ([#136](https://github.com/hjwylde/werewolf/issues/136))+ ### 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* +* Replaced references to Millers Hollow with an original game description. ([#126](https://github.com/hjwylde/werewolf/issues/126)) * 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))+* Updated the Simple Villager's description and rules. ([#135](https://github.com/hjwylde/werewolf/issues/135))+* 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)) ### v0.4.10.0
README.md view
@@ -3,6 +3,8 @@ [](http://www.repostatus.org/#wip) [](https://travis-ci.org/hjwylde/werewolf) [](https://github.com/hjwylde/werewolf/releases/latest)+[](https://www.stackage.org/lts/package/werewolf)+[](https://www.stackage.org/nightly/package/werewolf) A game engine for playing werewolf within a chat client. This engine is based off of the party game Mafia, also known as Werewolf.@@ -25,7 +27,7 @@ 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...+ mayhaps the Werewolves walk among the Villagers themselves... Objective of the Game: For the Loners: complete their own objective. @@ -63,12 +65,12 @@ The Villagers must lynch all of the Werewolves. -* Bear Tamer * Defender+* Druid+* Jester * Scapegoat * Seer * Simple Villager-* Village Idiot * Villager-Villager * Witch
app/Werewolf/Command/Help.hs view
@@ -145,7 +145,7 @@ ] ] , filter (/= "") [ T.concat- [ "Each player is informed of their role (see `help roles' for a list) at the start of the"+ [ "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,8 +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."+ , whenRoleInPlay mGame druidRole+ "- Ferina grunts if the Druid 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."@@ -190,7 +190,7 @@ ] , T.unwords [ "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"+ , "knew how to fight this scourge, however recently a theory has taken ahold that mayhaps" , "the Werewolves walk among the Villagers themselves..." ] ]
src/Game/Werewolf/Command/DevotedServant.hs view
@@ -60,11 +60,11 @@ resetRole :: (MonadState Game m, MonadWriter [Message] m) => Text -> Role -> m () resetRole callerName role+ | role == jesterRole = jesterRevealed .= False | 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
src/Game/Werewolf/Command/Scapegoat.hs view
@@ -33,8 +33,8 @@ 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]+ whenM (use jesterRevealed &&^ anyM isPlayerJester targetNames) $+ throwError [playerCannotChooseJesterMessage callerName] allowedVoters .= targetNames scapegoatBlamed .= False
src/Game/Werewolf/Command/Status.hs view
@@ -47,6 +47,7 @@ tell [pingRoleMessage $ devotedServantRole ^. Role.name] tell [pingPlayerMessage $ devotedServant ^. name]+ FerinasGrunt -> return () GameOver -> tell [gameIsOverMessage callerName] Lynching -> return () ScapegoatsTurn -> do@@ -61,7 +62,6 @@ tell [pingPlayerMessage $ seer ^. name] Sunrise -> return () Sunset -> return ()- UrsussGrunt -> return () VillagesTurn -> do allowedVoterNames <- use allowedVoters pendingVoterNames <- toListOf names <$> getPendingVoters@@ -91,11 +91,11 @@ statusCommand :: Text -> Command statusCommand callerName = Command $ use stage >>= \stage' -> case stage' of+ FerinasGrunt -> return () GameOver -> tell [gameIsOverMessage callerName] Lynching -> return () Sunrise -> return () Sunset -> return ()- UrsussGrunt -> return () VillagesTurn -> do allowedVoterNames <- use allowedVoters pendingVoterNames <- toListOf names <$> getPendingVoters
src/Game/Werewolf/Engine.hs view
@@ -78,13 +78,21 @@ whenM (has devotedServants <$> getVoteResult) advanceStage whenM (has devotedServants <$> getPassers) advanceStage + FerinasGrunt -> do+ druid <- findPlayerBy_ role druidRole+ players' <- getAdjacentAlivePlayers (druid ^. name)++ when (has werewolves players') $ tell [ferinaGruntsMessage]++ advanceStage+ GameOver -> return () Lynching -> do getVoteResult >>= lynchVotees - allVoters <- ifM (use villageIdiotRevealed)- (uses players $ filter (isn't villageIdiot))+ allVoters <- ifM (use jesterRevealed)+ (uses players $ filter (isn't jester)) (use players) allowedVoters .= allVoters ^.. traverse . alive . name @@ -133,14 +141,6 @@ advanceStage - UrsussGrunt -> do- bearTamer <- findPlayerBy_ role bearTamerRole- players' <- getAdjacentAlivePlayers (bearTamer ^. name)-- when (has werewolves players') $ tell [ursusGruntsMessage]-- advanceStage- VillagesTurn -> whenM (null <$> liftM2 intersect getAllowedVoters getPendingVoters) $ do tell . map (uncurry playerMadeLynchVoteMessage) =<< uses votes Map.toList @@ -187,10 +187,10 @@ lynchVotees :: (MonadState Game m, MonadWriter [Message] m) => [Player] -> m () lynchVotees [votee]- | is villageIdiot votee = do- villageIdiotRevealed .= True+ | is jester votee = do+ jesterRevealed .= True - tell [villageIdiotLynchedMessage $ votee ^. name]+ tell [jesterLynchedMessage $ votee ^. name] | otherwise = do killPlayer (votee ^. name) tell [playerLynchedMessage votee]
src/Game/Werewolf/Game.hs view
@@ -18,12 +18,12 @@ -- * Game Game, stage, round, players, events, boots, passes, allegianceChosen, allowedVoters, heal, healUsed,- poison, poisonUsed, priorProtect, protect, roleModel, scapegoatBlamed, see,- villageIdiotRevealed, votes,+ jesterRevealed, poison, poisonUsed, priorProtect, protect, roleModel, scapegoatBlamed, see,+ votes, Stage(..),- _DefendersTurn, _DevotedServantsTurn, _GameOver, _Lynching, _ScapegoatsTurn, _SeersTurn,- _Sunrise, _Sunset, _UrsussGrunt, _VillagesTurn, _WerewolvesTurn, _WildChildsTurn, _WitchsTurn,+ _DefendersTurn, _DevotedServantsTurn, _FerinasGrunt, _GameOver, _Lynching, _ScapegoatsTurn,+ _SeersTurn, _Sunrise, _Sunset, _VillagesTurn, _WerewolvesTurn, _WildChildsTurn, _WitchsTurn, _WolfHoundsTurn, allStages,@@ -82,25 +82,25 @@ -- 'Game.Werewolf.Engine.checkGameOver' will check to see if any of the win conditions are met and -- if so, advance the game's 'stage' to 'GameOver'. data Game = Game- { _stage :: Stage- , _round :: Int- , _players :: [Player]- , _events :: [Event]- , _boots :: Map Text [Text]- , _allegianceChosen :: Maybe Allegiance -- ^ Wolf-hound- , _allowedVoters :: [Text] -- ^ Scapegoat- , _heal :: Bool -- ^ Witch- , _healUsed :: Bool -- ^ Witch- , _passes :: [Text] -- ^ Witch- , _poison :: Maybe Text -- ^ Witch- , _poisonUsed :: Bool -- ^ Witch- , _priorProtect :: Maybe Text -- ^ Defender- , _protect :: Maybe Text -- ^ Defender- , _roleModel :: Maybe Text -- ^ Wild-child- , _scapegoatBlamed :: Bool -- ^ Scapegoat- , _see :: Maybe Text -- ^ Seer- , _villageIdiotRevealed :: Bool -- ^ Village Idiot- , _votes :: Map Text Text -- ^ Villagers and Werewolves+ { _stage :: Stage+ , _round :: Int+ , _players :: [Player]+ , _events :: [Event]+ , _boots :: Map Text [Text]+ , _allegianceChosen :: Maybe Allegiance -- ^ Wolf-hound+ , _allowedVoters :: [Text] -- ^ Scapegoat+ , _heal :: Bool -- ^ Witch+ , _healUsed :: Bool -- ^ Witch+ , _jesterRevealed :: Bool -- ^ Jester+ , _passes :: [Text] -- ^ Witch+ , _poison :: Maybe Text -- ^ Witch+ , _poisonUsed :: Bool -- ^ Witch+ , _priorProtect :: Maybe Text -- ^ Defender+ , _protect :: Maybe Text -- ^ Defender+ , _roleModel :: Maybe Text -- ^ Wild-child+ , _scapegoatBlamed :: Bool -- ^ Scapegoat+ , _see :: Maybe Text -- ^ Seer+ , _votes :: Map Text Text -- ^ Villagers and Werewolves } deriving (Eq, Read, Show) -- | Most of these are fairly self-sufficient (the turn stages). 'Sunrise' and 'Sunset' are provided@@ -109,8 +109,8 @@ -- -- Once the game reaches a turn stage, it requires a 'Game.Werewolf.Command.Command' to help push -- it past. Often only certain roles and commands may be performed at any given stage.-data Stage = DefendersTurn | DevotedServantsTurn | GameOver | Lynching | ScapegoatsTurn- | SeersTurn | Sunrise | Sunset | UrsussGrunt | VillagesTurn | WerewolvesTurn+data Stage = DefendersTurn | DevotedServantsTurn | FerinasGrunt | GameOver | Lynching+ | ScapegoatsTurn | SeersTurn | Sunrise | Sunset | VillagesTurn | WerewolvesTurn | WildChildsTurn | WitchsTurn | WolfHoundsTurn deriving (Eq, Read, Show) @@ -147,7 +147,7 @@ , WerewolvesTurn , WitchsTurn , Sunrise- , UrsussGrunt+ , FerinasGrunt , GameOver ] @@ -166,13 +166,13 @@ has (players . devotedServants . alive) game && length (getVoteResult game) == 1 && isn't devotedServant (head $ getVoteResult game)+stageAvailable game FerinasGrunt = has (players . druids . alive) game stageAvailable _ GameOver = False stageAvailable game Lynching = Map.size (game ^. votes) > 0 stageAvailable game ScapegoatsTurn = game ^. scapegoatBlamed stageAvailable game SeersTurn = has (players . seers . alive) game stageAvailable _ Sunrise = True stageAvailable _ Sunset = True-stageAvailable game UrsussGrunt = has (players . bearTamers . alive) game stageAvailable game VillagesTurn = (has (players . angels . alive) game || not (isFirstRound game)) && any (is alive) (getAllowedVoters game)@@ -203,6 +203,7 @@ , _allowedVoters = players ^.. names , _heal = False , _healUsed = False+ , _jesterRevealed = False , _poison = Nothing , _poisonUsed = False , _priorProtect = Nothing@@ -210,7 +211,6 @@ , _roleModel = Nothing , _scapegoatBlamed = False , _see = Nothing- , _villageIdiotRevealed = False , _votes = Map.empty }
src/Game/Werewolf/Messages.hs view
@@ -43,9 +43,6 @@ -- * Angel's turn messages angelJoinedVillagersMessage, - -- * Bear Tamer's turn messages- ursusGruntsMessage,- -- * Defender's turn messages -- ** Error messages@@ -54,18 +51,21 @@ -- * Devoted Servant's turn messages devotedServantRevealedMessage, devotedServantJoinedPackMessages, + -- * Druid's turn messages+ ferinaGruntsMessage,+ -- * Scapegoat's turn messages scapegoatChoseAllowedVotersMessage, -- ** Error messages- playerMustChooseAtLeastOneTargetMessage, playerCannotChooseVillageIdiotMessage,+ playerMustChooseAtLeastOneTargetMessage, playerCannotChooseJesterMessage, -- * Seer's turn messages playerSeenMessage, -- * Villages' turn messages playerMadeLynchVoteMessage, playerLynchedMessage, noPlayerLynchedMessage,- scapegoatLynchedMessage, villageIdiotLynchedMessage,+ jesterLynchedMessage, scapegoatLynchedMessage, -- ** Error messages playerHasAlreadyVotedMessage,@@ -148,13 +148,13 @@ stageMessages game = case game ^. stage of DefendersTurn -> defendersTurnMessages defendersName DevotedServantsTurn -> devotedServantsTurnMessages devotedServantsName victimsName+ FerinasGrunt -> [] GameOver -> [] Lynching -> [] ScapegoatsTurn -> scapegoatsTurnMessages scapegoatsName SeersTurn -> seersTurnMessages seersName Sunrise -> [sunriseMessage] Sunset -> [nightFallsMessage]- UrsussGrunt -> [] VillagesTurn -> if isFirstRound game then firstVillagesTurnMessages else villagesTurnMessages@@ -394,11 +394,11 @@ pingRoleMessage roleName = publicMessage $ T.concat ["Waiting on the ", roleName, "..."] currentStageMessages :: Text -> Stage -> [Message]+currentStageMessages _ FerinasGrunt = [] currentStageMessages to GameOver = [gameIsOverMessage to] currentStageMessages _ Lynching = [] currentStageMessages _ Sunrise = [] currentStageMessages _ Sunset = []-currentStageMessages _ UrsussGrunt = [] currentStageMessages to turn = [privateMessage to $ T.concat [ "It's currently the ", showTurn turn, " turn." ]]@@ -406,13 +406,13 @@ showTurn :: Stage -> Text showTurn DefendersTurn = "Defender's" showTurn DevotedServantsTurn = "Devoted Servant's"+ showTurn FerinasGrunt = undefined showTurn GameOver = undefined showTurn Lynching = undefined showTurn ScapegoatsTurn = "Scapegoat's" showTurn SeersTurn = "Seer's" showTurn Sunrise = undefined showTurn Sunset = undefined- showTurn UrsussGrunt = undefined showTurn VillagesTurn = "village's" showTurn WerewolvesTurn = "Werewolves'" showTurn WildChildsTurn = "Wild-child's"@@ -458,12 +458,6 @@ , "Now he is stuck here, doomed forever to live out a mortal life as a Villager." ] -ursusGruntsMessage :: Message-ursusGruntsMessage = publicMessage $ T.unwords- [ "Ursus wakes from his slumber, disturbed and on edge."- , "He loudly grunts as he smells danger."- ]- playerCannotProtectSamePlayerTwiceInARowMessage :: Text -> Message playerCannotProtectSamePlayerTwiceInARowMessage to = privateMessage to "You cannot protect the same player twice in a row!"@@ -493,6 +487,12 @@ , "waiting for you." ]] +ferinaGruntsMessage :: Message+ferinaGruntsMessage = publicMessage $ T.unwords+ [ "Ferina wakes from her slumber, disturbed and on edge."+ , "She loudly grunts as she smells danger."+ ]+ scapegoatChoseAllowedVotersMessage :: [Text] -> Message scapegoatChoseAllowedVotersMessage allowedVoters = publicMessage $ T.unwords [ "On the next day only", T.intercalate ", " allowedVoters, "shall be allowed to vote."@@ -503,9 +503,9 @@ playerMustChooseAtLeastOneTargetMessage to = privateMessage to "You must choose at least 1 target!" -playerCannotChooseVillageIdiotMessage :: Text -> Message-playerCannotChooseVillageIdiotMessage to =- privateMessage to "You cannot choose the Village Idiot!"+playerCannotChooseJesterMessage :: Text -> Message+playerCannotChooseJesterMessage to =+ privateMessage to "You cannot choose the Jester!" playerSeenMessage :: Text -> Player -> Message playerSeenMessage to target = privateMessage to $ T.concat@@ -544,18 +544,18 @@ , "Looks like no-one is being burned this day." ] +jesterLynchedMessage :: Text -> Message+jesterLynchedMessage name = publicMessage $ T.concat+ [ "Just as the townsfolk tie ", name, " up to the pyre, a voice in the crowd yells out."+ , " \"We can't burn ", name, "! He's the joke of the town!\" "+ , name, " the Jester is quickly untied and apologised to."+ ]+ scapegoatLynchedMessage :: Text -> Message scapegoatLynchedMessage name = publicMessage $ T.unwords [ "The townsfolk squabble over whom to tie up. Just as they are about to call it a day" , "they notice that", name, "has been acting awfully suspicious." , "Not wanting to take any chances,", name, "is promptly tied to a pyre and burned alive."- ]--villageIdiotLynchedMessage :: Text -> Message-villageIdiotLynchedMessage name = publicMessage $ T.concat- [ "Just as the townsfolk tie ", name, " up to the pyre, a voice in the crowd yells out."- , " \"We can't burn ", name, "! He's that oaf, you know, John's boy!\""- , " The Village Idiot is quickly untied and apologised to." ] playerHasAlreadyVotedMessage :: Text -> Message
src/Game/Werewolf/Player.hs view
@@ -26,16 +26,16 @@ newPlayer, -- ** Traversals- angel, bearTamer, defender, devotedServant, scapegoat, seer, simpleVillager, simpleWerewolf,- villageIdiot, villagerVillager, wildChild, witch, wolfHound,+ angel, defender, devotedServant, druid, jester, scapegoat, seer, simpleVillager, simpleWerewolf,+ villagerVillager, wildChild, witch, wolfHound, villager, werewolf, -- | These are provided just as a bit of sugar to avoid continually writing @'traverse' .@. names, roles, states, -- | N.B., these are not legal traversals for the same reason 'filtered' isn't!- angels, bearTamers, defenders, devotedServants, scapegoats, seers, simpleVillagers,- simpleWerewolves, villageIdiots, villagerVillagers, wildChildren, witches, wolfHounds,+ angels, defenders, devotedServants, druids, jesters, scapegoats, seers, simpleVillagers,+ simpleWerewolves, villagerVillagers, wildChildren, witches, wolfHounds, villagers, werewolves, alive, dead, @@ -83,14 +83,6 @@ angel :: Traversal' Player () angel = role . only angelRole --- | The traversal of 'Player's with a 'bearTamerRole'.------ @--- 'bearTamer' = 'role' . 'only' 'bearTamerRole'--- @-bearTamer :: Traversal' Player ()-bearTamer = role . only bearTamerRole- -- | The traversal of 'Player's with a 'defenderRole'. -- -- @@@ -107,6 +99,22 @@ devotedServant :: Traversal' Player () devotedServant = role . only devotedServantRole +-- | The traversal of 'Player's with a 'druidRole'.+--+-- @+-- 'druid' = 'role' . 'only' 'druidRole'+-- @+druid :: Traversal' Player ()+druid = role . only druidRole++-- | The traversal of 'Player's with a 'jesterRole'.+--+-- @+-- 'jester' = 'role' . 'only' 'jesterRole'+-- @+jester :: Traversal' Player ()+jester = role . only jesterRole+ -- | The traversal of 'Player's with a 'scapegoatRole'. -- -- @@@ -139,14 +147,6 @@ simpleWerewolf :: Traversal' Player () simpleWerewolf = role . only simpleWerewolfRole --- | The traversal of 'Player's with a 'villageIdiotRole'.------ @--- 'villageIdiot' = 'role' . 'only' 'villageIdiotRole'--- @-villageIdiot :: Traversal' Player ()-villageIdiot = role . only villageIdiotRole- -- | The traversal of 'Player's with a 'villagerVillagerRole'. -- -- @@@ -227,14 +227,6 @@ angels :: Traversable t => Traversal' (t Player) Player angels = traverse . filtered (is angel) --- | This 'Traversal' provides the traversal of 'bearTamer' 'Player's.------ @--- 'bearTamers' = 'traverse' . 'filtered' ('is' 'bearTamer')--- @-bearTamers :: Traversable t => Traversal' (t Player) Player-bearTamers = traverse . filtered (is bearTamer)- -- | This 'Traversal' provides the traversal of 'defender' 'Player's. -- -- @@@ -251,6 +243,22 @@ devotedServants :: Traversable t => Traversal' (t Player) Player devotedServants = traverse . filtered (is devotedServant) +-- | This 'Traversal' provides the traversal of 'druid' 'Player's.+--+-- @+-- 'druids' = 'traverse' . 'filtered' ('is' 'druid')+-- @+druids :: Traversable t => Traversal' (t Player) Player+druids = traverse . filtered (is druid)++-- | This 'Traversal' provides the traversal of 'jester' 'Player's.+--+-- @+-- 'jesters' = 'traverse' . 'filtered' ('is' 'jester')+-- @+jesters :: Traversable t => Traversal' (t Player) Player+jesters = traverse . filtered (is jester)+ -- | This 'Traversal' provides the traversal of 'scapegoat' 'Player's. -- -- @@@ -282,14 +290,6 @@ -- @ simpleWerewolves :: Traversable t => Traversal' (t Player) Player simpleWerewolves = traverse . filtered (is simpleWerewolf)---- | This 'Traversal' provides the traversal of 'villageIdiot' 'Player's.------ @--- 'villageIdiots' = 'traverse' . 'filtered' ('is' 'villageIdiot')--- @-villageIdiots :: Traversable t => Traversal' (t Player) Player-villageIdiots = traverse . filtered (is villageIdiot) -- | This 'Traversal' provides the traversal of 'villagerVillager' 'Player's. --
src/Game/Werewolf/Role.hs view
@@ -48,7 +48,7 @@ -- 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,+ defenderRole, druidRole, jesterRole, scapegoatRole, seerRole, simpleVillagerRole, villagerVillagerRole, witchRole, -- *** The Werewolves@@ -102,13 +102,13 @@ allRoles :: [Role] allRoles = [ angelRole- , bearTamerRole , defenderRole , devotedServantRole+ , druidRole+ , jesterRole , scapegoatRole , seerRole , simpleVillagerRole- , villageIdiotRole , simpleWerewolfRole , villagerVillagerRole , wildChildRole@@ -248,34 +248,6 @@ ] } --- | /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./------ 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.-bearTamerRole :: Role-bearTamerRole = Role- { _name = "Bear Tamer"- , _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."- ]- , _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@@ -299,9 +271,37 @@ ] } --- | /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./+-- | /How honoured we are to be in the presence of such a noble leader. The return of the Druid/+-- /marks an exceptional time in Fougères's history! Friend of the woodland creatures, practiced/+-- /philosopher and now, with the help of Ferina their companion, a bane to the Werewolves/+-- /themselves! My does she have a nose on her, strong enough to sniff out lycanthropes in close/+-- /proximity! Listen for her grunt and heed the Druid's words for they will not let you down./ --+-- Each morning when Ferina wakes from her slumber she will be alert and cautious. If the Druid is+-- next to a Werewolf then Ferina will grunt in warning.+druidRole :: Role+druidRole = Role+ { _name = "Druid"+ , _allegiance = Villagers+ , _balance = 2+ , _description = T.unwords+ [ "How honoured we are to be in the presence of such a noble leader. The return of the"+ , "Druid marks an exceptional time in Fougères's history! Friend of the woodland creatures,"+ , "practiced philosopher and now, with the help of Ferina their companion, a bane to the"+ , "Werewolves themselves! My does she have a nose on her, strong enough to sniff out"+ , "lycanthropes in close proximity! Listen for her grunt and heed the Druid's words for"+ , "they will not let you down."+ ]+ , _rules = T.unwords+ [ "Each morning when Ferina wakes from her slumber she will be alert and cautious. If the"+ , "Druid is next to a Werewolf then Ferina will grunt in warning."+ ]+ }++-- | /Werewolves don't just spring up out of the ground! That's where dwarves come from. Clearly/+-- /someone is to blame for this affliction to Fougères. Ah! Unluckily, since no-one actually/+-- /knows who brought them here, the blame is always laid upon the Scapegoat./+-- -- If the village's vote ends in a tie, it's the Scapegoat who is eliminated instead of no-one. -- -- In this event, the Scapegoat has one last task to complete: he must choose whom is permitted to@@ -312,8 +312,9 @@ , _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."+ [ "Werewolves don't just spring up out of the ground! That's where dwarves come from."+ , "Clearly someone is to blame for this affliction to Fougères. Ah! Unluckily, since no-one"+ , "actually knows who brought them here, the blame is always laid upon the Scapegoat." ] , _rules = T.intercalate "\n" [ T.unwords@@ -369,31 +370,32 @@ ] } --- | /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./+-- | /Every village needs a Jester, they're so stupid but provide so much entertainment! The Jester/+-- /may not have any special abilities, but at least no one in the village would want to hurt/+-- /him./ ----- 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.+-- If the village votes to lynch the Jester, his identity is revealed. The village realise there's+-- no point in burning him and so he is set free. ----- The Village Idiot continues to play but may no longer vote, as what would the vote of an idiot--- be worth?-villageIdiotRole :: Role-villageIdiotRole = Role- { _name = "Village Idiot"+-- The Jester continues to play but may no longer vote as no one can take him seriously.+jesterRole :: Role+jesterRole = Role+ { _name = "Jester" , _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."+ [ "Every village needs a Jester, they're so stupid but provide so much entertainment! The"+ , "Jester may not have any special abilities, but at least no one in the village would want"+ , "to hurt him." ] , _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."+ [ "If the village votes to lynch the Jester, his identity is revealed. The village"+ , "realise there's no point in burning him and so he is set free." ] , T.unwords- [ "The Village Idiot continues to play but may no longer vote, as what would the vote"- , "of an idiot be worth?"+ [ "The Jester continues to play but may no longer vote as no one can take him"+ , "seriously." ] ] }@@ -420,24 +422,30 @@ ] } --- | /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./+-- | /Somehow forgotten with the coming of the Werewolves, the Witch has a chance to prove themself/+-- /valuable to the village. The Witch is blessed (or maybe cursed) with the ability to make two/+-- /powerful potions; one of which may heal a victim of the Werewolves, the other able to poison/+-- /a player. The use of these potions could alter the village's currently misguided perception/+-- /of the Witch./ ----- 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.+-- The Witch is called after the Werewolves. They are able to heal and poison one player per game.+-- There is no restriction on using both potions in one night or to heal themself. witchRole :: Role witchRole = Role { _name = "Witch" , _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."+ [ "Somehow forgotten with the coming of the Werewolves, the Witch has a chance to prove"+ , "themself valuable to the village. The Witch is blessed (or maybe cursed) with the"+ , "ability to make two powerful potions; one of which may heal a victim of the Werewolves,"+ , "the other able to poison a player. The use of these potions could alter the village's"+ , "currently misguided perception of the Witch." ] , _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."+ [ "The Witch is called after the Werewolves. They are able to heal and poison one player"+ , "per game. There is no restriction on using both potions in one night or to heal"+ , "themself." ] }
src/Game/Werewolf/Util.hs view
@@ -32,7 +32,7 @@ -- ** Queries doesPlayerExist,- isPlayerDefender, isPlayerDevotedServant, isPlayerScapegoat, isPlayerSeer, isPlayerVillageIdiot,+ isPlayerDefender, isPlayerDevotedServant, isPlayerJester, isPlayerScapegoat, isPlayerSeer, isPlayerWildChild, isPlayerWitch, isPlayerWolfHound, isPlayerWerewolf, isPlayerAlive, isPlayerDead,@@ -42,10 +42,10 @@ import Control.Monad.Extra import Control.Monad.State hiding (state) -import Data.List-import Data.Maybe-import qualified Data.Map as Map-import Data.Text (Text)+import Data.List+import qualified Data.Map as Map+import Data.Maybe+import Data.Text (Text) import Game.Werewolf.Game hiding (doesPlayerExist, getAllowedVoters, getPendingVoters, getVoteResult, hasAngelWon, hasAnyoneWon, hasVillagersWon,@@ -173,14 +173,14 @@ isPlayerDevotedServant :: MonadState Game m => Text -> m Bool isPlayerDevotedServant name' = is devotedServant <$> findPlayerBy_ name name' +isPlayerJester :: MonadState Game m => Text -> m Bool+isPlayerJester name' = is jester <$> findPlayerBy_ name name'+ isPlayerScapegoat :: MonadState Game m => Text -> m Bool isPlayerScapegoat name' = is scapegoat <$> findPlayerBy_ name name' isPlayerSeer :: MonadState Game m => Text -> m Bool isPlayerSeer name' = is seer <$> findPlayerBy_ name name'--isPlayerVillageIdiot :: MonadState Game m => Text -> m Bool-isPlayerVillageIdiot name' = is villageIdiot <$> findPlayerBy_ name name' isPlayerWildChild :: MonadState Game m => Text -> m Bool isPlayerWildChild name' = is wildChild <$> findPlayerBy_ name name'
test/src/Game/Werewolf/Test/Arbitrary.hs view
@@ -19,10 +19,10 @@ GameOnSecondRound(..), GameWithAllegianceChosen(..), GameWithAllowedVoters(..), GameWithConflictingVote(..), GameWithDeadPlayers(..), GameWithDevourEvent(..), GameWithDevourVotes(..), GameWithHeal(..),- GameWithLynchVotes(..), GameWithMajorityVote(..), GameWithOneAllegianceAlive(..),- GameWithPassAtDevotedServantsTurn(..), GameWithPoison(..), GameWithProtect(..),- GameWithProtectAndDevourVotes(..), GameWithRoleModel(..), GameWithRoleModelAtVillagesTurn(..),- GameWithSee(..), GameWithVillageIdiotRevealedAtVillagesTurn(..),+ GameWithJesterRevealedAtVillagesTurn(..), GameWithLynchVotes(..), GameWithMajorityVote(..),+ GameWithOneAllegianceAlive(..), GameWithPassAtDevotedServantsTurn(..), GameWithPoison(..),+ GameWithProtect(..), GameWithProtectAndDevourVotes(..), GameWithRoleModel(..),+ GameWithRoleModelAtVillagesTurn(..), GameWithSee(..), -- ** Player arbitraryPlayerSet,@@ -275,6 +275,26 @@ return $ GameWithHeal (run_ (apply command) game) +newtype GameWithJesterRevealed = GameWithJesterRevealed Game+ deriving (Eq, Show)++instance Arbitrary GameWithJesterRevealed where+ arbitrary = do+ game <- arbitrary+ let jestersName = game ^?! players . jesters . name+ let game' = game & jesterRevealed .~ True & allowedVoters %~ delete jestersName++ return $ GameWithJesterRevealed game'++newtype GameWithJesterRevealedAtVillagesTurn = GameWithJesterRevealedAtVillagesTurn Game+ deriving (Eq, Show)++instance Arbitrary GameWithJesterRevealedAtVillagesTurn where+ arbitrary = do+ (GameWithJesterRevealed game) <- arbitrary++ return $ GameWithJesterRevealedAtVillagesTurn (game & stage .~ VillagesTurn)+ newtype GameWithLynchVotes = GameWithLynchVotes Game deriving (Eq, Show) @@ -399,26 +419,6 @@ return $ GameWithSee (run_ (apply command) game') -newtype GameWithVillageIdiotRevealed = GameWithVillageIdiotRevealed Game- deriving (Eq, Show)--instance Arbitrary GameWithVillageIdiotRevealed where- arbitrary = do- game <- arbitrary- let villageIdiotsName = game ^?! players . villageIdiots . name- let game' = game & villageIdiotRevealed .~ True & allowedVoters %~ delete villageIdiotsName-- return $ GameWithVillageIdiotRevealed game'--newtype GameWithVillageIdiotRevealedAtVillagesTurn = GameWithVillageIdiotRevealedAtVillagesTurn Game- deriving (Eq, Show)--instance Arbitrary GameWithVillageIdiotRevealedAtVillagesTurn where- arbitrary = do- (GameWithVillageIdiotRevealed game) <- arbitrary-- return $ GameWithVillageIdiotRevealedAtVillagesTurn (game & stage .~ VillagesTurn)- arbitraryPlayerSet :: Gen [Player] arbitraryPlayerSet = do n <- choose (14, 30)@@ -438,13 +438,13 @@ [ arbitraryDevotedServantPassCommand game , arbitraryRevealCommand game ]+ FerinasGrunt -> return $ Blind noopCommand GameOver -> return $ Blind noopCommand Lynching -> return $ Blind noopCommand ScapegoatsTurn -> arbitraryScapegoatChooseCommand game SeersTurn -> arbitrarySeeCommand game Sunrise -> return $ Blind noopCommand Sunset -> return $ Blind noopCommand- UrsussGrunt -> return $ Blind noopCommand VillagesTurn -> arbitraryVillagerVoteCommand game WerewolvesTurn -> arbitraryWerewolfVoteCommand game WildChildsTurn -> arbitraryWildChildChooseCommand game
test/src/Game/Werewolf/Test/Command/Reveal.hs view
@@ -33,7 +33,7 @@ , testProperty "reveal command errors when caller not devoted servant" prop_revealCommandErrorsWhenCallerNotDevotedServant , testProperty "reveal command sets caller's role" prop_revealCommandSetsCallersRole , testProperty "reveal command sets target's role" prop_revealCommandSetsTargetsRole- , testProperty "reveal command resets role when village idiot" prop_revealCommandResetsRoleWhenVillageIdiot+ , testProperty "reveal command resets role when jester" prop_revealCommandResetsRoleWhenJester , testProperty "reveal command resets role when wild-child" prop_revealCommandResetsRoleWhenWildChild , testProperty "reveal command resets role when witch" prop_revealCommandResetsRoleWhenWitch , testProperty "reveal command resets role when wolf-hound" prop_revealCommandResetsRoleWhenWolfHound@@ -90,16 +90,16 @@ where targetsName = head (getVoteResult game) ^. name -prop_revealCommandResetsRoleWhenVillageIdiot :: GameAtDevotedServantsTurn -> Bool-prop_revealCommandResetsRoleWhenVillageIdiot (GameAtDevotedServantsTurn game) = do+prop_revealCommandResetsRoleWhenJester :: GameAtDevotedServantsTurn -> Bool+prop_revealCommandResetsRoleWhenJester (GameAtDevotedServantsTurn game) = do let devotedServantsName = game ^?! players . devotedServants . name let command = revealCommand devotedServantsName let game'' = run_ (apply command) game' - not $ game'' ^. villageIdiotRevealed+ not $ game'' ^. jesterRevealed where targetsName = head (getVoteResult game) ^. name- game' = game & players . traverse . filteredBy name targetsName . role .~ villageIdiotRole & villageIdiotRevealed .~ True+ game' = game & players . traverse . filteredBy name targetsName . role .~ jesterRole & jesterRevealed .~ True prop_revealCommandResetsRoleWhenWildChild :: GameAtDevotedServantsTurn -> Bool prop_revealCommandResetsRoleWhenWildChild (GameAtDevotedServantsTurn game) = do
test/src/Game/Werewolf/Test/Command/Vote.hs view
@@ -46,7 +46,7 @@ , 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 errors when caller is known jester" prop_villagerVoteCommandErrorsWhenCallerIsKnownJester , testProperty "villager vote command updates votes" prop_villagerVoteCommandUpdatesVotes ] @@ -183,14 +183,14 @@ where game' = run_ checkStage game -prop_villagerVoteCommandErrorsWhenCallerIsKnownVillageIdiot :: GameWithVillageIdiotRevealedAtVillagesTurn -> Property-prop_villagerVoteCommandErrorsWhenCallerIsKnownVillageIdiot (GameWithVillageIdiotRevealedAtVillagesTurn game) =+prop_villagerVoteCommandErrorsWhenCallerIsKnownJester :: GameWithJesterRevealedAtVillagesTurn -> Property+prop_villagerVoteCommandErrorsWhenCallerIsKnownJester (GameWithJesterRevealedAtVillagesTurn game) = forAll (arbitraryPlayer game) $ \target -> do let command = Villager.voteCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game command where- caller = game ^?! players . villageIdiots+ caller = game ^?! players . jesters prop_villagerVoteCommandUpdatesVotes :: GameAtVillagesTurn -> Property prop_villagerVoteCommandUpdatesVotes (GameAtVillagesTurn game) =
test/src/Game/Werewolf/Test/Engine.hs view
@@ -54,7 +54,7 @@ , testProperty "check devoted servant's turn does nothing unless revealed or passed" prop_checkDevotedServantsTurnDoesNothingUnlessRevealedOrPassed , testProperty "check lynching lynches one player when consensus" prop_checkLynchingLynchesOnePlayerWhenConsensus- , testProperty "check lynching lynches no one when target is village idiot" prop_checkLynchingLynchesNoOneWhenTargetIsVillageIdiot+ , testProperty "check lynching lynches no one when target is jester" prop_checkLynchingLynchesNoOneWhenTargetIsJester , testProperty "check lynching lynches scapegoat when conflicted" prop_checkLynchingLynchesScapegoatWhenConflicted , testProperty "check lynching lynches no one when conflicted and no scapegoats" prop_checkLynchingLynchesNoOneWhenConflictedAndNoScapegoats , testProperty "check lynching resets votes" prop_checkLynchingResetsVotes@@ -212,18 +212,18 @@ prop_checkLynchingLynchesOnePlayerWhenConsensus :: GameWithPassAtDevotedServantsTurn -> Property prop_checkLynchingLynchesOnePlayerWhenConsensus (GameWithPassAtDevotedServantsTurn game) =- isn't villageIdiot target+ isn't jester target ==> length (run_ checkStage game ^.. players . traverse . dead) == 1 where target = head $ getVoteResult game -prop_checkLynchingLynchesNoOneWhenTargetIsVillageIdiot :: GameAtVillagesTurn -> Bool-prop_checkLynchingLynchesNoOneWhenTargetIsVillageIdiot (GameAtVillagesTurn game) = do- let game' = foldr (\player -> run_ (apply $ voteCommand (player ^. name) (villageIdiot ^. name))) game (game ^. players)+prop_checkLynchingLynchesNoOneWhenTargetIsJester :: GameAtVillagesTurn -> Bool+prop_checkLynchingLynchesNoOneWhenTargetIsJester (GameAtVillagesTurn game) = do+ let game' = foldr (\player -> run_ (apply $ voteCommand (player ^. name) (jester ^. name))) game (game ^. players) none (is dead) (run_ checkStage game' ^. players) where- villageIdiot = game ^?! players . villageIdiots+ jester = game ^?! players . jesters prop_checkLynchingLynchesScapegoatWhenConflicted :: GameAtScapegoatsTurn -> Bool prop_checkLynchingLynchesScapegoatWhenConflicted (GameAtScapegoatsTurn game) =@@ -242,8 +242,8 @@ where game' = run_ checkStage game expectedAllowedVoters- | game' ^. villageIdiotRevealed = filter (isn't villageIdiot) $ game' ^. players- | otherwise = game' ^.. players . traverse . alive+ | game' ^. jesterRevealed = filter (isn't jester) $ game' ^. players+ | otherwise = game' ^.. players . traverse . alive prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn :: GameWithAllowedVoters -> Bool prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn (GameWithAllowedVoters game) =@@ -296,7 +296,7 @@ let devotedServantsName = game ^?! players . devotedServants . name let command = passCommand devotedServantsName - isn't angel roleModel' && isn't devotedServant roleModel' && isn't villageIdiot roleModel'+ isn't angel roleModel' && isn't devotedServant roleModel' && isn't jester roleModel' ==> is werewolf $ run_ (checkStage >> apply command >> checkStage) game' ^?! players . wildChildren where roleModel' = game ^?! players . traverse . filteredBy name (fromJust $ game ^. roleModel)
test/src/Game/Werewolf/Test/Game.hs view
@@ -38,7 +38,7 @@ , testProperty "new game starts with no protect" prop_newGameStartsWithNoProtect , testProperty "new game starts with scapegoat blamed false" prop_newGameStartsWithScapegoatBlamedFalse , testProperty "new game starts with no see" prop_newGameStartsWithNoSee- , testProperty "new game starts with village idiot revealed false" prop_newGameStartsWithVillageIdiotRevealedFalse+ , testProperty "new game starts with jester revealed false" prop_newGameStartsWithJesterRevealedFalse , testProperty "new game starts with votes empty" prop_newGameStartsWithVotesEmpty , testProperty "new game uses given players" prop_newGameUsesGivenPlayers ]@@ -89,9 +89,9 @@ prop_newGameStartsWithNoSee :: [Player] -> Bool prop_newGameStartsWithNoSee players = isNothing $ newGame players ^. see -prop_newGameStartsWithVillageIdiotRevealedFalse :: [Player] -> Bool-prop_newGameStartsWithVillageIdiotRevealedFalse players =- not $ newGame players ^. villageIdiotRevealed+prop_newGameStartsWithJesterRevealedFalse :: [Player] -> Bool+prop_newGameStartsWithJesterRevealedFalse players =+ not $ newGame players ^. jesterRevealed prop_newGameStartsWithVotesEmpty :: [Player] -> Bool prop_newGameStartsWithVotesEmpty players = has (votes . _Empty) (newGame players)
werewolf.cabal view
@@ -1,5 +1,5 @@ name: werewolf-version: 0.4.11.0+version: 0.4.12.0 author: Henry J. Wylde maintainer: public@hjwylde.com