(#62) added the Scapegoat's ability to choose whom may vote on the ne…

…xt day when he is blamed

CHANGELOG.md

@@ -5,6 +5,7 @@
 *Minor*
 
 * Added the Village Idiot role. ([#41](https://github.com/hjwylde/werewolf/issues/41))
+* Added the Scapegoat's ability to choose whom may vote on the next day when he is blamed. ([#62](https://github.com/hjwylde/werewolf/issues/62))
 
 *Revisions*
 

app/Werewolf/Commands/Choose.hs

@@ -9,6 +9,8 @@ Maintainer  : public@hjwylde.com
 Options and handler for the choose subcommand.
 -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Werewolf.Commands.Choose (
     -- * Options
     Options(..),
@@ -17,12 +19,14 @@ module Werewolf.Commands.Choose (
     handle,
 ) where
 
+import Control.Lens
 import Control.Monad.Except
 import Control.Monad.Extra
 import Control.Monad.State
 import Control.Monad.Writer
 
-import Data.Text (Text)
+import           Data.Text (Text)
+import qualified Data.Text as T
 
 import Game.Werewolf.Command
 import Game.Werewolf.Engine   hiding (isWildChildsTurn)
@@ -41,10 +45,12 @@ handle callerName (Options arg) = do
 
     game <- readGame
 
-    let command = (if isWildChildsTurn game
-            then choosePlayerCommand
-            else chooseAllegianceCommand
-            ) callerName arg
+    let command = case game ^. stage of
+            ScapegoatsTurn  -> choosePlayersCommand callerName (T.splitOn "," arg)
+            WildChildsTurn  -> choosePlayerCommand callerName arg
+            WolfHoundsTurn  -> chooseAllegianceCommand callerName arg
+            -- TODO (hjw): throw an error
+            _               -> undefined
 
     case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of
         Left errorMessages      -> exitWith failure { messages = errorMessages }

app/Werewolf/Commands/Help.hs

@@ -58,7 +58,7 @@ handle callerName (Options Nothing) = exitWith success
 
 commandsMessages :: [Text]
 commandsMessages =
-    [ "choose (ALLEGIANCE|PLAYER) - choose an allegiance or player."
+    [ "choose (ALLEGIANCE|PLAYER[,...]) - choose an allegiance or player(s)."
     , "end - ends the current game."
     , "heal - heal the devoured player."
     , "pass - pass on healing or poisoning a player."
@@ -127,9 +127,10 @@ rulesMessages = map (T.intercalate "\n")
       , "8. The Witch wakes up and may heal the victim and/or poison someone."
       , "9. The village wakes up and find the victim."
       , "10. The village votes to lynch a suspect."
+      , "11. (When the Scapegoat is blamed) the Scapegot chooses whom may vote on the next day."
       , T.unwords
         [ "The game is over when only Villagers or Werewolves are left alive,"
-        , "or one of the Loners completes their own objective."
+        , "or when one of the Loners completes their own objective."
         ]
       ]
     ]

app/Werewolf/Options.hs

@@ -19,10 +19,9 @@ module Werewolf.Options (
     werewolfPrefs, werewolfInfo, werewolf,
 ) where
 
-import           Data.List.Extra
-import           Data.Text       (Text)
-import qualified Data.Text       as T
-import           Data.Version    (showVersion)
+import           Data.Text    (Text)
+import qualified Data.Text    as T
+import           Data.Version (showVersion)
 
 import qualified Werewolf.Commands.Choose    as Choose
 import qualified Werewolf.Commands.Help      as Help
@@ -89,7 +88,7 @@ werewolf = Options
         , help "Specify the calling player's name"
         ])
     <*> subparser (mconcat
-        [ command "choose"      $ info (helper <*> choose)      (fullDesc <> progDesc "Choose an allegiance")
+        [ command "choose"      $ info (helper <*> choose)      (fullDesc <> progDesc "Choose an allegiance or player(s)")
         , command "end"         $ info (helper <*> end)         (fullDesc <> progDesc "End the current game")
         , command "heal"        $ info (helper <*> heal)        (fullDesc <> progDesc "Heal the devoured player")
         , command "help"        $ info (helper <*> help_)       (fullDesc <> progDesc "Help documents")
@@ -107,7 +106,7 @@ werewolf = Options
         ])
 
 choose :: Parser Command
-choose = Choose . Choose.Options . T.pack <$> strArgument (metavar "ALLEGIANCE")
+choose = Choose . Choose.Options . T.pack <$> strArgument (metavar "ALLEGIANCE|PLAYER[,...]")
 
 end :: Parser Command
 end = pure End
@@ -149,7 +148,7 @@ see = See . See.Options <$> playerArgument
 
 start :: Parser Command
 start = fmap Start $ Start.Options
-    <$> fmap (map T.pack . wordsBy (',' ==)) (strOption $ mconcat
+    <$> fmap (T.splitOn "," . T.pack) (strOption $ mconcat
         [ long "extra-roles", metavar "ROLE,..."
         , value []
         , help "Specify the extra roles to include"

src/Game/Werewolf/Command.hs

@@ -19,8 +19,8 @@ module Game.Werewolf.Command (
     Command(..),
 
     -- ** Instances
-    chooseAllegianceCommand, choosePlayerCommand, healCommand, noopCommand, passCommand,
-    pingCommand, poisonCommand, protectCommand, quitCommand, seeCommand, statusCommand,
+    chooseAllegianceCommand, choosePlayerCommand, choosePlayersCommand, healCommand, noopCommand,
+    passCommand, pingCommand, poisonCommand, protectCommand, quitCommand, seeCommand, statusCommand,
     voteDevourCommand, voteLynchCommand,
 ) where
 
@@ -37,8 +37,9 @@ import           Data.Text  (Text)
 import qualified Data.Text  as T
 
 import           Game.Werewolf.Engine
-import           Game.Werewolf.Game     hiding (getDevourEvent, getPendingVoters, getPlayerVote,
-                                         isDefendersTurn, isGameOver, isSeersTurn, isVillagesTurn,
+import           Game.Werewolf.Game     hiding (getAllowedVoters, getDevourEvent, getPendingVoters,
+                                         getPlayerVote, isDefendersTurn, isGameOver,
+                                         isScapegoatsTurn, isSeersTurn, isVillagesTurn,
                                          isWerewolvesTurn, isWildChildsTurn, isWitchsTurn,
                                          isWolfHoundsTurn, killPlayer, setPlayerRole)
 import           Game.Werewolf.Player   hiding (doesPlayerExist)
@@ -72,6 +73,21 @@ choosePlayerCommand callerName targetName = Command $ do
 
     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
+
 healCommand :: Text -> Command
 healCommand callerName = Command $ do
     validateWitchsCommand callerName
@@ -98,6 +114,11 @@ pingCommand = Command $ use stage >>= \stage' -> case stage' of
 
         tell [pingRoleMessage $ defender ^. role . Role.name]
         tell [pingPlayerMessage $ defender ^. name]
+    ScapegoatsTurn  -> do
+        scapegoat <- findPlayerByRole_ scapegoatRole
+
+        tell [pingRoleMessage $ scapegoat ^. role . Role.name]
+        tell [pingPlayerMessage $ scapegoat ^. name]
     SeersTurn       -> do
         seer <- findPlayerByRole_ seerRole
 
@@ -106,10 +127,11 @@ pingCommand = Command $ use stage >>= \stage' -> case stage' of
     Sunrise         -> return ()
     Sunset          -> return ()
     VillagesTurn    -> do
+        allowedVoters <- getAllowedVoters
         pendingVoters <- getPendingVoters
 
-        tell [waitingOnMessage Nothing pendingVoters]
-        tell $ map (pingPlayerMessage . view name) pendingVoters
+        tell [waitingOnMessage Nothing $ allowedVoters `intersect` pendingVoters]
+        tell $ map (pingPlayerMessage . view name) (allowedVoters `intersect` pendingVoters)
     WerewolvesTurn  -> do
         pendingVoters <- getPendingVoters
 
@@ -193,10 +215,11 @@ statusCommand callerName = Command $ use stage >>= \stage' -> case stage' of
     Sunset          -> return ()
     VillagesTurn    -> do
         game            <- get
+        allowedVoters   <- getAllowedVoters
         pendingVoters   <- getPendingVoters
 
         tell $ standardStatusMessages stage' (game ^. players)
-        tell [waitingOnMessage (Just callerName) pendingVoters]
+        tell [waitingOnMessage (Just callerName) (allowedVoters `intersect` pendingVoters)]
     WerewolvesTurn  -> do
         game            <- get
         pendingVoters   <- filterWerewolves <$> getPendingVoters
@@ -230,7 +253,7 @@ voteDevourCommand callerName targetName = Command $ do
 voteLynchCommand :: Text -> Text -> Command
 voteLynchCommand callerName targetName = Command $ do
     validatePlayer callerName callerName
-    whenM (use villageIdiotRevealed &&^ isPlayerVillageIdiot callerName)    $ throwError [playerCannotDoThatMessage callerName]
+    whenM (uses allowedVoters (callerName `notElem`))                       $ throwError [playerCannotDoThatMessage callerName]
     unlessM isVillagesTurn                                                  $ throwError [playerCannotDoThatRightNowMessage callerName]
     whenJustM (getPlayerVote callerName) . const                            $ throwError [playerHasAlreadyVotedMessage callerName]
     validatePlayer callerName targetName