werewolf 0.5.0.0 → 0.5.1.0

raw patch · 31 files changed

+350/−299 lines, 31 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• README.md +1/−1
• app/Werewolf/Command/Boot.hs +1/−1
• app/Werewolf/Command/Choose.hs +8/−7
• app/Werewolf/Command/Heal.hs +1/−1
• app/Werewolf/Command/Help.hs +12/−12
• app/Werewolf/Command/Pass.hs +7/−6
• app/Werewolf/Command/Poison.hs +1/−1
• app/Werewolf/Command/Protect.hs +2/−2
• app/Werewolf/Command/Quit.hs +1/−1
• app/Werewolf/Command/Reveal.hs +1/−1
• app/Werewolf/Command/See.hs +1/−1
• app/Werewolf/Command/Start.hs +1/−1
• app/Werewolf/Command/Vote.hs +7/−6
• app/Werewolf/Game.hs +6/−1
• app/Werewolf/Messages.hs +4/−1
• src/Game/Werewolf/Command/Defender.hs +0/−37
• src/Game/Werewolf/Command/Protector.hs +37/−0
• src/Game/Werewolf/Command/Status.hs +18/−5
• src/Game/Werewolf/Engine.hs +5/−5
• src/Game/Werewolf/Game.hs +7/−7
• src/Game/Werewolf/Messages.hs +62/−49
• src/Game/Werewolf/Player.hs +19/−19
• src/Game/Werewolf/Response.hs +1/−1
• src/Game/Werewolf/Role.hs +31/−32
• src/Game/Werewolf/Util.hs +9/−9
• test/src/Game/Werewolf/Test/Arbitrary.hs +17/−17
• test/src/Game/Werewolf/Test/Command/Protect.hs +30/−30
• test/src/Game/Werewolf/Test/Command/Quit.hs +10/−10
• test/src/Game/Werewolf/Test/Engine.hs +32/−32
• werewolf.cabal +4/−3

@@ -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*

@@ -65,9 +65,9 @@  The Villagers must lynch all of the Werewolves. -* Defender * Druid * Jester+* Protector * Scapegoat * Seer * Simple Villager

@@ -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 }

@@ -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 }

@@ -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 }

@@ -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 

@@ -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 }

@@ -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 }

@@ -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 }

@@ -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 }

@@ -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 }

@@ -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 }

@@ -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

@@ -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 }

@@ -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

@@ -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!"

@@ -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

@@ -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

@@ -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 

@@ -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

@@ -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

@@ -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'

@@ -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. --

@@ -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.

@@ -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."         ]     } 

@@ -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'

@@ -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

@@ -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

@@ -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 

@@ -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

@@ -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