werewolf 0.4.1.3 → 0.4.2.0
raw patch · 15 files changed
+86/−128 lines, 15 files
Files
- CHANGELOG.md +4/−23
- README.md +1/−0
- app/Werewolf/Commands/Heal.hs +0/−43
- app/Werewolf/Commands/Help.hs +2/−2
- app/Werewolf/Commands/Start.hs +7/−1
- app/Werewolf/Options.hs +1/−6
- src/Game/Werewolf/Engine.hs +3/−3
- src/Game/Werewolf/Game.hs +7/−3
- src/Game/Werewolf/Player.hs +9/−2
- src/Game/Werewolf/Response.hs +18/−12
- src/Game/Werewolf/Role.hs +14/−20
- test/app/Main.hs +2/−1
- test/src/Game/Werewolf/Test/Arbitrary.hs +6/−5
- test/src/Game/Werewolf/Test/Engine.hs +11/−5
- werewolf.cabal +1/−2
CHANGELOG.md view
@@ -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
README.md view
@@ -23,6 +23,7 @@ * Scapegoat. * Seer. * Villager.+* Villager-Villager. * Werewolf. * Witch.
− app/Werewolf/Commands/Heal.hs
@@ -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 }
app/Werewolf/Commands/Help.hs view
@@ -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."
app/Werewolf/Commands/Start.hs view
@@ -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
app/Werewolf/Options.hs view
@@ -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
src/Game/Werewolf/Engine.hs view
@@ -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')
src/Game/Werewolf/Game.hs view
@@ -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]
src/Game/Werewolf/Player.hs view
@@ -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
src/Game/Werewolf/Response.hs view
@@ -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 [
src/Game/Werewolf/Role.hs view
@@ -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)
test/app/Main.hs view
@@ -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,
test/src/Game/Werewolf/Test/Arbitrary.hs view
@@ -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
test/src/Game/Werewolf/Test/Engine.hs view
@@ -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
werewolf.cabal view
@@ -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,