werewolf 0.3.2.0 → 0.3.3.0

raw patch · 14 files changed

+171/−38 lines, 14 files

Files

• CHANGELOG.md +11/−0
• README.md +1/−0
• app/Main.hs +2/−0
• app/Werewolf/Commands/Help.hs +3/−0
• app/Werewolf/Options.hs +6/−1
• src/Game/Werewolf/Command.hs +35/−1
• src/Game/Werewolf/Engine.hs +15/−6
• src/Game/Werewolf/Player.hs +8/−2
• src/Game/Werewolf/Response.hs +53/−15
• src/Game/Werewolf/Role.hs +11/−2
• test/app/Main.hs +3/−2
• test/src/Game/Werewolf/Test/Arbitrary.hs +7/−3
• test/src/Game/Werewolf/Test/Engine.hs +15/−5
• werewolf.cabal +1/−1

@@ -2,6 +2,17 @@  #### Upcoming +#### v0.3.3.0++*Minor*++* Added a Scapegoat role. ([#40](https://github.com/hjwylde/werewolf/issues/40))+* Added a `status` command. ([#18](https://github.com/hjwylde/werewolf/issues/18))++*Revisions*++* Added `--` to help description of `interpret`. ([#60](https://github.com/hjwylde/werewolf/issues/60))+ #### v0.3.2.0  *Minor*

@@ -20,6 +20,7 @@ #### Roles  The current implemented roles are:+* Scapegoat. * Seer. * Villager. * Werewolf.

@@ -27,6 +27,7 @@ import qualified Werewolf.Commands.Quit      as Quit import qualified Werewolf.Commands.See       as See import qualified Werewolf.Commands.Start     as Start+import qualified Werewolf.Commands.Status    as Status import qualified Werewolf.Commands.Vote      as Vote import           Werewolf.Options @@ -52,4 +53,5 @@     Quit                                -> Quit.handle callerName     See options                         -> See.handle callerName options     Start options                       -> Start.handle callerName options+    Status                              -> Status.handle callerName     Vote options                        -> Vote.handle callerName options

@@ -73,6 +73,9 @@     "start [--extra-roles ROLE,...] PLAYER ...",     "- Starts a new game with the given players and extra roles. A game requires at least 7 players."     ], [+    "status",+    "- Gets the status of the current game."+    ], [     "vote PLAYER",     T.unwords [         "- Vote against a player.",

@@ -48,6 +48,7 @@     | Quit     | See See.Options     | Start Start.Options+    | Status     | Vote Vote.Options     deriving (Eq, Show) @@ -83,6 +84,7 @@         command "quit"      $ info (helper <*> quit)        (fullDesc <> progDesc "Quit the current game"),         command "see"       $ info (helper <*> see)         (fullDesc <> progDesc "See a player's allegiance"),         command "start"     $ info (helper <*> start)       (fullDesc <> progDesc "Start a new game"),+        command "status"    $ info (helper <*> status)      (fullDesc <> progDesc "Get the status of the current game"),         command "vote"      $ info (helper <*> vote)        (fullDesc <> progDesc "Vote against a player")         ]) @@ -99,7 +101,7 @@         ])  interpret :: Parser Command-interpret = Interpret . Interpret.Options <$> many (T.pack <$> strArgument (metavar "COMMAND ARG..."))+interpret = Interpret . Interpret.Options <$> many (T.pack <$> strArgument (metavar "-- COMMAND ARG..."))  quit :: Parser Command quit = pure Quit@@ -115,6 +117,9 @@         help "Specify the extra roles to include"         ])     <*> many (T.pack <$> strArgument (metavar "PLAYER..."))++status :: Parser Command+status = pure Status  vote :: Parser Command vote = Vote . Vote.Options . T.pack <$> strArgument (metavar "PLAYER")

@@ -17,7 +17,7 @@     Command(..),      -- ** Instances-    devourVoteCommand, lynchVoteCommand, noopCommand, quitCommand, seeCommand,+    devourVoteCommand, lynchVoteCommand, noopCommand, quitCommand, seeCommand, statusCommand, ) where  import Control.Lens         hiding (only)@@ -27,9 +27,12 @@ import Control.Monad.Writer  import qualified Data.Map  as Map+import Data.List import           Data.Text (Text)+import           qualified Data.Text as T  import Game.Werewolf.Engine+import Game.Werewolf.Role hiding (Werewolves, Villagers, name, _name, findByName_) import Game.Werewolf.Player hiding (doesPlayerExist) import Game.Werewolf.Game     hiding (isGameOver, isSeersTurn, isVillagersTurn, isWerewolvesTurn,                                killPlayer)@@ -81,6 +84,37 @@     validatePlayer callerName targetName      sees %= Map.insert callerName targetName++statusCommand :: Text -> Command+statusCommand callerName = Command $ use turn >>= \turn' -> case turn' of+    Seers       -> do+        game <- get++        tell $ standardStatusMessages turn' (game ^. players)+    Villagers   -> do+        game <- get++        tell $ standardStatusMessages turn' (game ^. players)+        tell [waitingOnMessage callerName $ filter (flip Map.notMember (game ^. votes) . _name) (filterAlive $ game ^. players)]+    Werewolves  -> do+        unlessM (doesPlayerExist callerName) $ throwError [playerDoesNotExistMessage callerName callerName]++        game <- get++        tell $ standardStatusMessages turn' (game ^. players)+        whenM (isPlayerWerewolf callerName) $ tell [waitingOnMessage callerName $ filter (flip Map.notMember (game ^. votes) . _name) (filterAlive . filterWerewolves $ game ^. players)]+    NoOne       -> do+        aliveAllegiances <- uses players $ nub . map (_allegiance . _role) . filterAlive++        case aliveAllegiances of+            [allegiance]    -> tell [gameOverMessage . Just . T.pack $ show allegiance]+            _               -> tell [gameOverMessage Nothing]+    where+        standardStatusMessages turn players = [+            currentTurnMessage callerName turn,+            rolesInGameMessage (Just [callerName]) $ map _role players,+            playersInGameMessage callerName players+            ]  validatePlayer :: (MonadError [Message] m, MonadState Game m) => Text -> Text -> m () validatePlayer callerName name = do

@@ -89,8 +89,17 @@              let mLynchedName = only . last $ groupSortOn (length . flip elemIndices (Map.elems votes')) (nub $ Map.elems votes')             case mLynchedName of-                Nothing             -> tell [noPlayerLynchedMessage]-                Just lynchedName    -> do+                Nothing                -> do+                    aliveScapegoats <- uses players (filterAlive . filterScapegoats)++                    let mScapegoat = only aliveScapegoats+                    case mScapegoat of+                        Nothing        -> tell [noPlayerLynchedMessage]+                        Just scapegoat -> do+                            killPlayer scapegoat+                            tell [scapegoatLynchedMessage (scapegoat ^. name)]++                Just lynchedName       -> do                     target <- uses players (findByName_ lynchedName)                      killPlayer target@@ -143,10 +152,10 @@ checkGameOver = do     aliveAllegiances <- uses players $ nub . map (_allegiance . _role) . filterAlive -    case length aliveAllegiances of-        0 -> turn .= NoOne >> tell [gameOverMessage Nothing]-        1 -> turn .= NoOne >> tell [gameOverMessage . Just . T.pack . show $ head aliveAllegiances]-        _ -> return ()+    case aliveAllegiances of+        []              -> turn .= NoOne >> tell [gameOverMessage Nothing]+        [allegiance]    -> turn .= NoOne >> tell [gameOverMessage . Just . T.pack $ show allegiance]+        _               -> return ()  startGame :: (MonadError [Message] m, MonadWriter [Message] m) => Text -> [Player] -> m Game startGame callerName players = do

@@ -20,10 +20,10 @@     findByName, findByName_,      -- ** Filters-    filterSeers, filterVillagers, filterWerewolves,+    filterSeers, filterVillagers, filterWerewolves, filterScapegoats,      -- ** Queries-    doesPlayerExist, isSeer, isVillager, isWerewolf, isAlive, isDead,+    doesPlayerExist, isSeer, isVillager, isWerewolf, isScapegoat, isAlive, isDead,      -- * State     State(..),@@ -69,6 +69,9 @@ filterWerewolves :: [Player] -> [Player] filterWerewolves = filter isWerewolf +filterScapegoats :: [Player] -> [Player]+filterScapegoats = filter isScapegoat+ doesPlayerExist :: Text -> [Player] -> Bool doesPlayerExist name = isJust . findByName name @@ -80,6 +83,9 @@  isWerewolf :: Player -> Bool isWerewolf player = player ^. role == werewolfRole++isScapegoat :: Player -> Bool+isScapegoat player = player ^. role == scapegoatRole  isAlive :: Player -> Bool isAlive player = player ^. state == Alive

@@ -30,11 +30,15 @@     -- ** Generic messages     newGameMessages, turnMessages, nightFallsMessage, gameOverMessage, playerQuitMessage, +    -- ** Status messages+    currentTurnMessage, rolesInGameMessage, playersInGameMessage, waitingOnMessage,+     -- ** Seers turn messages     seersTurnMessages, playerSeenMessage,      -- ** Villagers turn messages     villagersTurnMessage, playerMadeLynchVoteMessage, playerLynchedMessage, noPlayerLynchedMessage,+    scapegoatLynchedMessage,      -- ** Werewolves turn messages     werewolvesTurnMessages, playerMadeDevourVoteMessage, playerDevouredMessage,@@ -123,28 +127,17 @@ privateMessage to = Message (Just to)  newGameMessages :: Game -> [Message]-newGameMessages game = [playersInGameMessage players', rolesInGameMessage $ map _role players'] ++ map (newPlayerMessage players') players' ++ [nightFallsMessage] ++ turnMessages turn' players'+newGameMessages game = [newPlayersInGameMessage players', rolesInGameMessage Nothing $ map _role players'] ++ map (newPlayerMessage players') players' ++ [nightFallsMessage] ++ turnMessages turn' players'     where         turn'       = game ^. turn         players'    = game ^. players -playersInGameMessage :: [Player] -> Message-playersInGameMessage players = publicMessage $ T.concat [+newPlayersInGameMessage :: [Player] -> Message+newPlayersInGameMessage players = publicMessage $ T.concat [     "A new game of werewolf is starting with ",     T.intercalate ", " (map _name players), "!"     ] -rolesInGameMessage :: [Role] -> Message-rolesInGameMessage roles = publicMessage $ T.concat [-    "The roles in play are ",-    T.intercalate ", " $ map (\(role, count) ->-        T.concat [role ^. Role.name, " (", T.pack $ show count, ")"])-        roleCounts,-    "."-    ]-    where-        roleCounts = map (\list -> (head list, length list)) (groupSortOn Role._name roles)- 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]@@ -152,7 +145,7 @@     where         packMessage             | length (filterWerewolves players) <= 1    = "."-            | otherwise                                 = T.concat [", along with ", T.intercalate "," (map _name $ filterWerewolves players \\ [player]), "."]+            | otherwise                                 = T.concat [", along with ", T.intercalate ", " (map _name $ filterWerewolves players \\ [player]), "."]  turnMessages :: Turn -> [Player] -> [Message] turnMessages Seers players      = seersTurnMessages $ filter isSeer players@@ -170,6 +163,44 @@ playerQuitMessage :: Player -> Message playerQuitMessage player = publicMessage $ T.unwords [player ^. name, "the", player ^. role . Role.name, "has quit!"] +currentTurnMessage :: Text -> Turn -> Message+currentTurnMessage name NoOne   = gameIsOverMessage name+currentTurnMessage name turn    = privateMessage [name] $ T.unwords [+    "It's currently the", T.pack $ show turn, "turn."+    ]++rolesInGameMessage :: Maybe [Text] -> [Role] -> Message+rolesInGameMessage mTo roles = Message mTo $ T.concat [+    "The roles in play are ",+    T.intercalate ", " $ map (\(role, count) ->+        T.concat [role ^. Role.name, " (", T.pack $ show count, ")"])+        roleCounts,+    "."+    ]+    where+        roleCounts = map (\list -> (head list, length list)) (groupSortOn Role._name roles)++playersInGameMessage :: Text -> [Player] -> Message+playersInGameMessage to players = privateMessage [to] . T.intercalate "\n" $ [+    alivePlayersText+    ] ++ if (null $ filterDead players) then [] else [deadPlayersText]+    where+        alivePlayersText = T.concat [+            "The following players are still alive: ",+            T.intercalate ", " (map _name $ filterAlive players), "."+            ]+        deadPlayersText = T.concat [+            "The following players are dead: ",+            T.intercalate ", " (map (\player -> T.concat [player ^. name, " (", player ^. role . Role.name, ")"]) $ filterDead players), "."+            ]++waitingOnMessage :: Text -> [Player] -> Message+waitingOnMessage name players = privateMessage [name] $ T.concat [+    "Waiting on ", T.intercalate ", " playerNames, "..."+    ]+    where+        playerNames = map _name players+ seersTurnMessages :: [Player] -> [Message] seersTurnMessages seers = [     publicMessage "The Seers wake up.",@@ -207,6 +238,13 @@ werewolvesTurnMessages werewolves = [     publicMessage "The Werewolves wake up, recognise one another and choose a new victim.",     privateMessage (map _name werewolves) "Whom would you like to devour?"+    ]++scapegoatLynchedMessage :: Text -> Message+scapegoatLynchedMessage name = publicMessage $ T.unwords [+    "The townsfolk squabble over whom to tie up. Just as they are about to call it a day",+    "they notice that", name, "has been acting awfully suspicious.",+    "Not wanting to take any chances,", name, "is promptly tied to a pyre and burned alive."     ]  playerMadeDevourVoteMessage :: [Text] -> Text -> Text -> Message

@@ -17,7 +17,7 @@     Role(..), name, allegiance, description, advice,      -- ** Instances-    allRoles, seerRole, villagerRole, werewolfRole,+    allRoles, seerRole, villagerRole, werewolfRole, scapegoatRole,      -- ** Queries     findByName, findByName_,@@ -43,7 +43,7 @@     } deriving (Eq, Read, Show)  allRoles :: [Role]-allRoles = [seerRole, villagerRole, werewolfRole]+allRoles = [seerRole, villagerRole, werewolfRole, scapegoatRole]  seerRole :: Role seerRole = Role@@ -76,6 +76,15 @@     , _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."+    }++scapegoatRole :: Role+scapegoatRole = Role+    { _name         = "Scapegoat"+    , _allegiance   = Villagers+    , _description  = "That one person everyone loves to blame."+    , _advice       =+        "Cross your fingers that the votes don't end up tied."     }  findByName :: Text -> Maybe Role

@@ -78,7 +78,8 @@      testProperty "PROP: check villagers turn advances to seers" prop_checkVillagersTurnAdvancesToSeers,     testProperty "PROP: check villagers turn lynches one player when consensus" prop_checkVillagersTurnLynchesOnePlayerWhenConsensus,-    testProperty "PROP: check villagers turn lynches no one when conflicted" prop_checkVillagersTurnLynchesNoOneWhenConflicted,+    testProperty "PROP: check villagers turn lynches no one when conflicted and no scapegoats" prop_checkVillagersTurnLynchesNoOneWhenConflictedAndNoScapegoats,+    testProperty "PROP: check villagers turn lynches scapegoat when conflicted" prop_checkVillagersTurnLynchesScapegoatWhenConflicted,     testProperty "PROP: check villagers turn resets votes" prop_checkVillagersTurnResetsVotes,     testProperty "PROP: check villagers turn does nothing unless all voted" prop_checkVillagersTurnDoesNothingUnlessAllVoted, @@ -89,7 +90,7 @@     testProperty "PROP: check werewolves turn does nothing unless all voted" prop_checkWerewolvesTurnDoesNothingUnlessAllVoted,      testProperty "PROP: check game over advances turn" prop_checkGameOverAdvancesTurn,-    testProperty "PROP: check game over does nothing when at least two allegiances alivevoted" prop_checkGameOverDoesNothingWhenAtLeastTwoAllegiancesAlive,+    testProperty "PROP: check game over does nothing when at least two allegiances alive" prop_checkGameOverDoesNothingWhenAtLeastTwoAllegiancesAlive,      testProperty "PROP: start game starts with seers turn when seers present" prop_startGameStartsWithSeersTurnWhenSeersPresent,     testProperty "PROP: start game starts with werewolves turn when seers absent" prop_startGameStartsWithWerewolvesTurnWhenSeersAbsent,

@@ -12,7 +12,7 @@     -- * Contextual arbitraries     arbitraryCommand, arbitraryDevourVoteCommand, arbitraryLynchVoteCommand, arbitraryQuitCommand,     arbitrarySeeCommand, arbitraryNewGame, arbitraryPlayer, arbitrarySeer, arbitraryVillager,-    arbitraryWerewolf,+    arbitraryWerewolf, arbitraryScapegoat,      -- * Utility functions     run, run_, runArbitraryCommands,@@ -96,9 +96,10 @@      let seer        = head $ filterSeers players     let werewolves  = take (n `quot` 6 + 1) $ filterWerewolves players-    let villagers   = take (n - 1 - (length werewolves)) $ filterVillagers players+    let villagers   = take (n - 2 - (length werewolves)) $ filterVillagers players+    let scapegoat   = head $ filterScapegoats players -    return $ newGame (seer:werewolves ++ villagers)+    return $ newGame (seer:scapegoat:werewolves ++ villagers)  instance Arbitrary Turn where     arbitrary = elements [Seers, Villagers, Werewolves, NoOne]@@ -117,6 +118,9 @@  arbitraryWerewolf :: Game -> Gen Player arbitraryWerewolf = elements . filterAlive . filterWerewolves . _players++arbitraryScapegoat :: Game -> Gen Player+arbitraryScapegoat = elements . filterAlive . filterScapegoats . _players  instance Arbitrary State where     arbitrary = elements [Alive, Dead]

@@ -13,8 +13,8 @@     prop_checkTurnSkipsSeersWhenNoSeers, prop_checkTurnDoesNothingWhenGameOver,     prop_checkSeersTurnAdvancesToWerewolves, prop_checkSeersTurnResetsSees,     prop_checkSeersTurnDoesNothingUnlessAllSeen, prop_checkVillagersTurnAdvancesToSeers,-    prop_checkVillagersTurnLynchesOnePlayerWhenConsensus,-    prop_checkVillagersTurnLynchesNoOneWhenConflicted, prop_checkVillagersTurnResetsVotes,+    prop_checkVillagersTurnLynchesOnePlayerWhenConsensus, prop_checkVillagersTurnLynchesNoOneWhenConflictedAndNoScapegoats,+    prop_checkVillagersTurnLynchesScapegoatWhenConflicted, prop_checkVillagersTurnResetsVotes,     prop_checkVillagersTurnDoesNothingUnlessAllVoted, prop_checkWerewolvesTurnAdvancesToVillagers,     prop_checkWerewolvesTurnKillsOnePlayerWhenConsensus,     prop_checkWerewolvesTurnKillsNoOneWhenConflicted, prop_checkWerewolvesTurnResetsVotes,@@ -113,11 +113,21 @@         game'   = game { _turn = Villagers }         n       = length $ game' ^. players -prop_checkVillagersTurnLynchesNoOneWhenConflicted :: Game -> Property-prop_checkVillagersTurnLynchesNoOneWhenConflicted game =+prop_checkVillagersTurnLynchesNoOneWhenConflictedAndNoScapegoats :: Game -> Property+prop_checkVillagersTurnLynchesNoOneWhenConflictedAndNoScapegoats game =     forAll (runArbitraryCommands n game') $ \game'' ->     length (last $ groupSortOn (length . flip elemIndices (Map.elems $ game'' ^. votes)) (nub . Map.elems $ game'' ^. votes)) > 1-    ==> length (filterDead $ run_ checkTurn game'' ^. players) == 0+    ==> length (filterDead $ run_ checkTurn game'' ^. players) == length (filterDead $ game' ^. players)+    where+        game'   = (foldl killPlayer game (filterScapegoats $ game ^. players)) { _turn = Villagers }+        n       = length $ game' ^. players++prop_checkVillagersTurnLynchesScapegoatWhenConflicted :: Game -> Property+prop_checkVillagersTurnLynchesScapegoatWhenConflicted game =+    forAll (runArbitraryCommands n game') $ \game'' -> and [+        length (last $ groupSortOn (length . flip elemIndices (Map.elems $ game'' ^. votes)) (nub . Map.elems $ game'' ^. votes)) > 1,+        any isScapegoat $ game' ^. players+        ] ==> isScapegoat $ head (filterDead $ run_ checkTurn game'' ^. players)     where         game'   = game { _turn = Villagers }         n       = length $ game' ^. players

@@ -1,5 +1,5 @@ name:           werewolf-version:        0.3.2.0+version:        0.3.3.0  author:         Henry J. Wylde maintainer:     public@hjwylde.com