diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,20 @@ ### Upcoming +### v0.5.1.0 + +*Minor* + +* Renamed the Defender to Protector. ([#132](https://github.com/hjwylde/werewolf/issues/132)) +* Automatically delete the game file if the game is over. ([#100](https://github.com/hjwylde/werewolf/issues/100)) +* Added errors for using overloaded commands out of turn. ([#100](https://github.com/hjwylde/werewolf/issues/100)) + +*Revisions* + +* Updated the Protector's description and rules. ([#132](https://github.com/hjwylde/werewolf/issues/132)) +* Improved the Enligsh used. ([#72](https://github.com/hjwylde/werewolf/issues/72)) +* Added which player is the Villager-Villager to `status`. ([#144](https://github.com/hjwylde/werewolf/issues/144)) + ### v0.5.0.0 *Major* diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -65,9 +65,9 @@ The Villagers must lynch all of the Werewolves. -* Defender * Druid * Jester +* Protector * Scapegoat * Seer * Simple Villager 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 @@ -46,4 +46,4 @@ case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages } - Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages } + Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = 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 @@ -47,13 +47,14 @@ game <- readGame tag - let command = case game ^. stage of - ScapegoatsTurn -> Scapegoat.chooseCommand callerName args - WildChildsTurn -> WildChild.chooseCommand callerName (head args) - WolfHoundsTurn -> WolfHound.chooseCommand callerName (head args) - -- TODO (hjw): throw an error - _ -> undefined + command <- case game ^. stage of + ScapegoatsTurn -> return $ Scapegoat.chooseCommand callerName args + WildChildsTurn -> return $ WildChild.chooseCommand callerName (head args) + WolfHoundsTurn -> return $ WolfHound.chooseCommand callerName (head args) + _ -> exitWith failure + { messages = [playerCannotDoThatRightNowMessage callerName] + } case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages } - Right (game, messages) -> writeGame tag game >> exitWith success { messages = messages } + Right (game, messages) -> writeOrDeleteGame tag game >> exitWith success { messages = 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 @@ -41,4 +41,4 @@ case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages } - Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages } + Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = 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 @@ -87,15 +87,15 @@ , [ "Standard commands:" , "- `vote PLAYER`" ] - , whenPlayerHasRole callerName mGame defenderRole - [ "Defender commands:" - , "- `protect PLAYER`" - ] , whenPlayerHasRole callerName mGame devotedServantRole [ "Devoted Servant commands:" , "- `reveal`" , "- `pass`" ] + , whenPlayerHasRole callerName mGame protectorRole + [ "Protector commands:" + , "- `protect PLAYER`" + ] , whenPlayerHasRole callerName mGame scapegoatRole [ "Scapegoat commands:" , "- `choose PLAYER...`" @@ -155,13 +155,13 @@ , "- The village falls asleep." , whenRoleInPlay mGame wildChildRole "- (First round only) the Wild-child wakes up and chooses a role model." - , whenRoleInPlay mGame defenderRole - "- The Defender wakes up and protects someone." + , whenRoleInPlay mGame protectorRole + "- The Protector wakes up and protects someone." , whenRoleInPlay mGame seerRole "- The Seer wakes up and sees someone's allegiance." , whenRoleInPlay mGame wolfHoundRole "- (First round only) the Wolf-hound wakes up and chooses an allegiance." - , "- The Werewolves wake up and select a victim." + , "- The Werewolves wake up and vote to devour a victim." , whenRoleInPlay mGame witchRole "- The Witch wakes up and may heal the victim and/or poison someone." , "- The village wakes up and find the victim." @@ -169,7 +169,7 @@ "- 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." + "- (When someone is lynched) the Devoted Servant may choose whether to reveal themselves and take on the role of their master." , whenRoleInPlay mGame scapegoatRole "- (When the Scapegoat is blamed) the Scapegoat chooses whom may vote on the next day." , T.concat @@ -202,11 +202,11 @@ ] whenPlayerHasRole :: Monoid m => Text -> Maybe Game -> Role -> m -> m -whenPlayerHasRole _ Nothing _ m = m +whenPlayerHasRole _ Nothing _ m = m whenPlayerHasRole callerName (Just game) role' m - | has (players . names . only callerName) game - && has (role . only role') player = m - | otherwise = mempty + | hasn't (players . names . only callerName) game = mempty + | hasn't (role . only role') player = mempty + | otherwise = m where player = game ^?! players . traverse . filteredBy name callerName 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 @@ -37,12 +37,13 @@ game <- readGame tag - let command = case game ^. stage of - DevotedServantsTurn -> DevotedServant.passCommand callerName - WitchsTurn -> Witch.passCommand callerName - -- TODO (hjw): throw an error - _ -> undefined + command <- case game ^. stage of + DevotedServantsTurn -> return $ DevotedServant.passCommand callerName + WitchsTurn -> return $ Witch.passCommand callerName + _ -> exitWith failure + { messages = [playerCannotDoThatRightNowMessage callerName] + } case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages } - Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages } + Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = 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 @@ -46,4 +46,4 @@ case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages } - Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages } + Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = 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,7 +25,7 @@ import Data.Text (Text) import Game.Werewolf -import Game.Werewolf.Command.Defender +import Game.Werewolf.Command.Protector import Werewolf.Game import Werewolf.Messages @@ -46,4 +46,4 @@ case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages } - Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages } + Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = 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 @@ -39,4 +39,4 @@ case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages } - Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages } + Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = 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 @@ -41,4 +41,4 @@ case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages } - Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages } + Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = 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 @@ -46,4 +46,4 @@ case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages } - Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages } + Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = 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 @@ -65,7 +65,7 @@ case result of Left errorMessages -> exitWith failure { messages = errorMessages } - Right (game, messages) -> writeGame tag game >> exitWith success { messages = messages } + Right (game, messages) -> writeOrDeleteGame tag game >> exitWith success { messages = messages } randomExtraRoles :: MonadIO m => Int -> m [Role] randomExtraRoles n = liftIO . evalRandIO $ do 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 @@ -44,12 +44,13 @@ game <- readGame tag - let command = case game ^. stage of - VillagesTurn -> Villager.voteCommand callerName targetName - WerewolvesTurn -> Werewolf.voteCommand callerName targetName - -- TODO (hjw): throw an error - _ -> undefined + command <- case game ^. stage of + VillagesTurn -> return $ Villager.voteCommand callerName targetName + WerewolvesTurn -> return $ Werewolf.voteCommand callerName targetName + _ -> exitWith failure + { messages = [playerCannotDoThatRightNowMessage callerName] + } case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of Left errorMessages -> exitWith failure { messages = errorMessages } - Right (game', messages) -> writeGame tag game' >> exitWith success { messages = messages } + Right (game', messages) -> writeOrDeleteGame tag game' >> exitWith success { messages = messages } diff --git a/app/Werewolf/Game.hs b/app/Werewolf/Game.hs --- a/app/Werewolf/Game.hs +++ b/app/Werewolf/Game.hs @@ -17,7 +17,7 @@ startGame, createPlayers, padRoles, -- ** Working with an existing - filePath, readGame, writeGame, deleteGame, doesGameExist, + filePath, readGame, writeGame, deleteGame, writeOrDeleteGame, doesGameExist, ) where import Control.Lens hiding (cons) @@ -70,6 +70,11 @@ deleteGame :: MonadIO m => Text -> m () deleteGame tag = liftIO $ filePath tag >>= removeFile + +writeOrDeleteGame :: MonadIO m => Text -> Game -> m () +writeOrDeleteGame tag game + | has (stage . _GameOver) game = deleteGame tag + | otherwise = writeGame tag game doesGameExist :: MonadIO m => Text -> m Bool doesGameExist tag = liftIO $ filePath tag >>= doesFileExist diff --git a/app/Werewolf/Messages.hs b/app/Werewolf/Messages.hs --- a/app/Werewolf/Messages.hs +++ b/app/Werewolf/Messages.hs @@ -17,7 +17,7 @@ -- ** Error messages noGameRunningMessage, gameAlreadyRunningMessage, roleDoesNotExistMessage, - playerCannotDoThatMessage, + playerCannotDoThatMessage, playerCannotDoThatRightNowMessage, ) where import Data.Text (Text) @@ -41,3 +41,6 @@ playerCannotDoThatMessage :: Text -> Message playerCannotDoThatMessage to = privateMessage to "You cannot do that!" + +playerCannotDoThatRightNowMessage :: Text -> Message +playerCannotDoThatRightNowMessage to = privateMessage to "You cannot do that right now!" diff --git a/src/Game/Werewolf/Command/Defender.hs b/src/Game/Werewolf/Command/Defender.hs deleted file mode 100644 --- a/src/Game/Werewolf/Command/Defender.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-| -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/Protector.hs b/src/Game/Werewolf/Command/Protector.hs new file mode 100644 --- /dev/null +++ b/src/Game/Werewolf/Command/Protector.hs @@ -0,0 +1,37 @@ +{-| +Module : Game.Werewolf.Command.Protector +Description : Protector commands. + +Copyright : (c) Henry J. Wylde, 2016 +License : BSD3 +Maintainer : public@hjwylde.com + +Protector commands. +-} + +module Game.Werewolf.Command.Protector ( + -- * 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 (isPlayerProtector callerName) $ throwError [playerCannotDoThatMessage callerName] + unlessM isProtectorsTurn $ 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/Status.hs b/src/Game/Werewolf/Command/Status.hs --- a/src/Game/Werewolf/Command/Status.hs +++ b/src/Game/Werewolf/Command/Status.hs @@ -37,52 +37,65 @@ 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] + FerinasGrunt -> return () + GameOver -> tell [gameIsOverMessage callerName] + Lynching -> return () + + ProtectorsTurn -> do + protector <- findPlayerBy_ role protectorRole + + tell [pingRoleMessage $ protectorRole ^. Role.name] + tell [pingPlayerMessage $ protector ^. name] + 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 () + 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 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 @@ -67,11 +67,6 @@ checkStage' :: (MonadState Game m, MonadWriter [Message] m) => m () checkStage' = use stage >>= \stage' -> case stage' of - DefendersTurn -> do - whenM (has (players . defenders . dead) <$> get) advanceStage - - whenM (isJust <$> use protect) advanceStage - DevotedServantsTurn -> do whenM (has (players . devotedServants . dead) <$> get) advanceStage @@ -99,6 +94,11 @@ votes .= Map.empty advanceStage + + ProtectorsTurn -> do + whenM (has (players . protectors . dead) <$> get) advanceStage + + whenM (isJust <$> use protect) advanceStage ScapegoatsTurn -> unlessM (use scapegoatBlamed) $ do allowedVoters' <- use allowedVoters diff --git a/src/Game/Werewolf/Game.hs b/src/Game/Werewolf/Game.hs --- a/src/Game/Werewolf/Game.hs +++ b/src/Game/Werewolf/Game.hs @@ -22,7 +22,7 @@ votes, Stage(..), - _DefendersTurn, _DevotedServantsTurn, _FerinasGrunt, _GameOver, _Lynching, _ScapegoatsTurn, + _DevotedServantsTurn, _FerinasGrunt, _GameOver, _Lynching, _ProtectorsTurn, _ScapegoatsTurn, _SeersTurn, _Sunrise, _Sunset, _VillagesTurn, _WerewolvesTurn, _WildChildsTurn, _WitchsTurn, _WolfHoundsTurn, @@ -95,8 +95,8 @@ , _passes :: [Text] -- ^ Witch , _poison :: Maybe Text -- ^ Witch , _poisonUsed :: Bool -- ^ Witch - , _priorProtect :: Maybe Text -- ^ Defender - , _protect :: Maybe Text -- ^ Defender + , _priorProtect :: Maybe Text -- ^ Protector + , _protect :: Maybe Text -- ^ Protector , _roleModel :: Maybe Text -- ^ Wild-child , _scapegoatBlamed :: Bool -- ^ Scapegoat , _see :: Maybe Text -- ^ Seer @@ -109,7 +109,7 @@ -- -- 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 | FerinasGrunt | GameOver | Lynching +data Stage = DevotedServantsTurn | FerinasGrunt | GameOver | Lynching | ProtectorsTurn | ScapegoatsTurn | SeersTurn | Sunrise | Sunset | VillagesTurn | WerewolvesTurn | WildChildsTurn | WitchsTurn | WolfHoundsTurn deriving (Eq, Read, Show) @@ -122,7 +122,7 @@ -- it was triggered. E.g., the 'DeovurEvent' occurs after the village wakes up rather than when -- the Werewolves' vote, this gives the Witch a chance to heal the victim. data Event = DevourEvent Text -- ^ Werewolves - | NoDevourEvent -- ^ Defender, Werewolves and Witch + | NoDevourEvent -- ^ Protector, Werewolves and Witch | PoisonEvent Text -- ^ Witch deriving (Eq, Read, Show) @@ -143,7 +143,7 @@ , WolfHoundsTurn , SeersTurn , WildChildsTurn - , DefendersTurn + , ProtectorsTurn , WerewolvesTurn , WitchsTurn , Sunrise @@ -161,7 +161,6 @@ -- One of the more complex checks here is for the 'VillagesTurn'. If the Angel is in play, then -- the 'VillagesTurn' is available on the first day rather than only after the first night. stageAvailable :: Game -> Stage -> Bool -stageAvailable game DefendersTurn = has (players . defenders . alive) game stageAvailable game DevotedServantsTurn = has (players . devotedServants . alive) game && length (getVoteResult game) == 1 @@ -169,6 +168,7 @@ stageAvailable game FerinasGrunt = has (players . druids . alive) game stageAvailable _ GameOver = False stageAvailable game Lynching = Map.size (game ^. votes) > 0 +stageAvailable game ProtectorsTurn = has (players . protectors . alive) game stageAvailable game ScapegoatsTurn = game ^. scapegoatBlamed stageAvailable game SeersTurn = has (players . seers . alive) game stageAvailable _ Sunrise = True 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 @@ -43,17 +43,17 @@ -- * Angel's turn messages angelJoinedVillagersMessage, - -- * Defender's turn messages - - -- ** Error messages - playerCannotProtectSamePlayerTwiceInARowMessage, - -- * Devoted Servant's turn messages devotedServantRevealedMessage, devotedServantJoinedPackMessages, -- * Druid's turn messages ferinaGruntsMessage, + -- * Protector's turn messages + + -- ** Error messages + playerCannotProtectSamePlayerTwiceInARowMessage, + -- * Scapegoat's turn messages scapegoatChoseAllowedVotersMessage, @@ -124,7 +124,7 @@ newPlayersInGameMessage :: [Text] -> Message newPlayersInGameMessage playerNames = publicMessage $ T.concat [ "A new game of werewolf is starting with " - , T.intercalate ", " playerNames, "!" + , concatList playerNames, "!" ] newPlayerMessage :: Player -> Message @@ -146,11 +146,11 @@ stageMessages :: Game -> [Message] stageMessages game = case game ^. stage of - DefendersTurn -> defendersTurnMessages defendersName DevotedServantsTurn -> devotedServantsTurnMessages devotedServantsName victimsName FerinasGrunt -> [] GameOver -> [] Lynching -> [] + ProtectorsTurn -> protectorsTurnMessages protectorsName ScapegoatsTurn -> scapegoatsTurnMessages scapegoatsName SeersTurn -> seersTurnMessages seersName Sunrise -> [sunriseMessage] @@ -166,7 +166,7 @@ WolfHoundsTurn -> wolfHoundsTurnMessages wolfHoundsName where players' = game ^. players - defendersName = players' ^?! defenders . name + protectorsName = players' ^?! protectors . name devotedServantsName = players' ^?! devotedServants . name victimsName = head (getVoteResult game) ^. name scapegoatsName = players' ^?! scapegoats . name @@ -175,12 +175,6 @@ wildChildsName = players' ^?! wildChildren . name wolfHoundsName = players' ^?! wolfHounds . name -defendersTurnMessages :: Text -> [Message] -defendersTurnMessages to = - [ publicMessage "The Defender wakes up." - , privateMessage to "Whom would you like to `protect`?" - ] - devotedServantsTurnMessages :: Text -> Text -> [Message] devotedServantsTurnMessages to victimsName = [ publicMessage "The Devoted Servant ponders." @@ -190,6 +184,12 @@ ] ] +protectorsTurnMessages :: Text -> [Message] +protectorsTurnMessages to = + [ publicMessage "The Protector wakes up." + , privateMessage to "Whom would you like to `protect`?" + ] + scapegoatsTurnMessages :: Text -> [Message] scapegoatsTurnMessages scapegoatsName = [ publicMessage "Just before he burns to a complete crisp, he cries out a dying wish." @@ -232,10 +232,10 @@ [ "You feel restless, like an old curse is keeping you from sleep." , "It seems you're not the only one..." , packNames werewolfName - , if length tos == 2 then "is" else "are", "also emerging from their" - , if length tos == 2 then "home." else "homes." + , conjugateToBe (length tos - 1), "also emerging from their" + , tryPlural (length tos - 1) "home" ] - packNames werewolfName = T.intercalate ", " (tos \\ [werewolfName]) + packNames werewolfName = concatList $ tos \\ [werewolfName] werewolvesTurnMessages :: [Text] -> [Message] werewolvesTurnMessages tos = @@ -267,12 +267,12 @@ ] _ -> [] healMessages - | not (game ^. healUsed) - && has (events . traverse . _DevourEvent) game = [privateMessage witchsName "Would you like to `heal` them?"] - | otherwise = [] + | game ^. healUsed = [] + | hasn't (events . traverse . _DevourEvent) game = [] + | otherwise = [privateMessage witchsName "Would you like to `heal` them?"] poisonMessages - | not (game ^. poisonUsed) = [privateMessage witchsName "Would you like to `poison` anyone?"] - | otherwise = [] + | game ^. poisonUsed = [] + | otherwise = [privateMessage witchsName "Would you like to `poison` anyone?"] wolfHoundsTurnMessages :: Text -> [Message] wolfHoundsTurnMessages to = @@ -308,11 +308,9 @@ where playerRolesMessage = publicMessage $ T.concat [ "As I know you're all wondering who lied to you, here's the role allocations: " - , T.intercalate ", " - (map - (\player -> T.concat [player ^. name, " (", player ^. role . Role.name, ")"]) - (game ^. players) - ) + , concatList $ map + (\player -> T.concat [player ^. name, " (", player ^. role . Role.name, ")"]) + (game ^. players) , "." ] @@ -380,8 +378,8 @@ ["You've already voted to boot ", targetName, "!"] circleMessage :: Text -> [Player] -> Message -circleMessage to players = privateMessage to $ T.concat - [ "The players are sitting in the following order:\n" +circleMessage to players = privateMessage to $ T.intercalate "\n" + [ "The players are sitting in the following order:" , T.intercalate " <-> " (map playerName (players ++ [head players])) ] where @@ -404,11 +402,11 @@ ]] where showTurn :: Stage -> Text - showTurn DefendersTurn = "Defender's" showTurn DevotedServantsTurn = "Devoted Servant's" showTurn FerinasGrunt = undefined showTurn GameOver = undefined showTurn Lynching = undefined + showTurn ProtectorsTurn = "Protector's" showTurn ScapegoatsTurn = "Scapegoat's" showTurn SeersTurn = "Seer's" showTurn Sunrise = undefined @@ -422,7 +420,7 @@ rolesInGameMessage :: Maybe Text -> [Role] -> Message rolesInGameMessage mTo roles = Message mTo $ T.concat [ "The roles in play are " - , T.intercalate ", " $ map (\(role, count) -> + , concatList $ map (\(role, count) -> T.concat [role ^. Role.name, " (", T.pack $ show count, ")"]) roleCounts , " for a total balance of ", T.pack $ show totalBalance, "." @@ -435,20 +433,22 @@ playersInGameMessage to players = privateMessage to . T.intercalate "\n" $ alivePlayersText : [deadPlayersText | any (is dead) players] where - alivePlayersText = T.concat + alivePlayers = players ^.. traverse . alive + deadPlayers = players ^.. traverse . dead + + alivePlayersText = T.concat [ "The following players are still alive: " - , T.intercalate ", " (players ^.. traverse . alive . name), "." + , concatList $ map (\player -> if is villagerVillager player then playerNameWithRole player else player ^. name) alivePlayers, "." ] - deadPlayersText = T.concat + deadPlayersText = T.concat [ "The following players are dead: " - , T.intercalate ", " (map playerNameWithRole (players ^.. traverse . dead)), "." + , concatList $ map playerNameWithRole deadPlayers, "." ] - playerNameWithRole player = T.concat [player ^. name, " (", player ^. role . Role.name, ")"] + playerNameWithRole player = T.concat [player ^. name, " (", player ^. role . Role.name, ")"] waitingOnMessage :: Maybe Text -> [Text] -> Message waitingOnMessage mTo playerNames = Message mTo $ T.concat - [ "Waiting on ", T.intercalate ", " playerNames, "..." - ] + ["Waiting on ", concatList playerNames, "..."] angelJoinedVillagersMessage :: Message angelJoinedVillagersMessage = publicMessage $ T.unwords @@ -458,10 +458,6 @@ , "Now he is stuck here, doomed forever to live out a mortal life as a Villager." ] -playerCannotProtectSamePlayerTwiceInARowMessage :: Text -> Message -playerCannotProtectSamePlayerTwiceInARowMessage to = - privateMessage to "You cannot protect the same player twice in a row!" - devotedServantRevealedMessage :: Text -> Message devotedServantRevealedMessage devotedServantsName = publicMessage $ T.unwords [ devotedServantsName, "stands up in horror." @@ -482,10 +478,10 @@ ] packMessages | null werewolfNames = [] - | otherwise = [T.unwords - [ "As you enter you see his pack", T.intercalate ", " werewolfNames - , "waiting for you." - ]] + | otherwise = + [ T.unwords + ["As you enter you see his pack", concatList werewolfNames , "waiting for you."] + ] ferinaGruntsMessage :: Message ferinaGruntsMessage = publicMessage $ T.unwords @@ -493,9 +489,13 @@ , "She loudly grunts as she smells danger." ] +playerCannotProtectSamePlayerTwiceInARowMessage :: Text -> Message +playerCannotProtectSamePlayerTwiceInARowMessage to = + privateMessage to "You cannot protect the same player twice in a row!" + scapegoatChoseAllowedVotersMessage :: [Text] -> Message scapegoatChoseAllowedVotersMessage allowedVoters = publicMessage $ T.unwords - [ "On the next day only", T.intercalate ", " allowedVoters, "shall be allowed to vote." + [ "On the next day only", concatList allowedVoters, "shall be allowed to vote." , "The town crier, realising how foolish it was to kill him, grants him this wish." ] @@ -592,8 +592,8 @@ [ "The death of your role model is distressing." , "Without second thought you abandon the Villagers and run off into the woods," , "towards your old home." - , "As you arrive you see the familiar faces of", T.intercalate ", " werewolfNames - , "waiting and happy to have you back." + , "As you arrive you see the familiar", tryPlural (length werewolfNames) "face", "of" + , concatList werewolfNames, "waiting and happy to have you back." ]) : groupMessages werewolfNames (T.unwords [ wildChildsName, "the Wild-child scampers off into the woods." @@ -627,3 +627,16 @@ article role | role `elem` restrictedRoles = "the" | otherwise = "a" + +concatList :: [Text] -> Text +concatList [] = "" +concatList [word] = word +concatList words = T.unwords [T.intercalate ", " (init words), "and", last words] + +conjugateToBe :: Int -> Text +conjugateToBe 1 = "is" +conjugateToBe _ = "are" + +tryPlural :: Int -> Text -> Text +tryPlural 1 word = word +tryPlural _ word = T.snoc word 's' diff --git a/src/Game/Werewolf/Player.hs b/src/Game/Werewolf/Player.hs --- a/src/Game/Werewolf/Player.hs +++ b/src/Game/Werewolf/Player.hs @@ -26,15 +26,15 @@ newPlayer, -- ** Traversals - angel, defender, devotedServant, druid, jester, scapegoat, seer, simpleVillager, simpleWerewolf, - villagerVillager, wildChild, witch, wolfHound, + angel, devotedServant, druid, jester, protector, 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, defenders, devotedServants, druids, jesters, scapegoats, seers, simpleVillagers, + angels, devotedServants, druids, jesters, protectors, 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 'defenderRole'. --- --- @ --- 'defender' = 'role' . 'only' 'defenderRole' --- @ -defender :: Traversal' Player () -defender = role . only defenderRole - -- | The traversal of 'Player's with a 'devotedServantRole'. -- -- @ @@ -115,6 +107,14 @@ jester :: Traversal' Player () jester = role . only jesterRole +-- | The traversal of 'Player's with a 'protectorRole'. +-- +-- @ +-- 'protector' = 'role' . 'only' 'protectorRole' +-- @ +protector :: Traversal' Player () +protector = role . only protectorRole + -- | The traversal of 'Player's with a 'scapegoatRole'. -- -- @ @@ -227,14 +227,6 @@ angels :: Traversable t => Traversal' (t Player) Player angels = traverse . filtered (is angel) --- | This 'Traversal' provides the traversal of 'defender' 'Player's. --- --- @ --- 'defenders' = 'traverse' . 'filtered' ('is' 'defender') --- @ -defenders :: Traversable t => Traversal' (t Player) Player -defenders = traverse . filtered (is defender) - -- | This 'Traversal' provides the traversal of 'devotedServant' 'Player's. -- -- @ @@ -258,6 +250,14 @@ -- @ jesters :: Traversable t => Traversal' (t Player) Player jesters = traverse . filtered (is jester) + +-- | This 'Traversal' provides the traversal of 'protector' 'Player's. +-- +-- @ +-- 'protectors' = 'traverse' . 'filtered' ('is' 'protector') +-- @ +protectors :: Traversable t => Traversal' (t Player) Player +protectors = traverse . filtered (is protector) -- | This 'Traversal' provides the traversal of 'scapegoat' 'Player's. -- 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 @@ -77,7 +77,7 @@ -- -- The program always exits with success even if the response was a failure one. This is to -- distinguish between bad calls to the binary and bad commands to the werewolf engine. -exitWith :: MonadIO m => Response -> m () +exitWith :: MonadIO m => Response -> m a exitWith response = liftIO $ T.putStrLn (T.decodeUtf8 $ encode response) >> Exit.exitSuccess -- | A message may be either public or private, indicated by it's @to@ field. 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 @@ -28,7 +28,6 @@ -- ** Instances allRoles, restrictedRoles, - allAllegiances, -- *** The Ambiguous -- | No-one knows the true nature of the Ambiguous, sometimes not even the Ambiguous themselves! @@ -48,7 +47,7 @@ -- certain few have learnt some tricks over the years that may turn out rather useful. -- The Villagers must lynch all of the Werewolves. - defenderRole, druidRole, jesterRole, scapegoatRole, seerRole, simpleVillagerRole, + druidRole, jesterRole, protectorRole, scapegoatRole, seerRole, simpleVillagerRole, villagerVillagerRole, witchRole, -- *** The Werewolves @@ -102,10 +101,10 @@ allRoles :: [Role] allRoles = [ angelRole - , defenderRole , devotedServantRole , druidRole , jesterRole + , protectorRole , scapegoatRole , seerRole , simpleVillagerRole @@ -124,12 +123,6 @@ restrictedRoles :: [Role] restrictedRoles = allRoles \\ [simpleVillagerRole, simpleWerewolfRole] --- | A list containing all the allegiances defined in this file. --- --- TODO (hjw): use reflection to get this list -allAllegiances :: [Allegiance] -allAllegiances = [Angel, Villagers, Werewolves] - -- | /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!/ @@ -248,29 +241,6 @@ ] } --- | /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" - , _allegiance = Villagers - , _balance = 2 - , _description = - "This character can save the Villagers from the bite of the Werewolves." - , _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." - ] - } - -- | /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/ @@ -295,6 +265,35 @@ , _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." + ] + } + +-- | /The Protector is one of the few pure of heart and altruistic Villagers. They are forever/ +-- /putting others needs above their own, standing guard at night against this terrifying foe./ +-- /Each night they fight against the Werewolves with naught but a sword and shield, potentially/ +-- /saving an innocents life./ +-- +-- Each night the Protector may choose a player deemed worthy of their protection. That player is +-- safe for that night night (and only that night) against the Werewolves. +-- +-- The Protector may not protect the same player two nights in a row. +protectorRole :: Role +protectorRole = Role + { _name = "Protector" + , _allegiance = Villagers + , _balance = 2 + , _description = T.unwords + [ "The Protector is one of the few pure of heart and altruistic Villagers. They are forever" + , "putting others needs above their own, standing guard at night against this terrifying" + , "foe. Each night they fight against the Werewolves with naught but a sword and shield," + , "potentially saving an innocents life." + ] + , _rules = T.intercalate "\n" + [ T.unwords + [ "Each night the Protector may choose a player deemed worthy of their protection. That" + , "player is safe for that night night (and only that night) against the Werewolves." + ] + , "The Protector may not protect the same player two nights in a row." ] } diff --git a/src/Game/Werewolf/Util.hs b/src/Game/Werewolf/Util.hs --- a/src/Game/Werewolf/Util.hs +++ b/src/Game/Werewolf/Util.hs @@ -24,7 +24,7 @@ getAllowedVoters, getPendingVoters, getVoteResult, -- ** Queries - isDefendersTurn, isDevotedServantsTurn, isGameOver, isScapegoatsTurn, isSeersTurn, isSunrise, + isDevotedServantsTurn, isGameOver, isProtectorsTurn, isScapegoatsTurn, isSeersTurn, isSunrise, isVillagesTurn, isWerewolvesTurn, isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn, hasAnyoneWon, hasAngelWon, hasVillagersWon, hasWerewolvesWon, @@ -32,7 +32,7 @@ -- ** Queries doesPlayerExist, - isPlayerDefender, isPlayerDevotedServant, isPlayerJester, isPlayerScapegoat, isPlayerSeer, + isPlayerDevotedServant, isPlayerJester, isPlayerProtector, isPlayerScapegoat, isPlayerSeer, isPlayerWildChild, isPlayerWitch, isPlayerWolfHound, isPlayerWerewolf, isPlayerAlive, isPlayerDead, @@ -69,7 +69,7 @@ player <- findPlayerBy_ name name' when (is angel player) $ setPlayerAllegiance name' Villagers - when (is defender player) $ do + when (is protector player) $ do protect .= Nothing priorProtect .= Nothing when (is seer player) $ see .= Nothing @@ -119,15 +119,15 @@ getVoteResult :: MonadState Game m => m [Player] getVoteResult = gets Game.getVoteResult -isDefendersTurn :: MonadState Game m => m Bool -isDefendersTurn = has (stage . _DefendersTurn) <$> get - isDevotedServantsTurn :: MonadState Game m => m Bool isDevotedServantsTurn = has (stage . _DevotedServantsTurn) <$> get isGameOver :: MonadState Game m => m Bool isGameOver = has (stage . _GameOver) <$> get +isProtectorsTurn :: MonadState Game m => m Bool +isProtectorsTurn = has (stage . _ProtectorsTurn) <$> get + isScapegoatsTurn :: MonadState Game m => m Bool isScapegoatsTurn = has (stage . _ScapegoatsTurn) <$> get @@ -167,14 +167,14 @@ doesPlayerExist :: MonadState Game m => Text -> m Bool doesPlayerExist name = gets $ Game.doesPlayerExist name -isPlayerDefender :: MonadState Game m => Text -> m Bool -isPlayerDefender name' = is defender <$> findPlayerBy_ name name' - 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' + +isPlayerProtector :: MonadState Game m => Text -> m Bool +isPlayerProtector name' = is protector <$> findPlayerBy_ name name' isPlayerScapegoat :: MonadState Game m => Text -> m Bool isPlayerScapegoat name' = is scapegoat <$> findPlayerBy_ name name' 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 @@ -12,7 +12,7 @@ -- ** Game NewGame(..), - GameAtDefendersTurn(..), GameAtDevotedServantsTurn(..), GameAtGameOver(..), + GameAtDevotedServantsTurn(..), GameAtGameOver(..), GameAtProtectorsTurn(..), GameAtScapegoatsTurn(..), GameAtSeersTurn(..), GameAtSunrise(..), GameAtVillagesTurn(..), GameAtWerewolvesTurn(..), GameAtWildChildsTurn(..), GameAtWitchsTurn(..), GameAtWolfHoundsTurn(..), @@ -49,9 +49,9 @@ import qualified Data.Text as T import Game.Werewolf -import Game.Werewolf.Command.Defender import Game.Werewolf.Command.DevotedServant as DevotedServant import Game.Werewolf.Command.Global +import Game.Werewolf.Command.Protector import Game.Werewolf.Command.Scapegoat as Scapegoat import Game.Werewolf.Command.Seer import Game.Werewolf.Command.Villager as Villager @@ -85,7 +85,7 @@ arbitrary = elements allRoles instance Arbitrary Allegiance where - arbitrary = elements allAllegiances + arbitrary = elements [Villagers, Werewolves] instance Arbitrary Text where arbitrary = T.pack <$> vectorOf 6 (elements ['a'..'z']) @@ -96,15 +96,6 @@ instance Arbitrary NewGame where arbitrary = NewGame . newGame <$> arbitraryPlayerSet -newtype GameAtDefendersTurn = GameAtDefendersTurn Game - deriving (Eq, Show) - -instance Arbitrary GameAtDefendersTurn where - arbitrary = do - game <- arbitrary - - return $ GameAtDefendersTurn (game & stage .~ DefendersTurn) - newtype GameAtDevotedServantsTurn = GameAtDevotedServantsTurn Game deriving (Eq, Show) @@ -124,6 +115,15 @@ return $ GameAtGameOver (game & stage .~ GameOver) +newtype GameAtProtectorsTurn = GameAtProtectorsTurn Game + deriving (Eq, Show) + +instance Arbitrary GameAtProtectorsTurn where + arbitrary = do + game <- arbitrary + + return $ GameAtProtectorsTurn (game & stage .~ ProtectorsTurn) + newtype GameAtScapegoatsTurn = GameAtScapegoatsTurn Game deriving (Eq, Show) @@ -373,7 +373,7 @@ instance Arbitrary GameWithProtect where arbitrary = do game <- arbitrary - let game' = game & stage .~ DefendersTurn + let game' = game & stage .~ ProtectorsTurn (Blind command) <- arbitraryProtectCommand game' return $ GameWithProtect (run_ (apply command) game') @@ -433,7 +433,6 @@ arbitraryCommand :: Game -> Gen (Blind Command) arbitraryCommand game = case game ^. stage of - DefendersTurn -> arbitraryProtectCommand game DevotedServantsTurn -> oneof [ arbitraryDevotedServantPassCommand game , arbitraryRevealCommand game @@ -441,6 +440,7 @@ FerinasGrunt -> return $ Blind noopCommand GameOver -> return $ Blind noopCommand Lynching -> return $ Blind noopCommand + ProtectorsTurn -> arbitraryProtectCommand game ScapegoatsTurn -> arbitraryScapegoatChooseCommand game SeersTurn -> arbitrarySeeCommand game Sunrise -> return $ Blind noopCommand @@ -507,13 +507,13 @@ arbitraryProtectCommand :: Game -> Gen (Blind Command) arbitraryProtectCommand game = do - let defender = game ^?! players . defenders + let protector = game ^?! players . protectors -- TODO (hjw): add suchThat (/= priorProtect) - target <- suchThat (arbitraryPlayer game) (defender /=) + target <- suchThat (arbitraryPlayer game) (protector /=) return $ if isJust (game ^. protect) then Blind noopCommand - else Blind $ protectCommand (defender ^. name) (target ^. name) + else Blind $ protectCommand (protector ^. name) (target ^. name) arbitraryQuitCommand :: Game -> Gen (Blind Command) arbitraryQuitCommand game = do 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 @@ -17,7 +17,7 @@ import Data.Maybe import Game.Werewolf -import Game.Werewolf.Command.Defender +import Game.Werewolf.Command.Protector import Game.Werewolf.Test.Arbitrary import Game.Werewolf.Test.Util @@ -31,8 +31,8 @@ , testProperty "protect command errors when target does not exist" prop_protectCommandErrorsWhenTargetDoesNotExist , testProperty "protect command errors when caller is dead" prop_protectCommandErrorsWhenCallerIsDead , testProperty "protect command errors when target is dead" prop_protectCommandErrorsWhenTargetIsDead - , testProperty "protect command errors when not defender's turn" prop_protectCommandErrorsWhenNotDefendersTurn - , testProperty "protect command errors when caller not defender" prop_protectCommandErrorsWhenCallerNotDefender + , testProperty "protect command errors when not protector's turn" prop_protectCommandErrorsWhenNotProtectorsTurn + , testProperty "protect command errors when caller not protector" prop_protectCommandErrorsWhenCallerNotProtector , testProperty "protect command errors when target is prior protect" prop_protectCommandErrorsWhenTargetIsPriorProtect , testProperty "protect command sets prior protect" prop_protectCommandSetsPriorProtect , testProperty "protect command sets protect" prop_protectCommandSetsProtect @@ -42,50 +42,50 @@ prop_protectCommandErrorsWhenGameIsOver (GameAtGameOver game) = forAll (arbitraryProtectCommand game) $ verbose_runCommandErrors game . getBlind -prop_protectCommandErrorsWhenCallerDoesNotExist :: GameAtDefendersTurn -> Player -> Property -prop_protectCommandErrorsWhenCallerDoesNotExist (GameAtDefendersTurn game) caller = +prop_protectCommandErrorsWhenCallerDoesNotExist :: GameAtProtectorsTurn -> Player -> Property +prop_protectCommandErrorsWhenCallerDoesNotExist (GameAtProtectorsTurn game) caller = not (doesPlayerExist (caller ^. name) game) ==> forAll (arbitraryPlayer game) $ \target -> do let command = protectCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game command -prop_protectCommandErrorsWhenTargetDoesNotExist :: GameAtDefendersTurn -> Player -> Property -prop_protectCommandErrorsWhenTargetDoesNotExist (GameAtDefendersTurn game) target = do - let defender = game ^?! players . defenders - let command = protectCommand (defender ^. name) (target ^. name) +prop_protectCommandErrorsWhenTargetDoesNotExist :: GameAtProtectorsTurn -> Player -> Property +prop_protectCommandErrorsWhenTargetDoesNotExist (GameAtProtectorsTurn game) target = do + let protector = game ^?! players . protectors + let command = protectCommand (protector ^. name) (target ^. name) not (doesPlayerExist (target ^. name) game) ==> verbose_runCommandErrors game command -prop_protectCommandErrorsWhenCallerIsDead :: GameAtDefendersTurn -> Property -prop_protectCommandErrorsWhenCallerIsDead (GameAtDefendersTurn game) = do - let defender = game ^?! players . defenders - let game' = killPlayer (defender ^. name) game +prop_protectCommandErrorsWhenCallerIsDead :: GameAtProtectorsTurn -> Property +prop_protectCommandErrorsWhenCallerIsDead (GameAtProtectorsTurn game) = do + let protector = game ^?! players . protectors + let game' = killPlayer (protector ^. name) game forAll (arbitraryPlayer game') $ \target -> do - let command = protectCommand (defender ^. name) (target ^. name) + let command = protectCommand (protector ^. name) (target ^. name) verbose_runCommandErrors game' command -prop_protectCommandErrorsWhenTargetIsDead :: GameAtDefendersTurn -> Property -prop_protectCommandErrorsWhenTargetIsDead (GameAtDefendersTurn game) = do - let defender = game ^?! players . defenders +prop_protectCommandErrorsWhenTargetIsDead :: GameAtProtectorsTurn -> Property +prop_protectCommandErrorsWhenTargetIsDead (GameAtProtectorsTurn game) = do + let protector = game ^?! players . protectors forAll (arbitraryPlayer game) $ \target -> do let game' = killPlayer (target ^. name) game - let command = protectCommand (defender ^. name) (target ^. name) + let command = protectCommand (protector ^. name) (target ^. name) verbose_runCommandErrors game' command -prop_protectCommandErrorsWhenNotDefendersTurn :: Game -> Property -prop_protectCommandErrorsWhenNotDefendersTurn game = - hasn't (stage . _DefendersTurn) game +prop_protectCommandErrorsWhenNotProtectorsTurn :: Game -> Property +prop_protectCommandErrorsWhenNotProtectorsTurn game = + hasn't (stage . _ProtectorsTurn) game ==> forAll (arbitraryProtectCommand game) $ verbose_runCommandErrors game . getBlind -prop_protectCommandErrorsWhenCallerNotDefender :: GameAtDefendersTurn -> Property -prop_protectCommandErrorsWhenCallerNotDefender (GameAtDefendersTurn game) = - forAll (suchThat (arbitraryPlayer game) (isn't defender)) $ \caller -> +prop_protectCommandErrorsWhenCallerNotProtector :: GameAtProtectorsTurn -> Property +prop_protectCommandErrorsWhenCallerNotProtector (GameAtProtectorsTurn game) = + forAll (suchThat (arbitraryPlayer game) (isn't protector)) $ \caller -> forAll (arbitraryPlayer game) $ \target -> do let command = protectCommand (caller ^. name) (target ^. name) @@ -95,17 +95,17 @@ prop_protectCommandErrorsWhenTargetIsPriorProtect (GameWithProtect game) = do let game' = game & protect .~ Nothing - let defender = game ^?! players . defenders - let command = protectCommand (defender ^. name) (fromJust $ game' ^. priorProtect) + let protector = game ^?! players . protectors + let command = protectCommand (protector ^. name) (fromJust $ game' ^. priorProtect) verbose_runCommandErrors game' command -prop_protectCommandSetsPriorProtect :: GameAtDefendersTurn -> Property -prop_protectCommandSetsPriorProtect (GameAtDefendersTurn game) = +prop_protectCommandSetsPriorProtect :: GameAtProtectorsTurn -> Property +prop_protectCommandSetsPriorProtect (GameAtProtectorsTurn game) = forAll (arbitraryProtectCommand game) $ \(Blind command) -> isJust $ run_ (apply command) game ^. priorProtect -prop_protectCommandSetsProtect :: GameAtDefendersTurn -> Property -prop_protectCommandSetsProtect (GameAtDefendersTurn game) = +prop_protectCommandSetsProtect :: GameAtProtectorsTurn -> Property +prop_protectCommandSetsProtect (GameAtProtectorsTurn game) = forAll (arbitraryProtectCommand game) $ \(Blind command) -> isJust $ run_ (apply command) game ^. protect 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 @@ -35,8 +35,8 @@ , testProperty "quit command clears heal used when caller is witch" prop_quitCommandClearsHealUsedWhenCallerIsWitch , testProperty "quit command clears poison when caller is witch" prop_quitCommandClearsPoisonWhenCallerIsWitch , testProperty "quit command clears poison used when caller is witch" prop_quitCommandClearsPoisonUsedWhenCallerIsWitch - , testProperty "quit command clears prior protect when caller is defender" prop_quitCommandClearsPriorProtectWhenCallerIsDefender - , testProperty "quit command clears protect when caller is defender" prop_quitCommandClearsProtectWhenCallerIsDefender + , testProperty "quit command clears prior protect when caller is protector" prop_quitCommandClearsPriorProtectWhenCallerIsProtector + , testProperty "quit command clears protect when caller is protector" prop_quitCommandClearsProtectWhenCallerIsProtector , testProperty "quit command clears player's devour vote" prop_quitCommandClearsPlayersDevourVote , testProperty "quit command clears player's lynch vote" prop_quitCommandClearsPlayersLynchVote , testProperty "quit command clears role model when caller is wild-child" prop_quitCommandClearsRoleModelWhenCallerIsWildChild @@ -103,17 +103,17 @@ not $ run_ (apply command) game ^. poisonUsed -prop_quitCommandClearsPriorProtectWhenCallerIsDefender :: GameWithProtect -> Bool -prop_quitCommandClearsPriorProtectWhenCallerIsDefender (GameWithProtect game) = do - let defender = game ^?! players . defenders - let command = quitCommand (defender ^. name) +prop_quitCommandClearsPriorProtectWhenCallerIsProtector :: GameWithProtect -> Bool +prop_quitCommandClearsPriorProtectWhenCallerIsProtector (GameWithProtect game) = do + let protector = game ^?! players . protectors + let command = quitCommand (protector ^. name) isNothing $ run_ (apply command) game ^. priorProtect -prop_quitCommandClearsProtectWhenCallerIsDefender :: GameWithProtect -> Bool -prop_quitCommandClearsProtectWhenCallerIsDefender (GameWithProtect game) = do - let defender = game ^?! players . defenders - let command = quitCommand (defender ^. name) +prop_quitCommandClearsProtectWhenCallerIsProtector :: GameWithProtect -> Bool +prop_quitCommandClearsProtectWhenCallerIsProtector (GameWithProtect game) = do + let protector = game ^?! players . protectors + let command = quitCommand (protector ^. name) isNothing $ run_ (apply command) game ^. protect 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 @@ -36,8 +36,8 @@ allEngineTests :: [TestTree] allEngineTests = - [ testProperty "check stage skips defender's turn when no defender" prop_checkStageSkipsDefendersTurnWhenNoDefender - , testProperty "check stage skips devoted servant's turn when no devoted servant" prop_checkStageSkipsDevotedServantsTurnWhenNoDevotedServant + [ testProperty "check stage skips devoted servant's turn when no devoted servant" prop_checkStageSkipsDevotedServantsTurnWhenNoDevotedServant + , testProperty "check stage skips protector's turn when no protector" prop_checkStageSkipsProtectorsTurnWhenNoProtector , testProperty "check stage skips scapegoat's turn when no scapegoat" prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat , testProperty "check stage skips seer's turn when no seer" prop_checkStageSkipsSeersTurnWhenNoSeer , testProperty "check stage skips village's turn when allowed voters empty" prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty @@ -45,10 +45,6 @@ , testProperty "check stage skips witch's turn when no witch" prop_checkStageSkipsWitchsTurnWhenNoWitch , testProperty "check stage skips wolf-hound's turn when no wolf-hound" prop_checkStageSkipsWolfHoundsTurnWhenNoWolfHound - , testProperty "check defender's turn advances to werewolves' turn" prop_checkDefendersTurnAdvancesToWerewolvesTurn - , testProperty "check defender's turn advances when no defender" prop_checkDefendersTurnAdvancesWhenNoDefender - , testProperty "check defender's turn does nothing unless protected" prop_checkDefendersTurnDoesNothingUnlessProtected - , testProperty "check devoted servant's turn advances to wolf-hound's turn" prop_checkDevotedServantsTurnAdvancesToWolfHoundsTurn , testProperty "check devoted servant's turn advances when no devoted servant" prop_checkDevotedServantsTurnAdvancesWhenNoDevotedServant , testProperty "check devoted servant's turn does nothing unless revealed or passed" prop_checkDevotedServantsTurnDoesNothingUnlessRevealedOrPassed @@ -67,6 +63,10 @@ , testProperty "check game over does nothing when angel dead but aligned with villagers" prop_checkGameOverDoesNothingWhenAngelDeadButAlignedWithVillagers , testProperty "check game over does nothing when game over" prop_checkGameOverDoesNothingWhenGameOver + , testProperty "check protector's turn advances to werewolves' turn" prop_checkProtectorsTurnAdvancesToWerewolvesTurn + , testProperty "check protector's turn advances when no protector" prop_checkProtectorsTurnAdvancesWhenNoProtector + , testProperty "check protector's turn does nothing unless protected" prop_checkProtectorsTurnDoesNothingUnlessProtected + , testProperty "check scapegoat's turn advances to wolf-hound's turn" prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn , testProperty "check scapegoat's turn skips wolf-hound's turn when allegiance chosen" prop_checkScapegoatsTurnSkipsWolfHoundsTurnWhenAllegianceChosen , testProperty "check scapegoat's turn does nothing while scapegoat blamed" prop_checkScapegoatsTurnDoesNothingWhileScapegoatBlamed @@ -94,7 +94,7 @@ , testProperty "check werewolves' turn resets votes" prop_checkWerewolvesTurnResetsVotes , testProperty "check werewolves' turn does nothing unless all voted" prop_checkWerewolvesTurnDoesNothingUnlessAllVoted - , testProperty "check wild-child's turn advances to defender's turn" prop_checkWildChildsTurnAdvancesToDefendersTurn + , testProperty "check wild-child's turn advances to protector's turn" prop_checkWildChildsTurnAdvancesToProtectorsTurn , testProperty "check wild-child's turn advances when no wild-child" prop_checkWildChildsTurnAdvancesWhenNoWildChild , testProperty "check wild-child's turn does nothing unless chosen" prop_checkWildChildsTurnDoesNothingUnlessRoleModelChosen @@ -119,13 +119,6 @@ , testProperty "start game errors when more than 1 of a restricted role" prop_startGameErrorsWhenMoreThan1OfARestrictedRole ] -prop_checkStageSkipsDefendersTurnWhenNoDefender :: GameWithRoleModel -> Bool -prop_checkStageSkipsDefendersTurnWhenNoDefender (GameWithRoleModel game) = - hasn't (stage . _DefendersTurn) game' - where - defendersName = game ^?! players . defenders . name - game' = run_ (apply (quitCommand defendersName) >> checkStage) game - prop_checkStageSkipsDevotedServantsTurnWhenNoDevotedServant :: GameWithMajorityVote -> Bool prop_checkStageSkipsDevotedServantsTurnWhenNoDevotedServant (GameWithMajorityVote game) = hasn't (stage . _DevotedServantsTurn) game' @@ -133,6 +126,13 @@ devotedServantsName = game ^?! players . devotedServants . name game' = run_ (apply (quitCommand devotedServantsName) >> checkStage) game +prop_checkStageSkipsProtectorsTurnWhenNoProtector :: GameWithRoleModel -> Bool +prop_checkStageSkipsProtectorsTurnWhenNoProtector (GameWithRoleModel game) = + hasn't (stage . _ProtectorsTurn) game' + where + protectorsName = game ^?! players . protectors . name + game' = run_ (apply (quitCommand protectorsName) >> checkStage) game + prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat :: GameWithConflictingVote -> Bool prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat (GameWithConflictingVote game) = hasn't (stage . _ScapegoatsTurn) game' @@ -176,21 +176,6 @@ wolfHoundsName = game ^?! players . wolfHounds . name game' = run_ (apply (quitCommand wolfHoundsName) >> checkStage) game -prop_checkDefendersTurnAdvancesToWerewolvesTurn :: GameWithProtect -> Bool -prop_checkDefendersTurnAdvancesToWerewolvesTurn (GameWithProtect game) = - has (stage . _WerewolvesTurn) (run_ checkStage game) - -prop_checkDefendersTurnAdvancesWhenNoDefender :: GameAtDefendersTurn -> Bool -prop_checkDefendersTurnAdvancesWhenNoDefender (GameAtDefendersTurn game) = do - let defender = game ^?! players . defenders - let command = quitCommand $ defender ^. name - - hasn't (stage . _DefendersTurn) (run_ (apply command >> checkStage) game) - -prop_checkDefendersTurnDoesNothingUnlessProtected :: GameAtDefendersTurn -> Bool -prop_checkDefendersTurnDoesNothingUnlessProtected (GameAtDefendersTurn game) = - has (stage . _DefendersTurn) (run_ checkStage game) - prop_checkDevotedServantsTurnAdvancesToWolfHoundsTurn :: GameAtDevotedServantsTurn -> Property prop_checkDevotedServantsTurnAdvancesToWolfHoundsTurn (GameAtDevotedServantsTurn game) = do forAll (arbitraryCommand game) $ \(Blind command) -> @@ -245,6 +230,21 @@ | game' ^. jesterRevealed = filter (isn't jester) $ game' ^. players | otherwise = game' ^.. players . traverse . alive +prop_checkProtectorsTurnAdvancesToWerewolvesTurn :: GameWithProtect -> Bool +prop_checkProtectorsTurnAdvancesToWerewolvesTurn (GameWithProtect game) = + has (stage . _WerewolvesTurn) (run_ checkStage game) + +prop_checkProtectorsTurnAdvancesWhenNoProtector :: GameAtProtectorsTurn -> Bool +prop_checkProtectorsTurnAdvancesWhenNoProtector (GameAtProtectorsTurn game) = do + let protector = game ^?! players . protectors + let command = quitCommand $ protector ^. name + + hasn't (stage . _ProtectorsTurn) (run_ (apply command >> checkStage) game) + +prop_checkProtectorsTurnDoesNothingUnlessProtected :: GameAtProtectorsTurn -> Bool +prop_checkProtectorsTurnDoesNothingUnlessProtected (GameAtProtectorsTurn game) = + has (stage . _ProtectorsTurn) (run_ checkStage game) + prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn :: GameWithAllowedVoters -> Bool prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn (GameWithAllowedVoters game) = has (stage . _WolfHoundsTurn) (run_ checkStage game) @@ -374,10 +374,10 @@ where n = length (game ^.. players . werewolves) - 1 -prop_checkWildChildsTurnAdvancesToDefendersTurn :: GameAtWildChildsTurn -> Property -prop_checkWildChildsTurnAdvancesToDefendersTurn (GameAtWildChildsTurn game) = +prop_checkWildChildsTurnAdvancesToProtectorsTurn :: GameAtWildChildsTurn -> Property +prop_checkWildChildsTurnAdvancesToProtectorsTurn (GameAtWildChildsTurn game) = forAll (arbitraryWildChildChooseCommand game) $ \(Blind command) -> - has (stage . _DefendersTurn) (run_ (apply command >> checkStage) game) + has (stage . _ProtectorsTurn) (run_ (apply command >> checkStage) game) prop_checkWildChildsTurnAdvancesWhenNoWildChild :: GameAtWildChildsTurn -> Bool prop_checkWildChildsTurnAdvancesWhenNoWildChild (GameAtWildChildsTurn game) = do diff --git a/werewolf.cabal b/werewolf.cabal --- a/werewolf.cabal +++ b/werewolf.cabal @@ -1,12 +1,13 @@ name: werewolf -version: 0.5.0.0 +version: 0.5.1.0 author: Henry J. Wylde maintainer: public@hjwylde.com homepage: https://github.com/hjwylde/werewolf 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. +description: A game engine for playing werewolf within a chat client. + This engine is based off of the party game Mafia, also known as Werewolf. license: BSD3 license-file: LICENSE @@ -75,9 +76,9 @@ exposed-modules: Game.Werewolf Game.Werewolf.Command - Game.Werewolf.Command.Defender Game.Werewolf.Command.DevotedServant Game.Werewolf.Command.Global + Game.Werewolf.Command.Protector Game.Werewolf.Command.Scapegoat Game.Werewolf.Command.Seer Game.Werewolf.Command.Status