diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,36 +2,17 @@ #### Upcoming -#### v0.4.1.3 - -*Revisions* - -* Fixed grammar for the `currentStageMessages`. ([#83](https://github.com/hjwylde/werewolf/issues/83)) -* Fixed the `heal` command help message to not require a `PLAYER` argument. ([#82](https://github.com/hjwylde/werewolf/issues/82)) - -#### v0.4.1.2 - -*Revisions* - -* Added missing module to Cabal file. - -#### v0.4.1.1 +#### v0.4.2.0 -*Revisions* +*Minor* -* Fixed a bug causing the Witch being unable to heal themselves. ([#76](https://github.com/hjwylde/werewolf/issues/76)) +* Added the Villager role. ([#37](https://github.com/hjwylde/werewolf/issues/37)) #### v0.4.1.0 *Minor* -* Added a Witch role. ([#5](https://github.com/hjwylde/werewolf/issues/5)) - -#### v0.4.0.1 - -*Revisions* - -* Fixed grammar for the `currentStageMessages`. ([#83](https://github.com/hjwylde/werewolf/issues/83)) +* Added the Witch role. ([#5](https://github.com/hjwylde/werewolf/issues/5)) #### v0.4.0.0 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -23,6 +23,7 @@ * Scapegoat. * Seer. * Villager. +* Villager-Villager. * Werewolf. * Witch. diff --git a/app/Werewolf/Commands/Heal.hs b/app/Werewolf/Commands/Heal.hs deleted file mode 100644 --- a/app/Werewolf/Commands/Heal.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-| -Module : Werewolf.Commands.Heal -Description : Handler for the heal subcommand. - -Copyright : (c) Henry J. Wylde, 2015 -License : BSD3 -Maintainer : public@hjwylde.com - -Handler for the heal subcommand. --} - -{-# LANGUAGE OverloadedStrings #-} - -module Werewolf.Commands.Heal ( - -- * Handle - handle, -) where - -import Control.Monad.Except -import Control.Monad.Extra -import Control.Monad.State -import Control.Monad.Writer - -import Data.Text (Text) - -import Game.Werewolf.Command -import Game.Werewolf.Engine -import Game.Werewolf.Response - --- | Handle. -handle :: MonadIO m => Text -> m () -handle callerName = do - unlessM doesGameExist $ exitWith failure { - messages = [noGameRunningMessage callerName] - } - - game <- readGame - - let command = healCommand callerName - - case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of - Left errorMessages -> exitWith failure { messages = errorMessages } - Right (game', messages) -> writeGame game' >> exitWith success { messages = messages } diff --git a/app/Werewolf/Commands/Help.hs b/app/Werewolf/Commands/Help.hs --- a/app/Werewolf/Commands/Help.hs +++ b/app/Werewolf/Commands/Help.hs @@ -64,8 +64,8 @@ "end", "- Ends the current game." ], [ - "heal", - "- Heal the devoured player. The Witch may heal the devoured player at nighttime." + "heal PLAYER", + "- Heal a devoured player. The Witch may heal a devoured player at nighttime." ], [ "pass", "- Pass. A Witch may pass on poisoning a player." diff --git a/app/Werewolf/Commands/Start.hs b/app/Werewolf/Commands/Start.hs --- a/app/Werewolf/Commands/Start.hs +++ b/app/Werewolf/Commands/Start.hs @@ -22,7 +22,9 @@ import Control.Monad.State import Control.Monad.Writer -import Data.Text (Text) +import Data.List +import Data.Text (Text) +import qualified Data.Text as T import Game.Werewolf.Engine hiding (isGameOver) import Game.Werewolf.Game @@ -55,3 +57,7 @@ case result of Left errorMessages -> exitWith failure { messages = errorMessages } Right (game, messages) -> writeGame game >> exitWith success { messages = messages } + + +findByName :: Text -> Maybe Role +findByName name = find ((name ==) . T.toLower . _name) allRoles diff --git a/app/Werewolf/Options.hs b/app/Werewolf/Options.hs --- a/app/Werewolf/Options.hs +++ b/app/Werewolf/Options.hs @@ -19,7 +19,6 @@ werewolfPrefs, werewolfInfo, werewolf, ) where -import Data.Char import Data.List.Extra import Data.Text (Text) import qualified Data.Text as T @@ -136,7 +135,7 @@ start :: Parser Command start = fmap Start $ Start.Options - <$> fmap (map (T.pack . capitalise) . wordsBy (',' ==)) (strOption $ mconcat [ + <$> fmap (map T.pack . wordsBy (',' ==)) (strOption $ mconcat [ long "extra-roles", metavar "ROLE,...", value [], help "Specify the extra roles to include" @@ -148,7 +147,3 @@ vote :: Parser Command vote = Vote . Vote.Options . T.pack <$> strArgument (metavar "PLAYER") - -capitalise :: String -> String -capitalise [] = [] -capitalise (head:tail) = toUpper head : map toLower tail 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 @@ -65,8 +65,8 @@ import Game.Werewolf.Player hiding (doesPlayerExist) import qualified Game.Werewolf.Player as Player import Game.Werewolf.Response -import Game.Werewolf.Role (Role, scapegoatRole, seerRole, villagerRole, werewolfRole, - witchRole, _allegiance) +import Game.Werewolf.Role (Role, scapegoatRole, seerRole, villagerRole, + villagerVillagerRole, werewolfRole, witchRole, _allegiance) import qualified Game.Werewolf.Role as Role import System.Directory @@ -204,7 +204,7 @@ return game where playerNames = map _name players - restrictedRoles = [scapegoatRole, seerRole, witchRole] + restrictedRoles = [scapegoatRole, seerRole, villagerVillagerRole, witchRole] killPlayer :: MonadState Game m => Player -> m () killPlayer player = players %= map (\player' -> if player' == player then player' & state .~ Dead else player') 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 @@ -139,9 +139,13 @@ stageAvailable _ Sunset = True stageAvailable _ VillagesTurn = True stageAvailable game WerewolvesTurn = any isWerewolf (filterAlive $ game ^. players) -stageAvailable game WitchsTurn = - (any isWitch (filterAlive $ game ^. players)) - && (not (game ^. healUsed) || not (game ^. poisonUsed)) +stageAvailable game WitchsTurn = and [ + any isWitch (filterAlive $ game ^. players), + not (game ^. healUsed) || not (game ^. poisonUsed), + witch ^. name `notElem` [name | (DevourEvent name) <- game ^. events] + ] + where + witch = head . filterWitches $ game ^. players getDevourEvent :: Game -> Maybe Event getDevourEvent game = listToMaybe [event | event@(DevourEvent _) <- game ^. events] 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 @@ -20,7 +20,8 @@ findByName, findByName_, -- ** Filters - filterScapegoats, filterSeers, filterVillagers, filterWerewolves, filterWitches, + filterScapegoats, filterSeers, filterVillagers, filterVillagerVillagers, filterWerewolves, + filterWitches, -- ** Queries doesPlayerExist, isScapegoat, isSeer, isVillager, isWerewolf, isWitch, isAlive, isDead, @@ -38,7 +39,7 @@ import Data.Maybe import Data.Text (Text) -import Game.Werewolf.Role hiding (findByName, name, _name) +import Game.Werewolf.Role hiding (name, _name) data Player = Player { _name :: Text @@ -69,6 +70,9 @@ filterVillagers :: [Player] -> [Player] filterVillagers = filter isVillager +filterVillagerVillagers :: [Player] -> [Player] +filterVillagerVillagers = filter isVillagerVillager + filterWerewolves :: [Player] -> [Player] filterWerewolves = filter isWerewolf @@ -86,6 +90,9 @@ isVillager :: Player -> Bool isVillager player = player ^. role == villagerRole + +isVillagerVillager :: Player -> Bool +isVillagerVillager player = player ^. role == villagerVillagerRole isWerewolf :: Player -> Bool isWerewolf player = player ^. role == werewolfRole 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 @@ -143,9 +143,14 @@ newPlayersInGameMessage players', rolesInGameMessage Nothing $ map _role players' ] ++ map (newPlayerMessage players') players' + ++ villagerVillagerMessages ++ stageMessages game where - players' = game ^. players + players' = game ^. players + villagerVillagerMessages = + case filterVillagerVillagers (game ^. players) of + [villagerVillager] -> [villagerVillagerMessage $ villagerVillager ^. name] + _ -> [] newPlayersInGameMessage :: [Player] -> Message newPlayersInGameMessage players = publicMessage $ T.concat [ @@ -156,12 +161,21 @@ newPlayerMessage :: [Player] -> Player -> Message newPlayerMessage players player | isWerewolf player = privateMessage (player ^. name) $ T.intercalate "\n" [T.concat ["You're a Werewolf", packMessage], player ^. role . description] - | otherwise = privateMessage (player ^. name) $ T.intercalate "\n" [T.concat ["You're a ", player ^. role . Role.name, "."], player ^. role . description] + | isVillager player = privateMessage (player ^. name) $ T.intercalate "\n" ["You're a Villager.", player ^. role . description] + | otherwise = privateMessage (player ^. name) $ T.intercalate "\n" [T.concat ["You're the ", player ^. role . Role.name, "."], player ^. role . description] where packMessage | length (filterWerewolves players) <= 1 = "." | otherwise = T.concat [", along with ", T.intercalate ", " (map _name $ filterWerewolves players \\ [player]), "."] +villagerVillagerMessage :: Text -> Message +villagerVillagerMessage name = publicMessage $ T.unwords [ + "Unguarded advice is seldom given, for advice is a dangerous gift,", + "even from the wise to the wise, and all courses may run ill.", + "Yet as you feel like you need help, I will begrudgingly leave you with this:", + name, "is the Villager-Villager." + ] + stageMessages :: Game -> [Message] stageMessages game = case game ^. stage of GameOver -> [] @@ -252,18 +266,10 @@ currentStageMessages to GameOver = [gameIsOverMessage to] currentStageMessages _ Sunrise = [] currentStageMessages _ Sunset = [] + -- TODO (hjw): pluralise this correctly for the Seer currentStageMessages to turn = [privateMessage to $ T.concat [ - "It's currently the ", showTurn turn, " turn." + "It's currently the ", T.pack $ show turn, "' turn." ]] - where - showTurn :: Stage -> Text - showTurn GameOver = undefined - showTurn SeersTurn = "Seer's" - showTurn Sunrise = undefined - showTurn Sunset = undefined - showTurn VillagesTurn = "Village's" - showTurn WerewolvesTurn = "Werewolves'" - showTurn WitchsTurn = "Witch's" rolesInGameMessage :: Maybe Text -> [Role] -> Message rolesInGameMessage mTo roles = Message mTo $ T.concat [ 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 @@ -17,11 +17,7 @@ Role(..), name, allegiance, description, advice, -- ** Instances - allRoles, diurnalRoles, nocturnalRoles, scapegoatRole, seerRole, villagerRole, werewolfRole, - witchRole, - - -- ** Queries - findByName, + allRoles, scapegoatRole, seerRole, villagerRole, villagerVillagerRole, werewolfRole, witchRole, -- * Allegiance Allegiance(..), @@ -29,10 +25,8 @@ import Control.Lens -import Data.List -import Data.Maybe -import Data.Text (Text) -import qualified Data.Text as T +import Data.Text (Text) +import qualified Data.Text as T import Prelude hiding (all) @@ -44,13 +38,7 @@ } deriving (Eq, Read, Show) allRoles :: [Role] -allRoles = [scapegoatRole, seerRole, villagerRole, werewolfRole, witchRole] - -diurnalRoles :: [Role] -diurnalRoles = [scapegoatRole, villagerRole, witchRole] - -nocturnalRoles :: [Role] -nocturnalRoles = allRoles \\ diurnalRoles +allRoles = [scapegoatRole, seerRole, villagerRole, villagerVillagerRole, werewolfRole, witchRole] scapegoatRole :: Role scapegoatRole = Role @@ -84,11 +72,20 @@ "Bluffing can be a good technique, but you had better be convincing about what you say." } +villagerVillagerRole :: Role +villagerVillagerRole = Role + { _name = "Villager-Villager" + , _allegiance = Villagers + , _description = "An honest townsperson humbly living in Millers Hollow." + , _advice = "You'll make friends quickly, but be wary about whom you trust." + } + werewolfRole :: Role werewolfRole = Role { _name = "Werewolf" , _allegiance = Werewolves - , _description = "A shapeshifting townsperson that, at night, hunts the residents of Millers Hollow." + , _description = + "A shapeshifting townsperson that, at night, hunts the residents of Millers Hollow." , _advice = "Voting against your partner can be a good way to deflect suspicion from yourself." } @@ -108,9 +105,6 @@ , "but there are no restrictions on how many you may use at night." ] } - -findByName :: Text -> Maybe Role -findByName name = find ((name ==) . _name) allRoles data Allegiance = Villagers | Werewolves deriving (Eq, Read, Show) diff --git a/test/app/Main.hs b/test/app/Main.hs --- a/test/app/Main.hs +++ b/test/app/Main.hs @@ -115,7 +115,7 @@ testProperty "check villages' turn does nothing unless all voted" prop_checkVillagesTurnDoesNothingUnlessAllVoted, testProperty "check werewolves' turn advances to witch's turn" prop_checkWerewolvesTurnAdvancesToWitchsTurn, - testProperty "check werewolves' turn doesn't skip witch's turn when witch devoured" prop_checkWerewolvesTurnDoesntSkipWitchsTurnWhenWitchDevoured, + testProperty "check werewolves' turn skips witch's turn when witch devoured" prop_checkWerewolvesTurnSkipsWitchsTurnWhenWitchDevoured, testProperty "check werewolves' turn skips witch's turn when healed and poisoned" prop_checkWerewolvesTurnSkipsWitchsTurnWhenHealedAndPoisoned, testProperty "check werewolves' turn kills one player when consensus" prop_checkWerewolvesTurnKillsOnePlayerWhenConsensus, testProperty "check werewolves' turn kills no one when conflicted" prop_checkWerewolvesTurnKillsNoOneWhenConflicted, @@ -139,6 +139,7 @@ testProperty "start game errors when more than 24 players" prop_startGameErrorsWhenMoreThan24Players, testProperty "start game errors when more than 1 scapegoat" prop_startGameErrorsWhenMoreThan1Scapegoat, testProperty "start game errors when more than 1 seer" prop_startGameErrorsWhenMoreThan1Seer, + testProperty "start game errors when more than 1 villager-villager" prop_startGameErrorsWhenMoreThan1VillagerVillager, testProperty "start game errors when more than 1 witch" prop_startGameErrorsWhenMoreThan1Witch, testProperty "create players uses given player names" prop_createPlayersUsesGivenPlayerNames, 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 @@ -137,14 +137,15 @@ n <- choose (7, 24) players <- nubOn _name <$> infiniteList - let scapegoat = head $ filterScapegoats players - let seer = head $ filterSeers players - let witch = head $ filterWitches players + let scapegoat = head $ filterScapegoats players + let seer = head $ filterSeers players + let villagerVillager = head $ filterVillagerVillagers players + let witch = head $ filterWitches players let werewolves = take (n `quot` 6 + 1) $ filterWerewolves players - let villagers = take (n - 3 - (length werewolves)) $ filterVillagers players + let villagers = take (n - 4 - (length werewolves)) $ filterVillagers players - return $ scapegoat:seer:witch:werewolves ++ villagers + return $ scapegoat:seer:villagerVillager:witch:werewolves ++ villagers arbitraryScapegoat :: Game -> Gen Player arbitraryScapegoat = elements . filterAlive . filterScapegoats . _players 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 @@ -22,7 +22,7 @@ prop_checkVillagesTurnDoesNothingUnlessAllVoted, prop_checkWerewolvesTurnAdvancesToWitchsTurn, - prop_checkWerewolvesTurnDoesntSkipWitchsTurnWhenWitchDevoured, + prop_checkWerewolvesTurnSkipsWitchsTurnWhenWitchDevoured, prop_checkWerewolvesTurnSkipsWitchsTurnWhenHealedAndPoisoned, prop_checkWerewolvesTurnKillsOnePlayerWhenConsensus, prop_checkWerewolvesTurnKillsNoOneWhenConflicted, prop_checkWerewolvesTurnResetsVotes, @@ -39,7 +39,8 @@ prop_startGameStartsWithSunsetStage, prop_startGameUsesGivenPlayers, prop_startGameErrorsUnlessUniquePlayerNames, prop_startGameErrorsWhenLessThan7Players, prop_startGameErrorsWhenMoreThan24Players, prop_startGameErrorsWhenMoreThan1Scapegoat, - prop_startGameErrorsWhenMoreThan1Seer, prop_startGameErrorsWhenMoreThan1Witch, + prop_startGameErrorsWhenMoreThan1Seer, prop_startGameErrorsWhenMoreThan1VillagerVillager, + prop_startGameErrorsWhenMoreThan1Witch, -- * createPlayers prop_createPlayersUsesGivenPlayerNames, prop_createPlayersUsesGivenRoles, @@ -178,12 +179,12 @@ game' = game { _stage = WerewolvesTurn } n = length . filterWerewolves $ game' ^. players -prop_checkWerewolvesTurnDoesntSkipWitchsTurnWhenWitchDevoured :: Game -> Property -prop_checkWerewolvesTurnDoesntSkipWitchsTurnWhenWitchDevoured game = +prop_checkWerewolvesTurnSkipsWitchsTurnWhenWitchDevoured :: Game -> Property +prop_checkWerewolvesTurnSkipsWitchsTurnWhenWitchDevoured game = forAll (arbitraryWitch game) $ \witch -> let devourVoteCommands = map (\werewolf -> devourVoteCommand (werewolf ^. name) (witch ^. name)) (filterWerewolves $ game ^. players) game'' = foldl (flip $ run_ . apply) game' devourVoteCommands - in isWitchsTurn $ run_ checkStage game'' + in not . isWitchsTurn $ run_ checkStage game'' where game' = game { _stage = WerewolvesTurn } @@ -341,6 +342,11 @@ prop_startGameErrorsWhenMoreThan1Seer :: [Player] -> Property prop_startGameErrorsWhenMoreThan1Seer players = length (filterSeers players) > 1 + ==> isLeft (runExcept . runWriterT $ startGame "" players) + +prop_startGameErrorsWhenMoreThan1VillagerVillager :: [Player] -> Property +prop_startGameErrorsWhenMoreThan1VillagerVillager players = + length (filterVillagerVillagers players) > 1 ==> isLeft (runExcept . runWriterT $ startGame "" players) prop_startGameErrorsWhenMoreThan1Witch :: [Player] -> Property diff --git a/werewolf.cabal b/werewolf.cabal --- a/werewolf.cabal +++ b/werewolf.cabal @@ -1,5 +1,5 @@ name: werewolf -version: 0.4.1.3 +version: 0.4.2.0 author: Henry J. Wylde maintainer: public@hjwylde.com @@ -29,7 +29,6 @@ ghc-options: -threaded -with-rtsopts=-N other-modules: Werewolf.Commands.End, - Werewolf.Commands.Heal, Werewolf.Commands.Help, Werewolf.Commands.Interpret, Werewolf.Commands.Pass,