Merge branch 'issue/41'

CHANGELOG.md

@@ -2,6 +2,10 @@
 
 #### Upcoming
 
+*Minor*
+
+* Added the Village Idiot role. ([#41](https://github.com/hjwylde/werewolf/issues/41))
+
 *Revisions*
 
 * Fixed the Defender being unable to protect himself.

README.md

@@ -37,6 +37,7 @@ The implemented roles are split into four categories.
 * Scapegoat.
 * Seer.
 * Simple Villager.
+* Village Idiot.
 * Villager-Villager.
 * Witch.
 

src/Game/Werewolf/Command.hs

@@ -230,9 +230,11 @@ voteDevourCommand callerName targetName = Command $ do
 voteLynchCommand :: Text -> Text -> Command
 voteLynchCommand callerName targetName = Command $ do
     validatePlayer callerName callerName
-    unlessM isVillagesTurn                          $ throwError [playerCannotDoThatRightNowMessage callerName]
-    whenJustM (getPlayerVote callerName) . const    $ throwError [playerHasAlreadyVotedMessage callerName]
+    whenM (use villageIdiotRevealed &&^ isPlayerVillageIdiot callerName)    $ throwError [playerCannotDoThatMessage callerName]
+    unlessM isVillagesTurn                                                  $ throwError [playerCannotDoThatRightNowMessage callerName]
+    whenJustM (getPlayerVote callerName) . const                            $ throwError [playerHasAlreadyVotedMessage callerName]
     validatePlayer callerName targetName
+    whenM (use villageIdiotRevealed &&^ isPlayerVillageIdiot targetName)    $ throwError [playerCannotLynchVillageIdiotMessage callerName]
 
     votes %= Map.insert callerName targetName
 

src/Game/Werewolf/Engine.hs

@@ -44,7 +44,8 @@ module Game.Werewolf.Engine (
     createPlayers,
 
     -- ** Queries
-    doesPlayerExist, isPlayerDefender, isPlayerSeer, isPlayerWildChild, isPlayerWitch,
+    doesPlayerExist,
+    isPlayerDefender, isPlayerSeer, isPlayerVillageIdiot, isPlayerWildChild, isPlayerWitch,
     isPlayerWolfHound,
     isPlayerWerewolf,
     isPlayerAlive, isPlayerDead,
@@ -138,16 +139,19 @@ checkStage' = use stage >>= \stage' -> case stage' of
         advanceStage
 
     VillagesTurn -> do
-        playersCount    <- uses players (length . filterAlive)
+        alivePlayers    <- uses players filterAlive
+        playersCount    <- ifM (use villageIdiotRevealed)
+            (return . length $ filter (not . isVillageIdiot) alivePlayers)
+            (return $ length alivePlayers)
         votes'          <- use votes
 
         when (playersCount == Map.size votes') $ do
             tell $ map (uncurry playerMadeLynchVoteMessage) (Map.toList votes')
 
             getVoteResult >>= \votees -> case votees of
-                [votee]   -> do
-                    killPlayer $ votee ^. name
-                    tell [playerLynchedMessage votee]
+                [votee]   -> if isVillageIdiot votee
+                    then villageIdiotRevealed .= True >> tell [villageIdiotLynchedMessage $ votee ^. name]
+                    else killPlayer (votee ^. name) >> tell [playerLynchedMessage votee]
                 _               ->
                     findPlayerByRole scapegoatRole >>= \mScapegoat -> case mScapegoat of
                         Just scapegoat  -> killPlayer (scapegoat ^. name) >> tell [scapegoatLynchedMessage (scapegoat ^. name)]
@@ -350,6 +354,9 @@ isPlayerDefender name = isDefender <$> findPlayerByName_ name
 isPlayerSeer :: MonadState Game m => Text -> m Bool
 isPlayerSeer name = isSeer <$> findPlayerByName_ name
 
+isPlayerVillageIdiot :: MonadState Game m => Text -> m Bool
+isPlayerVillageIdiot name = isVillageIdiot <$> findPlayerByName_ name
+
 isPlayerWildChild :: MonadState Game m => Text -> m Bool
 isPlayerWildChild name = isWildChild <$> findPlayerByName_ name
 

src/Game/Werewolf/Game.hs

@@ -14,7 +14,7 @@ Game and stage data structures.
 module Game.Werewolf.Game (
     -- * Game
     Game, stage, round, players, events, passes, heal, healUsed, poison, poisonUsed, priorProtect,
-    protect, roleModel, see, votes,
+    protect, roleModel, see, villageIdiotRevealed, votes,
     newGame,
 
     -- ** Manipulations
@@ -54,20 +54,21 @@ import Game.Werewolf.Role   hiding (name)
 import Prelude hiding (round)
 
 data Game = Game
-    { _stage        :: Stage
-    , _round        :: Int
-    , _players      :: [Player]
-    , _events       :: [Event]
-    , _passes       :: [Text]
-    , _heal         :: Bool
-    , _healUsed     :: Bool
-    , _poison       :: Maybe Text
-    , _poisonUsed   :: Bool
-    , _priorProtect :: Maybe Text
-    , _protect      :: Maybe Text
-    , _roleModel    :: Maybe Text
-    , _see          :: Maybe Text
-    , _votes        :: Map Text Text
+    { _stage                :: Stage
+    , _round                :: Int
+    , _players              :: [Player]
+    , _events               :: [Event]
+    , _passes               :: [Text]
+    , _heal                 :: Bool
+    , _healUsed             :: Bool
+    , _poison               :: Maybe Text
+    , _poisonUsed           :: Bool
+    , _priorProtect         :: Maybe Text
+    , _protect              :: Maybe Text
+    , _roleModel            :: Maybe Text
+    , _see                  :: Maybe Text
+    , _villageIdiotRevealed :: Bool
+    , _votes                :: Map Text Text
     } deriving (Eq, Read, Show)
 
 data Stage  = GameOver | DefendersTurn | SeersTurn | Sunrise | Sunset | VillagesTurn
@@ -85,20 +86,21 @@ newGame :: [Player] -> Game
 newGame players = game & stage .~ head (filter (stageAvailable game) stageCycle)
     where
         game = Game
-            { _stage        = Sunset
-            , _round        = 0
-            , _players      = players
-            , _events       = []
-            , _passes       = []
-            , _heal         = False
-            , _healUsed     = False
-            , _poison       = Nothing
-            , _poisonUsed   = False
-            , _priorProtect = Nothing
-            , _protect      = Nothing
-            , _roleModel    = Nothing
-            , _see          = Nothing
-            , _votes        = Map.empty
+            { _stage                = Sunset
+            , _round                = 0
+            , _players              = players
+            , _events               = []
+            , _passes               = []
+            , _heal                 = False
+            , _healUsed             = False
+            , _poison               = Nothing
+            , _poisonUsed           = False
+            , _priorProtect         = Nothing
+            , _protect              = Nothing
+            , _roleModel            = Nothing
+            , _see                  = Nothing
+            , _villageIdiotRevealed = False
+            , _votes                = Map.empty
             }
 
 killPlayer :: Text -> Game -> Game

src/Game/Werewolf/Player.hs

@@ -32,7 +32,7 @@ module Game.Werewolf.Player (
 
     -- ** Queries
     doesPlayerExist,
-    isAngel, isDefender, isScapegoat, isSeer, isSimpleVillager, isSimpleWerewolf,
+    isAngel, isDefender, isScapegoat, isSeer, isSimpleVillager, isSimpleWerewolf, isVillageIdiot,
     isVillagerVillager, isWildChild, isWitch, isWolfHound,
     isVillager, isWerewolf,
     isAlive, isDead,
@@ -138,6 +138,10 @@ isSimpleVillager player = player ^. role == simpleVillagerRole
 isSimpleWerewolf :: Player -> Bool
 isSimpleWerewolf player = player ^. role == simpleWerewolfRole
 
+-- | @isVillageIdiot player = player ^. role == 'villageIdiotRole'@
+isVillageIdiot :: Player -> Bool
+isVillageIdiot player = player ^. role == villageIdiotRole
+
 -- | @isVillagerVillager player = player ^. role == 'villagerVillagerRole'@
 isVillagerVillager :: Player -> Bool
 isVillagerVillager player = player ^. role == villagerVillagerRole

src/Game/Werewolf/Response.hs

@@ -58,7 +58,8 @@ module Game.Werewolf.Response (
 
     -- ** Villages' turn messages
     playerMadeLynchVoteMessage, playerLynchedMessage, noPlayerLynchedMessage,
-    scapegoatLynchedMessage, playerHasAlreadyVotedMessage,
+    scapegoatLynchedMessage, villageIdiotLynchedMessage, playerHasAlreadyVotedMessage,
+    playerCannotLynchVillageIdiotMessage,
 
     -- ** Werewolves' turn messages
     playerMadeDevourVoteMessage, playerDevouredMessage, noPlayerDevouredMessage,
@@ -494,9 +495,20 @@ scapegoatLynchedMessage name = publicMessage $ T.unwords
     , "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
 playerHasAlreadyVotedMessage to = privateMessage to "You've already voted!"
 
+playerCannotLynchVillageIdiotMessage :: Text -> Message
+playerCannotLynchVillageIdiotMessage to =
+    privateMessage to "You cannot lynch the Village Idiot!"
+
 playerMadeDevourVoteMessage :: Text -> Text -> Text -> Message
 playerMadeDevourVoteMessage to voterName targetName = privateMessage to $ T.concat
     [ voterName, " voted to devour ", targetName, "."

src/Game/Werewolf/Role.hs

@@ -37,7 +37,8 @@ module Game.Werewolf.Role (
 
     -- *** The Villagers
     -- | The Villagers must lynch all of the Werewolves.
-    defenderRole, scapegoatRole, seerRole, simpleVillagerRole, villagerVillagerRole, witchRole,
+    defenderRole, scapegoatRole, seerRole, simpleVillagerRole, villageIdiotRole,
+    villagerVillagerRole, witchRole,
 
     -- *** The Werewolves
     -- | The Werewolves must devour all of the Villagers.
@@ -83,6 +84,7 @@ allRoles =
     , scapegoatRole
     , seerRole
     , simpleVillagerRole
+    , villageIdiotRole
     , simpleWerewolfRole
     , villagerVillagerRole
     , wildChildRole
@@ -114,7 +116,6 @@ allAllegiances = [Angel, Villagers, Werewolves]
 --   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.
 wildChildRole :: Role
 wildChildRole = Role
@@ -252,6 +253,27 @@ simpleVillagerRole = Role
         "Bluffing can be a good technique, but you had better be convincing about what you say."
     }
 
+-- | /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./
+--
+--   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.
+--
+--   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"
+    , _allegiance   = Villagers
+    , _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."
+        ]
+    , _advice       =
+        "Hah! As if advice would do you any good..."
+    }
+
 -- | /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./

test/src/Game/Werewolf/Test/Arbitrary.hs

@@ -18,9 +18,9 @@ module Game.Werewolf.Test.Arbitrary (
     GameAtWitchsTurn(..), GameAtWolfHoundsTurn(..),
     GameOnSecondRound(..),
     GameWithDeadPlayers(..), GameWithDevourEvent(..), GameWithDevourVotes(..), GameWithHeal(..),
-    GameWithLynchVotes(..), GameWithOneAllegianceAlive(..), GameWithPoison(..),
-    GameWithProtect(..), GameWithProtectAndDevourVotes(..), GameWithRoleModel(..),
-    GameWithRoleModelAtVillagesTurn(..), GameWithSee(..), GameWithZeroAllegiancesAlive(..),
+    GameWithLynchVotes(..), GameWithOneAllegianceAlive(..), GameWithPoison(..), GameWithProtect(..),
+    GameWithProtectAndDevourVotes(..), GameWithRoleModel(..), GameWithRoleModelAtVillagesTurn(..),
+    GameWithSee(..), GameWithVillageIdiotRevealedAtVillagesTurn(..), GameWithZeroAllegiancesAlive(..),
 
     -- ** Player
     arbitraryPlayerSet,
@@ -323,6 +323,24 @@ instance Arbitrary GameWithSee where
 
         return $ GameWithSee (run_ (apply command) game')
 
+newtype GameWithVillageIdiotRevealed = GameWithVillageIdiotRevealed Game
+    deriving (Eq, Show)
+
+instance Arbitrary GameWithVillageIdiotRevealed where
+    arbitrary = do
+        game <- arbitrary
+
+        return $ GameWithVillageIdiotRevealed (game & villageIdiotRevealed .~ True)
+
+newtype GameWithVillageIdiotRevealedAtVillagesTurn = GameWithVillageIdiotRevealedAtVillagesTurn Game
+    deriving (Eq, Show)
+
+instance Arbitrary GameWithVillageIdiotRevealedAtVillagesTurn where
+    arbitrary = do
+        (GameWithVillageIdiotRevealed game) <- arbitrary
+
+        return $ GameWithVillageIdiotRevealedAtVillagesTurn (game & stage .~ VillagesTurn)
+
 newtype GameWithZeroAllegiancesAlive = GameWithZeroAllegiancesAlive Game
     deriving (Eq, Show)
 

test/src/Game/Werewolf/Test/Command.hs

@@ -127,14 +127,16 @@ allCommandTests =
     , testProperty "vote devour command errors when target werewolf"        prop_voteDevourCommandErrorsWhenTargetWerewolf
     , testProperty "vote devour command updates votes"                      prop_voteDevourCommandUpdatesVotes
 
-    , 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 updates votes"                       prop_voteLynchCommandUpdatesVotes
+    , 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 known village idiot"   prop_voteLynchCommandErrorsWhenCallerIsKnownVillageIdiot
+    , testProperty "vote lynch command errors when target is known village idiot"   prop_voteLynchCommandErrorsWhenTargetIsKnownVillageIdiot
+    , testProperty "vote lynch command updates votes"                               prop_voteLynchCommandUpdatesVotes
     ]
 
 prop_chooseAllegianceCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property
@@ -777,6 +779,24 @@ prop_voteLynchCommandErrorsWhenCallerHasVoted (GameWithLynchVotes game) =
 
         verbose_runCommandErrors game command
 
+prop_voteLynchCommandErrorsWhenCallerIsKnownVillageIdiot :: GameWithVillageIdiotRevealedAtVillagesTurn -> Property
+prop_voteLynchCommandErrorsWhenCallerIsKnownVillageIdiot (GameWithVillageIdiotRevealedAtVillagesTurn game) =
+    forAll (arbitraryPlayer game) $ \target -> do
+        let command = voteLynchCommand (caller ^. name) (target ^. name)
+
+        verbose_runCommandErrors game command
+    where
+        caller = findByRole_ villageIdiotRole (game ^. players)
+
+prop_voteLynchCommandErrorsWhenTargetIsKnownVillageIdiot :: GameWithVillageIdiotRevealedAtVillagesTurn -> Property
+prop_voteLynchCommandErrorsWhenTargetIsKnownVillageIdiot (GameWithVillageIdiotRevealedAtVillagesTurn game) =
+    forAll (arbitraryPlayer game) $ \caller -> do
+        let command = voteLynchCommand (caller ^. name) (target ^. name)
+
+        verbose_runCommandErrors game command
+    where
+        target = findByRole_ villageIdiotRole (game ^. players)
+
 prop_voteLynchCommandUpdatesVotes :: GameAtVillagesTurn -> Property
 prop_voteLynchCommandUpdatesVotes (GameAtVillagesTurn game) =
     forAll (arbitraryVoteLynchCommand game) $ \(Blind command) -> do