diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,12 +2,18 @@ #### Upcoming -#### v0.4.6.1 +#### v0.4.7.0 *Revisions* -* Fixed Village Idiot text to have spaces around the name. ([#87](https://github.com/hjwylde/werewolf/issues/87)) -* Fixed a bug where the Werewolves couldn't win if it was down to 1 Werewolf and the Village Idiot. ([#88](https://github.com/hjwylde/werewolf/issues/88)) +* Fixed balance calculation to ensure total balance is between -2 and 2. +* Changed `--random-extra-roles` to have between `n / 3` and `n / 3 + 2` extra roles. +* Added prisms and traversals to Role, Player & Game modules. ([#20](https://github.com/hjwylde/werewolf/issues/20)) +* Removed fudging of roles and replaced with fudging of allegiances. +* Wolf-hound now has their allegiance hidden when they are lynched. +* Fixed the grammar on the first Werewolves' turn messages. +* Moved Wolf-hound's turn to before the Seer's so that the Seer may see his allegiance properly. +* Restricted specifying `Simple Villager` or `Simple Werewolf` as extra roles. #### v0.4.6.0 diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -6,7 +6,6 @@ Maintainer : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-} {-# LANGUAGE OverloadedStrings #-} module Main ( diff --git a/app/Werewolf/Commands/Choose.hs b/app/Werewolf/Commands/Choose.hs --- a/app/Werewolf/Commands/Choose.hs +++ b/app/Werewolf/Commands/Choose.hs @@ -30,6 +30,7 @@ import Game.Werewolf +import Werewolf.Game import Werewolf.Messages data Options = Options diff --git a/app/Werewolf/Commands/Circle.hs b/app/Werewolf/Commands/Circle.hs --- a/app/Werewolf/Commands/Circle.hs +++ b/app/Werewolf/Commands/Circle.hs @@ -26,6 +26,7 @@ import Game.Werewolf +import Werewolf.Game import Werewolf.Messages data Options = Options diff --git a/app/Werewolf/Commands/End.hs b/app/Werewolf/Commands/End.hs --- a/app/Werewolf/Commands/End.hs +++ b/app/Werewolf/Commands/End.hs @@ -24,6 +24,7 @@ import Game.Werewolf +import Werewolf.Game import Werewolf.Messages handle :: MonadIO m => Text -> m () diff --git a/app/Werewolf/Commands/Heal.hs b/app/Werewolf/Commands/Heal.hs --- a/app/Werewolf/Commands/Heal.hs +++ b/app/Werewolf/Commands/Heal.hs @@ -25,6 +25,7 @@ import Game.Werewolf +import Werewolf.Game import Werewolf.Messages handle :: MonadIO m => Text -> m () 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 @@ -59,16 +59,17 @@ commandsMessages :: [Text] commandsMessages = [ "choose (ALLEGIANCE | PLAYER,...) - choose an allegiance or player(s)." + , "circle [--include-dead] - get the game circle." , "end - ends the current game." , "heal - heal the devoured player." , "pass - pass on healing or poisoning a player." - , "ping - pings the status of the current game publicly." + , "ping - ping the status of the current game publicly." , "poison PLAYER - poison a player." , "protect PLAYER - protect a player." , "quit - quit the current game." , "see PLAYER - see a player's allegiance." , "start ([--extra-roles ROLE,...] | [--random-extra-roles]) 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." + , "status - get the status of the current game." , "version - show this engine's version." , "vote PLAYER - vote against a player." ] diff --git a/app/Werewolf/Commands/Pass.hs b/app/Werewolf/Commands/Pass.hs --- a/app/Werewolf/Commands/Pass.hs +++ b/app/Werewolf/Commands/Pass.hs @@ -23,6 +23,7 @@ import Game.Werewolf +import Werewolf.Game import Werewolf.Messages handle :: MonadIO m => Text -> m () diff --git a/app/Werewolf/Commands/Ping.hs b/app/Werewolf/Commands/Ping.hs --- a/app/Werewolf/Commands/Ping.hs +++ b/app/Werewolf/Commands/Ping.hs @@ -23,6 +23,7 @@ import Game.Werewolf +import Werewolf.Game import Werewolf.Messages handle :: MonadIO m => Text -> m () diff --git a/app/Werewolf/Commands/Poison.hs b/app/Werewolf/Commands/Poison.hs --- a/app/Werewolf/Commands/Poison.hs +++ b/app/Werewolf/Commands/Poison.hs @@ -26,6 +26,7 @@ import Game.Werewolf +import Werewolf.Game import Werewolf.Messages data Options = Options diff --git a/app/Werewolf/Commands/Protect.hs b/app/Werewolf/Commands/Protect.hs --- a/app/Werewolf/Commands/Protect.hs +++ b/app/Werewolf/Commands/Protect.hs @@ -26,6 +26,7 @@ import Game.Werewolf +import Werewolf.Game import Werewolf.Messages data Options = Options diff --git a/app/Werewolf/Commands/Quit.hs b/app/Werewolf/Commands/Quit.hs --- a/app/Werewolf/Commands/Quit.hs +++ b/app/Werewolf/Commands/Quit.hs @@ -23,6 +23,7 @@ import Game.Werewolf +import Werewolf.Game import Werewolf.Messages handle :: MonadIO m => Text -> m () diff --git a/app/Werewolf/Commands/See.hs b/app/Werewolf/Commands/See.hs --- a/app/Werewolf/Commands/See.hs +++ b/app/Werewolf/Commands/See.hs @@ -26,6 +26,7 @@ import Game.Werewolf +import Werewolf.Game import Werewolf.Messages data Options = Options 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 @@ -10,6 +10,7 @@ -} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} module Werewolf.Commands.Start ( -- * Options @@ -21,20 +22,20 @@ import Control.Lens import Control.Monad.Except -import Control.Monad.Random import Control.Monad.Extra +import Control.Monad.Random import Control.Monad.State import Control.Monad.Writer -import Data.List import Data.Text (Text) import qualified Data.Text as T -import Game.Werewolf -import Game.Werewolf.Role as Role +import Game.Werewolf hiding (name) +import Game.Werewolf.Role import System.Random.Shuffle +import Werewolf.Game import Werewolf.Messages data Options = Options @@ -47,7 +48,7 @@ handle :: MonadIO m => Text -> Options -> m () handle callerName (Options extraRoles playerNames) = do - whenM (doesGameExist &&^ fmap (not . isGameOver) readGame) $ exitWith failure + whenM (doesGameExist &&^ (hasn't (stage . _GameOver) <$> readGame)) $ exitWith failure { messages = [gameAlreadyRunningMessage callerName] } @@ -67,7 +68,7 @@ randomExtraRoles :: MonadIO m => Int -> m [Role] randomExtraRoles n = liftIO . evalRandIO $ do - let minimum = n `div` 5 + 1 + let minimum = n `div` 3 count <- getRandomR (minimum, minimum + 2) @@ -79,4 +80,4 @@ Nothing -> throwError [roleDoesNotExistMessage callerName roleName] findByName :: Text -> Maybe Role -findByName name' = find ((name' ==) . T.toLower . view Role.name) allRoles +findByName name' = restrictedRoles ^? traverse . filtered ((name' ==) . T.toLower . view name) diff --git a/app/Werewolf/Commands/Status.hs b/app/Werewolf/Commands/Status.hs --- a/app/Werewolf/Commands/Status.hs +++ b/app/Werewolf/Commands/Status.hs @@ -23,6 +23,7 @@ import Game.Werewolf +import Werewolf.Game import Werewolf.Messages handle :: MonadIO m => Text -> m () diff --git a/app/Werewolf/Commands/Vote.hs b/app/Werewolf/Commands/Vote.hs --- a/app/Werewolf/Commands/Vote.hs +++ b/app/Werewolf/Commands/Vote.hs @@ -27,6 +27,7 @@ import Game.Werewolf +import Werewolf.Game import Werewolf.Messages data Options = Options diff --git a/app/Werewolf/Game.hs b/app/Werewolf/Game.hs new file mode 100644 --- /dev/null +++ b/app/Werewolf/Game.hs @@ -0,0 +1,74 @@ +{-| +Module : Werewolf.Game +Description : Game functions pertaining to binary calls. + +Copyright : (c) Henry J. Wylde, 2016 +License : BSD3 +Maintainer : public@hjwylde.com + +This module defines a few utility functions for working with a game state file. It also provides +functions for padding roles and shuffling them when creating players. +-} + +module Werewolf.Game ( + -- * Game + + -- ** Creating anew + startGame, createPlayers, padRoles, + + -- ** Working with an existing + defaultFilePath, readGame, writeGame, deleteGame, doesGameExist, +) where + +import Control.Lens hiding (cons) +import Control.Monad.Except +import Control.Monad.Random + +import Data.List.Extra +import Data.Text (Text) + +import Game.Werewolf + +import Prelude hiding (round) + +import System.Directory +import System.FilePath +import System.Random.Shuffle + +createPlayers :: MonadIO m => [Text] -> [Role] -> m [Player] +createPlayers playerNames roles = liftIO $ zipWith newPlayer playerNames <$> evalRandIO (shuffleM roles) + +padRoles :: [Role] -> Int -> [Role] +padRoles roles n = roles ++ simpleVillagerRoles ++ simpleWerewolfRoles + where + goal = 3 + m = max (n - length roles) 0 + startingBalance = sumOf (traverse . balance) roles + simpleWerewolfBalance = simpleWerewolfRole ^. balance + + -- Little magic here to calculate how many Werewolves and Villagers we want. + -- This tries to ensure that the balance of the game is between -2 and 2. + simpleWerewolvesCount = (goal - m - startingBalance) `div` (simpleWerewolfBalance - 1) + 1 + simpleVillagersCount = m - simpleWerewolvesCount + + -- N.B., if roles is quite unbalanced then one list will be empty. + simpleVillagerRoles = replicate simpleVillagersCount simpleVillagerRole + simpleWerewolfRoles = replicate simpleWerewolvesCount simpleWerewolfRole + +defaultFilePath :: MonadIO m => m FilePath +defaultFilePath = ( defaultFileName) <$> liftIO getHomeDirectory + +defaultFileName :: FilePath +defaultFileName = ".werewolf" + +readGame :: MonadIO m => m Game +readGame = liftIO . fmap read $ defaultFilePath >>= readFile + +writeGame :: MonadIO m => Game -> m () +writeGame game = liftIO $ defaultFilePath >>= flip writeFile (show game) + +deleteGame :: MonadIO m => m () +deleteGame = liftIO $ defaultFilePath >>= removeFile + +doesGameExist :: MonadIO m => m Bool +doesGameExist = liftIO $ defaultFilePath >>= doesFileExist diff --git a/app/Werewolf/Options.hs b/app/Werewolf/Options.hs --- a/app/Werewolf/Options.hs +++ b/app/Werewolf/Options.hs @@ -97,7 +97,7 @@ , command "help" $ info (helper <*> help_) (fullDesc <> progDesc "Help documents") , command "interpret" $ info (helper <*> interpret) (fullDesc <> progDesc "Interpret a command" <> noIntersperse) , command "pass" $ info (helper <*> pass) (fullDesc <> progDesc "Pass") - , command "ping" $ info (helper <*> ping) (fullDesc <> progDesc "Pings the status of the current game publicly") + , command "ping" $ info (helper <*> ping) (fullDesc <> progDesc "Ping the status of the current game publicly") , command "poison" $ info (helper <*> poison) (fullDesc <> progDesc "Poison a player") , command "protect" $ info (helper <*> protect) (fullDesc <> progDesc "Protect a player") , command "quit" $ info (helper <*> quit) (fullDesc <> progDesc "Quit the current game") diff --git a/src/Game/Werewolf.hs b/src/Game/Werewolf.hs --- a/src/Game/Werewolf.hs +++ b/src/Game/Werewolf.hs @@ -6,29 +6,26 @@ License : BSD3 Maintainer : public@hjwylde.com -Re-exports all of the public modules under /Game.Werewolf/. +Re-exports all of the public modules under /Game.Werewolf/. These are: -Where clashes are found between "Game.Werewolf.Game" and "Game.Werewolf.Engine", the -"Game.Werewolf.Game" functions are preferred. +* "Game.Werewolf.Command" +* "Game.Werewolf.Engine" +* "Game.Werewolf.Game" +* "Game.Werewolf.Player" +* "Game.Werewolf.Response" +* "Game.Werewolf.Role" -Likewise, where clashes are found between "Game.Werewolf.Player" and "Game.Werewolf.Role", the +N.B., where clashes are found between "Game.Werewolf.Player" and "Game.Werewolf.Role", the "Game.Werewolf.Player" functions are preferred. -} module Game.Werewolf ( - module Game.Werewolf.Command, - module Game.Werewolf.Engine, - module Game.Werewolf.Game, - module Game.Werewolf.Player, - module Game.Werewolf.Response, - module Game.Werewolf.Role + module Werewolf ) where -import Game.Werewolf.Command -import Game.Werewolf.Engine hiding (doesPlayerExist, isDefendersTurn, isGameOver, - isScapegoatsTurn, isSeersTurn, isVillagesTurn, isWerewolvesTurn, - isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn) -import Game.Werewolf.Game -import Game.Werewolf.Player -import Game.Werewolf.Response -import Game.Werewolf.Role hiding (name) +import Game.Werewolf.Command as Werewolf +import Game.Werewolf.Engine as Werewolf +import Game.Werewolf.Game as Werewolf +import Game.Werewolf.Player as Werewolf +import Game.Werewolf.Response as Werewolf +import Game.Werewolf.Role as Werewolf hiding (name) diff --git a/src/Game/Werewolf/Command.hs b/src/Game/Werewolf/Command.hs --- a/src/Game/Werewolf/Command.hs +++ b/src/Game/Werewolf/Command.hs @@ -12,7 +12,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Rank2Types #-} module Game.Werewolf.Command ( -- * Command @@ -24,7 +24,7 @@ statusCommand, voteDevourCommand, voteLynchCommand, ) where -import Control.Lens hiding (only) +import Control.Lens import Control.Monad.Except import Control.Monad.Extra import Control.Monad.State hiding (state) @@ -36,18 +36,13 @@ import Data.Text (Text) import qualified Data.Text as T -import Game.Werewolf.Engine -import Game.Werewolf.Internal.Game hiding (doesPlayerExist, getAllowedVoters, - getDevourEvent, getPendingVoters, getPlayerVote, - isDefendersTurn, isGameOver, isScapegoatsTurn, - isSeersTurn, isVillagesTurn, isWerewolvesTurn, - isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn, - killPlayer, setPlayerRole) -import Game.Werewolf.Internal.Player -import Game.Werewolf.Internal.Role hiding (name) -import qualified Game.Werewolf.Internal.Role as Role +import Game.Werewolf.Game hiding (doesPlayerExist, getPendingVoters, killPlayer) import Game.Werewolf.Messages +import Game.Werewolf.Player import Game.Werewolf.Response +import Game.Werewolf.Role hiding (name) +import qualified Game.Werewolf.Role as Role +import Game.Werewolf.Util data Command = Command { apply :: forall m . (MonadError [Message] m, MonadState Game m, MonadWriter [Message] m) => m () } @@ -56,13 +51,13 @@ validatePlayer callerName callerName unlessM (isPlayerWolfHound callerName) $ throwError [playerCannotDoThatMessage callerName] unlessM isWolfHoundsTurn $ throwError [playerCannotDoThatRightNowMessage callerName] - when (isNothing mRole) $ throwError [allegianceDoesNotExistMessage callerName allegianceName] + when (isNothing mAllegiance) $ throwError [allegianceDoesNotExistMessage callerName allegianceName] - setPlayerRole callerName (fromJust mRole) + allegianceChosen .= mAllegiance where - mRole = case T.toLower allegianceName of - "villagers" -> Just simpleVillagerRole - "werewolves" -> Just simpleWerewolfRole + mAllegiance = case T.toLower allegianceName of + "villagers" -> Just Villagers + "werewolves" -> Just Werewolves _ -> Nothing choosePlayerCommand :: Text -> Text -> Command @@ -92,15 +87,15 @@ circleCommand :: Text -> Bool -> Command circleCommand callerName includeDead = Command $ do - players' <- uses players (if includeDead then id else filterAlive) + players' <- toListOf (players . traverse . if includeDead then id else alive) <$> get tell [circleMessage callerName players'] healCommand :: Text -> Command healCommand callerName = Command $ do validateWitchsCommand callerName - whenM (use healUsed) $ throwError [playerHasAlreadyHealedMessage callerName] - whenM (isNothing <$> getDevourEvent) $ throwError [playerCannotDoThatRightNowMessage callerName] + whenM (use healUsed) $ throwError [playerHasAlreadyHealedMessage callerName] + whenM (hasn't (events . traverse . _DevourEvent) <$> get) $ throwError [playerCannotDoThatRightNowMessage callerName] heal .= True healUsed .= True @@ -118,57 +113,56 @@ pingCommand = Command $ use stage >>= \stage' -> case stage' of GameOver -> return () DefendersTurn -> do - defender <- findPlayerByRole_ defenderRole + defender <- findPlayerBy_ role defenderRole - tell [pingRoleMessage $ defender ^. role . Role.name] + tell [pingRoleMessage $ defenderRole ^. Role.name] tell [pingPlayerMessage $ defender ^. name] ScapegoatsTurn -> do - scapegoat <- findPlayerByRole_ scapegoatRole + scapegoat <- findPlayerBy_ role scapegoatRole - tell [pingRoleMessage $ scapegoat ^. role . Role.name] + tell [pingRoleMessage $ scapegoatRole ^. Role.name] tell [pingPlayerMessage $ scapegoat ^. name] SeersTurn -> do - seer <- findPlayerByRole_ seerRole + seer <- findPlayerBy_ role seerRole - tell [pingRoleMessage $ seer ^. role . Role.name] + tell [pingRoleMessage $ seerRole ^. Role.name] tell [pingPlayerMessage $ seer ^. name] Sunrise -> return () Sunset -> return () UrsussGrunt -> return () VillagesTurn -> do - allowedVoters <- getAllowedVoters - pendingVoters <- getPendingVoters + allowedVoterNames <- use allowedVoters + pendingVoterNames <- toListOf names <$> getPendingVoters - tell [waitingOnMessage Nothing $ allowedVoters `intersect` pendingVoters] - tell $ map (pingPlayerMessage . view name) (allowedVoters `intersect` pendingVoters) + tell [waitingOnMessage Nothing $ allowedVoterNames `intersect` pendingVoterNames] + tell $ map pingPlayerMessage (allowedVoterNames `intersect` pendingVoterNames) WerewolvesTurn -> do pendingVoters <- getPendingVoters tell [pingRoleMessage "Werewolves"] - tell $ map (pingPlayerMessage . view name) (filterWerewolves pendingVoters) + tell $ map pingPlayerMessage (pendingVoters ^.. werewolves . name) WildChildsTurn -> do - wildChild <- findPlayerByRole_ wildChildRole + wildChild <- findPlayerBy_ role wildChildRole - tell [pingRoleMessage $ wildChild ^. role . Role.name] + tell [pingRoleMessage $ wildChildRole ^. Role.name] tell [pingPlayerMessage $ wildChild ^. name] WitchsTurn -> do - witch <- findPlayerByRole_ witchRole + witch <- findPlayerBy_ role witchRole - tell [pingRoleMessage $ witch ^. role . Role.name] + tell [pingRoleMessage $ witchRole ^. Role.name] tell [pingPlayerMessage $ witch ^. name] WolfHoundsTurn -> do - wolfHound <- findPlayerByRole_ wolfHoundRole + wolfHound <- findPlayerBy_ role wolfHoundRole - tell [pingRoleMessage $ wolfHound ^. role . Role.name] + tell [pingRoleMessage $ wolfHoundRole ^. Role.name] tell [pingPlayerMessage $ wolfHound ^. name] poisonCommand :: Text -> Text -> Command poisonCommand callerName targetName = Command $ do validateWitchsCommand callerName - whenM (use poisonUsed) $ throwError [playerHasAlreadyPoisonedMessage callerName] + whenM (use poisonUsed) $ throwError [playerHasAlreadyPoisonedMessage callerName] validatePlayer callerName targetName - whenJustM getDevourEvent $ \(DevourEvent targetName') -> - when (targetName == targetName') $ throwError [playerCannotDoThatMessage callerName] + whenM (has (events . traverse . _DevourEvent . only targetName) <$> get) $ throwError [playerCannotDoThatMessage callerName] poison .= Just targetName poisonUsed .= True @@ -176,11 +170,10 @@ protectCommand :: Text -> Text -> Command protectCommand callerName targetName = Command $ do validatePlayer callerName callerName - unlessM (isPlayerDefender callerName) $ throwError [playerCannotDoThatMessage callerName] - unlessM isDefendersTurn $ throwError [playerCannotDoThatRightNowMessage callerName] + unlessM (isPlayerDefender callerName) $ throwError [playerCannotDoThatMessage callerName] + unlessM isDefendersTurn $ throwError [playerCannotDoThatRightNowMessage callerName] validatePlayer callerName targetName - whenJustM (use priorProtect) $ \priorName -> - when (targetName == priorName) $ throwError [playerCannotProtectSamePlayerTwiceInARowMessage callerName] + whenM (has (priorProtect . traverse . only targetName) <$> get) $ throwError [playerCannotProtectSamePlayerTwiceInARowMessage callerName] priorProtect .= Just targetName protect .= Just targetName @@ -189,24 +182,26 @@ quitCommand callerName = Command $ do validatePlayer callerName callerName - caller <- findPlayerByName_ callerName + caller <- findPlayerBy_ name callerName killPlayer callerName tell [playerQuitMessage caller] - passes %= delete callerName - when (isAngel caller) $ setPlayerRole callerName simpleVillagerRole - when (isDefender caller) $ do + passes %= delete callerName + votes %= Map.delete callerName + + when (is angel caller) $ setPlayerAllegiance callerName Villagers + when (is defender caller) $ do protect .= Nothing priorProtect .= Nothing - when (isSeer caller) $ see .= Nothing - when (isWildChild caller) $ roleModel .= Nothing - when (isWitch caller) $ do + when (is seer caller) $ see .= Nothing + when (is wildChild caller) $ roleModel .= Nothing + when (is witch caller) $ do heal .= False healUsed .= False poison .= Nothing poisonUsed .= False - votes %= Map.delete callerName + when (is wolfHound caller) $ allegianceChosen .= Nothing seeCommand :: Text -> Text -> Command seeCommand callerName targetName = Command $ do @@ -223,23 +218,18 @@ Sunrise -> return () Sunset -> return () VillagesTurn -> do - game <- get - allowedVoters <- getAllowedVoters - pendingVoters <- getPendingVoters + allowedVoterNames <- use allowedVoters + pendingVoterNames <- toListOf names <$> getPendingVoters - tell $ standardStatusMessages stage' (game ^. players) - tell [waitingOnMessage (Just callerName) (allowedVoters `intersect` pendingVoters)] + tell . standardStatusMessages stage' =<< use players + tell [waitingOnMessage (Just callerName) (allowedVoterNames `intersect` pendingVoterNames)] WerewolvesTurn -> do - game <- get - pendingVoters <- filterWerewolves <$> getPendingVoters + pendingVoterNames <- toListOf (werewolves . name) <$> getPendingVoters - tell $ standardStatusMessages stage' (game ^. players) + tell . standardStatusMessages stage' =<< use players whenM (doesPlayerExist callerName &&^ isPlayerWerewolf callerName) $ - tell [waitingOnMessage (Just callerName) pendingVoters] - _ -> do - game <- get - - tell $ standardStatusMessages stage' (game ^. players) + tell [waitingOnMessage (Just callerName) pendingVoterNames] + _ -> tell . standardStatusMessages stage' =<< use players where standardStatusMessages stage players = currentStageMessages callerName stage ++ [playersInGameMessage callerName players] @@ -247,25 +237,26 @@ voteDevourCommand :: Text -> Text -> Command voteDevourCommand callerName targetName = Command $ do validatePlayer callerName callerName - unlessM (isPlayerWerewolf callerName) $ throwError [playerCannotDoThatMessage callerName] - unlessM isWerewolvesTurn $ throwError [playerCannotDoThatRightNowMessage callerName] - whenJustM (getPlayerVote callerName) . const $ throwError [playerHasAlreadyVotedMessage callerName] + unlessM (isPlayerWerewolf callerName) $ throwError [playerCannotDoThatMessage callerName] + unlessM isWerewolvesTurn $ throwError [playerCannotDoThatRightNowMessage callerName] + whenM (isJust <$> getPlayerVote callerName) $ throwError [playerHasAlreadyVotedMessage callerName] validatePlayer callerName targetName - whenM (isPlayerWerewolf targetName) $ throwError [playerCannotDevourAnotherWerewolfMessage callerName] + whenM (isPlayerWerewolf targetName) $ throwError [playerCannotDevourAnotherWerewolfMessage callerName] votes %= Map.insert callerName targetName - aliveWerewolfNames <- uses players $ map (view name) . filterAlive . filterWerewolves + aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get - tell $ map (\werewolfName -> playerMadeDevourVoteMessage werewolfName callerName targetName) (aliveWerewolfNames \\ [callerName]) + tell [playerMadeDevourVoteMessage werewolfName callerName targetName | werewolfName <- aliveWerewolfNames \\ [callerName]] voteLynchCommand :: Text -> Text -> Command voteLynchCommand callerName targetName = Command $ do validatePlayer callerName callerName - whenM (uses allowedVoters (callerName `notElem`)) $ throwError [playerCannotDoThatMessage callerName] - unlessM isVillagesTurn $ throwError [playerCannotDoThatRightNowMessage callerName] - whenJustM (getPlayerVote callerName) . const $ throwError [playerHasAlreadyVotedMessage callerName] + whenM (uses allowedVoters (callerName `notElem`)) $ throwError [playerCannotDoThatMessage callerName] + unlessM isVillagesTurn $ throwError [playerCannotDoThatRightNowMessage callerName] + whenM (isJust <$> getPlayerVote callerName) $ throwError [playerHasAlreadyVotedMessage callerName] validatePlayer callerName targetName + whenM (use villageIdiotRevealed &&^ isPlayerVillageIdiot targetName) $ throwError [playerCannotLynchVillageIdiotMessage callerName] votes %= Map.insert callerName targetName 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 @@ -18,74 +18,33 @@ checkStage, checkGameOver, -- * Game - - -- ** Manipulations - startGame, killPlayer, setPlayerRole, - - -- ** Searches - findPlayerByName_, findPlayerByRole_, - - -- ** Queries - isGameOver, isDefendersTurn, isScapegoatsTurn, isSeersTurn, isVillagesTurn, isWerewolvesTurn, - isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn, - getPlayerVote, getAllowedVoters, getPendingVoters, getVoteResult, - - -- ** Reading and writing - defaultFilePath, writeGame, readGame, deleteGame, doesGameExist, - - -- * Event - - -- ** Queries - getDevourEvent, - - -- * Player - - -- ** Manipulations - createPlayers, - - -- ** Queries - doesPlayerExist, - isPlayerDefender, isPlayerScapegoat, isPlayerSeer, isPlayerVillageIdiot, isPlayerWildChild, - isPlayerWitch, isPlayerWolfHound, - isPlayerWerewolf, - isPlayerAlive, isPlayerDead, - - -- * Role - padRoles, + startGame, ) where -import Control.Lens hiding (cons, snoc) +import Control.Lens hiding (cons, isn't) import Control.Monad.Except import Control.Monad.Extra -import Control.Monad.Random import Control.Monad.State hiding (state) import Control.Monad.Writer import Data.List.Extra import qualified Data.Map as Map +import Data.Maybe import Data.Text (Text) import qualified Data.Text as T -import Game.Werewolf.Internal.Game hiding (doesPlayerExist, getAllowedVoters, - getDevourEvent, getPassers, getPendingVoters, - getPlayerVote, getVoteResult, isDefendersTurn, - isGameOver, isScapegoatsTurn, isSeersTurn, - isVillagesTurn, isWerewolvesTurn, isWildChildsTurn, - isWitchsTurn, isWolfHoundsTurn, killPlayer, - setPlayerAllegiance, setPlayerRole) -import qualified Game.Werewolf.Internal.Game as Game -import Game.Werewolf.Internal.Player -import Game.Werewolf.Internal.Role hiding (name) -import qualified Game.Werewolf.Internal.Role as Role +import Game.Werewolf.Game hiding (doesPlayerExist, getAllowedVoters, getPendingVoters, + getVoteResult, hasAngelWon, hasAnyoneWon, hasVillagersWon, + hasWerewolvesWon, killPlayer) import Game.Werewolf.Messages +import Game.Werewolf.Player import Game.Werewolf.Response +import Game.Werewolf.Role hiding (name) +import qualified Game.Werewolf.Role as Role +import Game.Werewolf.Util import Prelude hiding (round) -import System.Directory -import System.FilePath -import System.Random.Shuffle - checkStage :: (MonadState Game m, MonadWriter [Message] m) => m () checkStage = do game <- get @@ -99,9 +58,9 @@ GameOver -> return () DefendersTurn -> do - whenM (isDead <$> findPlayerByRole_ defenderRole) advanceStage + whenM (has (players . defenders . dead) <$> get) advanceStage - whenJustM (use protect) $ const advanceStage + whenM (isJust <$> use protect) advanceStage ScapegoatsTurn -> unlessM (use scapegoatBlamed) $ do allowedVoters' <- use allowedVoters @@ -110,12 +69,11 @@ advanceStage SeersTurn -> do - seer <- findPlayerByRole_ seerRole - - when (isDead seer) advanceStage + whenM (has (players . seers . dead) <$> get) advanceStage whenJustM (use see) $ \targetName -> do - target <- findPlayerByName_ targetName + seer <- findPlayerBy_ role seerRole + target <- findPlayerBy_ name targetName tell [playerSeenMessage (seer ^. name) target] @@ -124,19 +82,19 @@ Sunrise -> do round += 1 - whenJustM (findAlivePlayerByRole angelRole) $ \angel -> do + whenJustM (preuse $ players . angels . alive) $ \angel -> do tell [angelJoinedVillagersMessage] - setPlayerRole (angel ^. name) simpleVillagerRole + setPlayerAllegiance (angel ^. name) Villagers advanceStage Sunset -> do whenJustM (use roleModel) $ \roleModelsName -> do - wildChild <- findPlayerByRole_ wildChildRole + wildChild <- findPlayerBy_ role wildChildRole - whenM (isPlayerDead roleModelsName &&^ return (isVillager wildChild)) $ do - aliveWerewolfNames <- uses players (map (view name) . filterAlive . filterWerewolves) + whenM (isPlayerDead roleModelsName &&^ return (is villager wildChild)) $ do + aliveWerewolfNames <- toListOf (players . werewolves . alive . name) <$> get setPlayerAllegiance (wildChild ^. name) Werewolves @@ -146,10 +104,10 @@ advanceStage UrsussGrunt -> do - bearTamer <- findPlayerByRole_ bearTamerRole - players' <- cons bearTamer <$> gets (getAdjacentAlivePlayers $ bearTamer ^. name) + bearTamer <- findPlayerBy_ role bearTamerRole + players' <- getAdjacentAlivePlayers (bearTamer ^. name) - when (any isWerewolf players') $ tell [ursusGruntsMessage] + when (has werewolves players') $ tell [ursusGruntsMessage] advanceStage @@ -158,14 +116,14 @@ getVoteResult >>= lynchVotees - allowedVoters' <- ifM (use villageIdiotRevealed) - (uses players (filter $ not . isVillageIdiot)) + allVoters <- ifM (use villageIdiotRevealed) + (uses players $ filter (isn't villageIdiot)) (use players) - allowedVoters .= map (view name) (filterAlive allowedVoters') + allowedVoters .= allVoters ^.. traverse . alive . name advanceStage - WerewolvesTurn -> whenM (null . filterWerewolves <$> getPendingVoters) $ do + WerewolvesTurn -> whenM (none (is werewolf) <$> getPendingVoters) $ do getVoteResult >>= devourVotees protect .= Nothing @@ -173,38 +131,46 @@ advanceStage WildChildsTurn -> do - whenM (isDead <$> findPlayerByRole_ wildChildRole) advanceStage + whenM (has (players . wildChildren . dead) <$> get) advanceStage - whenJustM (use roleModel) $ const advanceStage + whenM (isJust <$> use roleModel) advanceStage WitchsTurn -> do - whenM (isDead <$> findPlayerByRole_ witchRole) advanceStage + whenM (has (players . witches . dead) <$> get) advanceStage whenJustM (use poison) $ \targetName -> do events %= (++ [PoisonEvent targetName]) poison .= Nothing whenM (use heal) $ do - devourEvent <- uses events $ \events -> head [event | event@(DevourEvent _) <- events] + devourEvent <- fromJust <$> preuse (events . traverse . filtered (is _DevourEvent)) events %= cons NoDevourEvent . delete devourEvent heal .= False whenM (use healUsed &&^ use poisonUsed) advanceStage - whenM (any isWitch <$> getPassers) advanceStage + whenM (has witches <$> getPassers) advanceStage - WolfHoundsTurn -> unlessM (uses players (any isWolfHound . filterAlive)) advanceStage + WolfHoundsTurn -> do + whenM (has (players . wolfHounds . dead) <$> get) advanceStage + whenJustM (use allegianceChosen) $ \allegiance -> do + wolfHound <- findPlayerBy_ role wolfHoundRole + + setPlayerAllegiance (wolfHound ^. name) allegiance + + advanceStage + lynchVotees :: (MonadState Game m, MonadWriter [Message] m) => [Player] -> m () lynchVotees [votee] - | isVillageIdiot votee = do + | is villageIdiot votee = do villageIdiotRevealed .= True tell [villageIdiotLynchedMessage $ votee ^. name] | otherwise = do killPlayer (votee ^. name) tell [playerLynchedMessage votee] -lynchVotees _ = findAlivePlayerByRole scapegoatRole >>= \mScapegoat -> case mScapegoat of +lynchVotees _ = preuse (players . scapegoats . alive) >>= \mScapegoat -> case mScapegoat of Just scapegoat -> do scapegoatBlamed .= True @@ -220,13 +186,10 @@ advanceStage :: (MonadState Game m, MonadWriter [Message] m) => m () advanceStage = do - game <- get - stage' <- use stage - aliveAllegiances <- uses players (nub . map (view $ role . allegiance) . filterAlive) - - let nextStage = if length aliveAllegiances <= 1 || any isAngel (filterDead $ game ^. players) - then GameOver - else head $ filter (stageAvailable game) (drop1 $ dropWhile (stage' /=) stageCycle) + game <- get + nextStage <- ifM hasAnyoneWon + (return GameOver) + (return . head $ filter (stageAvailable game) (drop1 $ dropWhile (game ^. stage /=) stageCycle)) stage .= nextStage passes .= [] @@ -244,32 +207,25 @@ mapM_ applyEvent available eventAvailable :: MonadState Game m => Event -> m Bool -eventAvailable (DevourEvent _) = gets isSunrise -eventAvailable NoDevourEvent = gets isSunrise -eventAvailable (PoisonEvent _) = gets isSunrise +eventAvailable (DevourEvent _) = isSunrise +eventAvailable NoDevourEvent = isSunrise +eventAvailable (PoisonEvent _) = isSunrise applyEvent :: (MonadState Game m, MonadWriter [Message] m) => Event -> m () applyEvent (DevourEvent targetName) = do - player <- findPlayerByName_ targetName + target <- findPlayerBy_ name targetName killPlayer targetName - tell [playerDevouredMessage player] + tell [playerDevouredMessage target] applyEvent NoDevourEvent = tell [noPlayerDevouredMessage] -applyEvent (PoisonEvent name) = do - player <- findPlayerByName_ name +applyEvent (PoisonEvent targetName) = do + target <- findPlayerBy_ name targetName - killPlayer name - tell [playerPoisonedMessage player] + killPlayer targetName + tell [playerPoisonedMessage target] checkGameOver :: (MonadState Game m, MonadWriter [Message] m) => m () -checkGameOver = do - aliveAllegiances <- uses players (nub . map (view $ role . allegiance) . filterAlive) - deadPlayers <- uses players filterDead - - when (length aliveAllegiances <= 1 || any isAngel deadPlayers) $ do - stage .= GameOver - - tell . gameOverMessages =<< get +checkGameOver = whenM hasAnyoneWon $ stage .= GameOver >> get >>= tell . gameOverMessages startGame :: (MonadError [Message] m, MonadWriter [Message] m) => Text -> [Player] -> m Game startGame callerName players = do @@ -277,7 +233,7 @@ when (length players < 7) $ throwError [privateMessage callerName "Must have at least 7 players."] when (length players > 24) $ throwError [privateMessage callerName "Cannot have more than 24 players."] forM_ restrictedRoles $ \role' -> - when (length (filter ((role' ==) . view role) players) > 1) $ + when (length (players ^.. traverse . filteredBy role role') > 1) $ throwError [privateMessage callerName $ T.concat ["Cannot have more than 1 ", role' ^. Role.name, "."]] let game = newGame players @@ -286,138 +242,4 @@ return game where - playerNames = map (view name) players - -killPlayer :: MonadState Game m => Text -> m () -killPlayer name = modify $ Game.killPlayer name - -setPlayerRole :: MonadState Game m => Text -> Role -> m () -setPlayerRole name role = modify $ Game.setPlayerRole name role - -setPlayerAllegiance :: MonadState Game m => Text -> Allegiance -> m () -setPlayerAllegiance name allegiance = modify $ Game.setPlayerAllegiance name allegiance - -findPlayerByName_ :: MonadState Game m => Text -> m Player -findPlayerByName_ name = uses players $ findByName_ name - -findPlayerByRole_ :: MonadState Game m => Role -> m Player -findPlayerByRole_ role = uses players $ findByRole_ role - -findAlivePlayerByRole :: MonadState Game m => Role -> m (Maybe Player) -findAlivePlayerByRole role = uses players $ findByRole role . filterAlive - -isDefendersTurn :: MonadState Game m => m Bool -isDefendersTurn = gets Game.isDefendersTurn - -isScapegoatsTurn :: MonadState Game m => m Bool -isScapegoatsTurn = gets Game.isScapegoatsTurn - -isSeersTurn :: MonadState Game m => m Bool -isSeersTurn = gets Game.isSeersTurn - -isVillagesTurn :: MonadState Game m => m Bool -isVillagesTurn = gets Game.isVillagesTurn - -isWerewolvesTurn :: MonadState Game m => m Bool -isWerewolvesTurn = gets Game.isWerewolvesTurn - -isWildChildsTurn :: MonadState Game m => m Bool -isWildChildsTurn = gets Game.isWildChildsTurn - -isWitchsTurn :: MonadState Game m => m Bool -isWitchsTurn = gets Game.isWitchsTurn - -isWolfHoundsTurn :: MonadState Game m => m Bool -isWolfHoundsTurn = gets Game.isWolfHoundsTurn - -isGameOver :: MonadState Game m => m Bool -isGameOver = gets Game.isGameOver - -getPassers :: MonadState Game m => m [Player] -getPassers = gets Game.getPassers - -getPlayerVote :: MonadState Game m => Text -> m (Maybe Text) -getPlayerVote playerName = gets $ Game.getPlayerVote playerName - -getAllowedVoters :: MonadState Game m => m [Player] -getAllowedVoters = gets Game.getAllowedVoters - -getPendingVoters :: MonadState Game m => m [Player] -getPendingVoters = gets Game.getPendingVoters - -getVoteResult :: MonadState Game m => m [Player] -getVoteResult = gets Game.getVoteResult - -defaultFilePath :: MonadIO m => m FilePath -defaultFilePath = ( defaultFileName) <$> liftIO getHomeDirectory - -defaultFileName :: FilePath -defaultFileName = ".werewolf" - -readGame :: MonadIO m => m Game -readGame = liftIO . fmap read $ defaultFilePath >>= readFile - -writeGame :: MonadIO m => Game -> m () -writeGame game = liftIO $ defaultFilePath >>= flip writeFile (show game) - -deleteGame :: MonadIO m => m () -deleteGame = liftIO $ defaultFilePath >>= removeFile - -doesGameExist :: MonadIO m => m Bool -doesGameExist = liftIO $ defaultFilePath >>= doesFileExist - -getDevourEvent :: MonadState Game m => m (Maybe Event) -getDevourEvent = gets Game.getDevourEvent - -createPlayers :: MonadIO m => [Text] -> [Role] -> m [Player] -createPlayers playerNames roles = liftIO $ zipWith newPlayer playerNames <$> evalRandIO (shuffleM roles) - -doesPlayerExist :: MonadState Game m => Text -> m Bool -doesPlayerExist name = gets $ Game.doesPlayerExist name - -isPlayerDefender :: MonadState Game m => Text -> m Bool -isPlayerDefender name = isDefender <$> findPlayerByName_ name - -isPlayerScapegoat :: MonadState Game m => Text -> m Bool -isPlayerScapegoat name = isScapegoat <$> findPlayerByName_ name - -isPlayerSeer :: MonadState Game m => Text -> m Bool -isPlayerSeer name = isSeer <$> findPlayerByName_ name - -isPlayerVillageIdiot :: MonadState Game m => Text -> m Bool -isPlayerVillageIdiot name = isVillageIdiot <$> findPlayerByName_ name - -isPlayerWildChild :: MonadState Game m => Text -> m Bool -isPlayerWildChild name = isWildChild <$> findPlayerByName_ name - -isPlayerWitch :: MonadState Game m => Text -> m Bool -isPlayerWitch name = isWitch <$> findPlayerByName_ name - -isPlayerWolfHound :: MonadState Game m => Text -> m Bool -isPlayerWolfHound name = isWolfHound <$> findPlayerByName_ name - -isPlayerWerewolf :: MonadState Game m => Text -> m Bool -isPlayerWerewolf name = isWerewolf <$> findPlayerByName_ name - -isPlayerAlive :: MonadState Game m => Text -> m Bool -isPlayerAlive name = isAlive <$> findPlayerByName_ name - -isPlayerDead :: MonadState Game m => Text -> m Bool -isPlayerDead name = isDead <$> findPlayerByName_ name - -padRoles :: [Role] -> Int -> [Role] -padRoles roles n = roles ++ simpleVillagerRoles ++ simpleWerewolfRoles - where - goal = 2 - m = max (n - length roles) 0 - startingBalance = sum (map (view balance) roles) - simpleWerewolfBalance = simpleWerewolfRole ^. balance - - -- Little magic here to calculate how many Werewolves and Villagers we want. - -- Essentially we get a 1:4 ratio of Werewolves to Villagers. - simpleWerewolvesCount = (goal - m - startingBalance) `div` (simpleWerewolfBalance - 1) + 1 - simpleVillagersCount = m - simpleWerewolvesCount - - -- N.B., if roles is quite unbalanced then one list will be empty. - simpleVillagerRoles = replicate simpleVillagersCount simpleVillagerRole - simpleWerewolfRoles = replicate simpleWerewolvesCount simpleWerewolfRole + playerNames = players ^.. names 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 @@ -1,30 +1,260 @@ {-| Module : Game.Werewolf.Game -Description : Game data structure. - +Description : Game data structure with functions for manipulating and querying the game state. Copyright : (c) Henry J. Wylde, 2016 License : BSD3 Maintainer : public@hjwylde.com -Game functions are defined in "Game.Werewolf.Internal.Game". This module just re-exports the -functions relevant to the public interface. +A game is not quite as simple as players! Roughly speaking though, this engine is /stateful/. The +game state only changes when a /command/ is issued (see "Game.Werewolf.Command"). Thus, this module +defines the 'Game' data structure and any fields required to keep track of the current state. + +It also has a few additional functions for manipulating and querying the game state. -} +{-# LANGUAGE TemplateHaskell #-} + module Game.Werewolf.Game ( -- * Game - Game, stage, round, players, events, passes, allowedVoters, heal, healUsed, poison, poisonUsed, - priorProtect, protect, roleModel, scapegoatBlamed, see, villageIdiotRevealed, votes, + Game, + stage, round, players, events, passes, allegianceChosen, allowedVoters, heal, healUsed, poison, + poisonUsed, priorProtect, protect, roleModel, scapegoatBlamed, see, villageIdiotRevealed, votes, Stage(..), + _DefendersTurn, _GameOver, _ScapegoatsTurn, _SeersTurn, _Sunrise, _Sunset, _UrsussGrunt, + _VillagesTurn, _WerewolvesTurn, _WildChildsTurn, _WitchsTurn, _WolfHoundsTurn, + allStages, + stageCycle, stageAvailable, + Event(..), + _DevourEvent, _NoDevourEvent, _PoisonEvent, + newGame, + + -- ** Manipulations + killPlayer, + + -- ** Searches + getAllowedVoters, getPendingVoters, getVoteResult, + -- ** Queries - isDefendersTurn, isGameOver, isScapegoatsTurn, isSeersTurn, isSunrise, isSunset, isVillagesTurn, - isWerewolvesTurn, isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn, + isFirstRound, doesPlayerExist, + hasAnyoneWon, hasAngelWon, hasVillagersWon, hasWerewolvesWon, ) where -import Game.Werewolf.Internal.Game +import Control.Lens hiding (isn't) +import Data.List.Extra +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe +import Data.Text (Text) + +import Game.Werewolf.Player +import Game.Werewolf.Role hiding (name) + import Prelude hiding (round) + +-- | There are a few key pieces of information that a game always needs to hold. These are: +-- +-- * the 'stage', +-- * the 'round' number, +-- * the 'players' and +-- * the 'events'. +-- +-- Any further fields on the game are specific to one or more roles (and their respective turns!). +-- Some of the additional fields are reset each round (e.g., the Seer's 'see') while others are +-- kept around for the whole game (e.g., the Wild-child's 'roleModel'). +-- +-- In order to advance a game's 'state', a 'Game.Werewolf.Command.Command' from a user needs to be +-- received. Afterwards the following steps should be performed: +-- +-- 1. 'Game.Werewolf.Command.apply' the 'Game.Werewolf.Command.Command'. +-- 2. run 'Game.Werewolf.Engine.checkStage'. +-- 3. run 'Game.Werewolf.Engine.checkGameOver'. +-- +-- 'Game.Werewolf.Engine.checkStage' will perform any additional checks and manipulations to the +-- game state before advancing the game's 'stage'. It also runs any relevant 'events'. +-- 'Game.Werewolf.Engine.checkGameOver' will check to see if any of the win conditions are met and +-- if so, advance the game's 'stage' to 'GameOver'. +data Game = Game + { _stage :: Stage + , _round :: Int + , _players :: [Player] + , _events :: [Event] + , _allegianceChosen :: Maybe Allegiance -- ^ Wolf-hound + , _allowedVoters :: [Text] -- ^ Scapegoat + , _heal :: Bool -- ^ Witch + , _healUsed :: Bool -- ^ Witch + , _passes :: [Text] -- ^ Witch + , _poison :: Maybe Text -- ^ Witch + , _poisonUsed :: Bool -- ^ Witch + , _priorProtect :: Maybe Text -- ^ Defender + , _protect :: Maybe Text -- ^ Defender + , _roleModel :: Maybe Text -- ^ Wild-child + , _scapegoatBlamed :: Bool -- ^ Scapegoat + , _see :: Maybe Text -- ^ Seer + , _villageIdiotRevealed :: Bool -- ^ Village Idiot + , _votes :: Map Text Text -- ^ Villagers and Werewolves + } deriving (Eq, Read, Show) + +-- | Most of these are fairly self-sufficient (the turn stages). 'Sunrise' and 'Sunset' are provided +-- as meaningful breaks between the day and night as, for example, a 'VillagesTurn' may not always +-- be available (curse that retched Scapegoat). +-- +-- 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 = GameOver | DefendersTurn | ScapegoatsTurn | SeersTurn | Sunrise | Sunset + | UrsussGrunt | VillagesTurn | WerewolvesTurn | WildChildsTurn | WitchsTurn + | WolfHoundsTurn + deriving (Eq, Read, Show) + +-- | Events occur /after/ a 'Stage' is advanced. This is automatically handled in +-- 'Game.Werewolf.Engine.checkStage', while an event's specific behaviour is defined by +-- 'Game.Werewolf.Engine.eventAvailable' and 'Game.Werewolf.Engine.applyEvent'. +-- +-- For the most part events are used to allow something to happen on a 'Stage' different to when +-- 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 + | PoisonEvent Text -- ^ Witch + deriving (Eq, Read, Show) + +makeLenses ''Game + +makePrisms ''Stage + +makePrisms ''Event + +-- | All of the 'Stage's in the order that they should occur. +allStages :: [Stage] +allStages = + [ VillagesTurn + , ScapegoatsTurn + , Sunset + , WolfHoundsTurn + , SeersTurn + , WildChildsTurn + , DefendersTurn + , WerewolvesTurn + , WitchsTurn + , Sunrise + , UrsussGrunt + , GameOver + ] + +-- | An infinite cycle of all 'Stage's in the order that they should occur. +stageCycle :: [Stage] +stageCycle = cycle allStages + +-- | Checks whether the stage is available for the given 'Game'. Most often this just involves +-- checking if there is an applicable role alive, but sometimes it is more complex. +-- +-- One of the most 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 _ GameOver = False +stageAvailable game ScapegoatsTurn = game ^. scapegoatBlamed +stageAvailable game SeersTurn = has (players . seers . alive) game +stageAvailable _ Sunrise = True +stageAvailable _ Sunset = True +stageAvailable game UrsussGrunt = has (players . bearTamers . alive) game +stageAvailable game VillagesTurn = + (has (players . angels . alive) game || not (isFirstRound game)) + && any (is alive) (getAllowedVoters game) +stageAvailable game WerewolvesTurn = has (players . werewolves . alive) game +stageAvailable game WildChildsTurn = + has (players . wildChildren . alive) game + && isNothing (game ^. roleModel) +stageAvailable game WitchsTurn = + has (players . witches . alive) game + && (not (game ^. healUsed) || not (game ^. poisonUsed)) +stageAvailable game WolfHoundsTurn = has (players . wolfHounds . alive) game + +-- | Creates a new 'Game' with the given players. No validations are performed here, those are left +-- to 'Game.Werewolf.Engine.startGame'. +newGame :: [Player] -> Game +newGame players = game & stage .~ head (filter (stageAvailable game) stageCycle) + where + game = Game + { _stage = Sunset + , _round = 0 + , _players = players + , _events = [] + , _passes = [] + , _allegianceChosen = Nothing + , _allowedVoters = players ^.. names + , _heal = False + , _healUsed = False + , _poison = Nothing + , _poisonUsed = False + , _priorProtect = Nothing + , _protect = Nothing + , _roleModel = Nothing + , _scapegoatBlamed = False + , _see = Nothing + , _villageIdiotRevealed = False + , _votes = Map.empty + } + +-- | Kills the given player! This function should be used carefully as it doesn't clear any state +-- that the player's role may use. If you're after just removing a player from a game for a test, +-- try using a 'Game.Werewolf.Command.quitCommand' instead. +killPlayer :: Text -> Game -> Game +killPlayer name' = players . traverse . filteredBy name name' . state .~ Dead + +-- | Gets all the 'allowedVoters' in a game (which is names only) and maps them to their player. +getAllowedVoters :: Game -> [Player] +getAllowedVoters game = + map (\name' -> game ^?! players . traverse . filteredBy name name') (game ^. allowedVoters) + +-- | Gets all 'Alive' players that have yet to vote. +getPendingVoters :: Game -> [Player] +getPendingVoters game = + game ^.. players . traverse . alive . filtered ((`Map.notMember` votes') . view name) + where + votes' = game ^. votes + +-- | Gets all players that had /the/ highest vote count. This could be 1 or more players depending +-- on whether the votes were in conflict. +getVoteResult :: Game -> [Player] +getVoteResult game = map (\name' -> game ^?! players . traverse . filteredBy name name') result + where + votees = Map.elems $ game ^. votes + result = last $ groupSortOn (length . (`elemIndices` votees)) (nub votees) + +-- | @'isFirstRound' game = game ^. 'round' == 0@ +isFirstRound :: Game -> Bool +isFirstRound game = game ^. round == 0 + +-- | Queries whether the player is in the game. +doesPlayerExist :: Text -> Game -> Bool +doesPlayerExist name = has $ players . names . only name + +-- | Queries whether anyone has won. +hasAnyoneWon :: Game -> Bool +hasAnyoneWon game = any ($ game) [hasAngelWon, hasVillagersWon, hasWerewolvesWon] + +-- | Queries whether the Angel has won. The Angel wins if they manage to get themselves killed on +-- the first round. +-- +-- N.B., we check that the Angel isn't a 'villager' as the Angel's role is altered if they don't +-- win. +hasAngelWon :: Game -> Bool +hasAngelWon game = has (players . angels) game && is dead angel && isn't villager angel + where + angel = game ^?! players . angels + +-- | Queries whether the 'Villagers' have won. The 'Villagers' win if they are the only players +-- surviving. +hasVillagersWon :: Game -> Bool +hasVillagersWon = allOf (players . traverse . alive) (is villager) + +-- | Queries whether the 'Werewolves' have won. The 'Werewolves' win if they are the only players +-- surviving. +hasWerewolvesWon :: Game -> Bool +hasWerewolvesWon = allOf (players . traverse . alive) (is werewolf) diff --git a/src/Game/Werewolf/Internal/Game.hs b/src/Game/Werewolf/Internal/Game.hs deleted file mode 100644 --- a/src/Game/Werewolf/Internal/Game.hs +++ /dev/null @@ -1,309 +0,0 @@ -{-| -Module : Game.Werewolf.Internal.Game -Description : Game data structure with functions for manipulating and querying the game state. -Copyright : (c) Henry J. Wylde, 2016 -License : BSD3 -Maintainer : public@hjwylde.com - -A game is not quite as simple as players! Roughly speaking though, this engine is /stateful/. The -game state only changes when a /command/ is issued (see "Game.Werewolf.Command"). Thus, this module -defines the game data structure and any fields required to keep track of the current state. - -It also has a few additional functions for manipulating the game state. --} - -{-# LANGUAGE TemplateHaskell #-} - -module Game.Werewolf.Internal.Game ( - -- * Game - Game, stage, round, players, events, passes, allowedVoters, heal, healUsed, poison, poisonUsed, - priorProtect, protect, roleModel, scapegoatBlamed, see, villageIdiotRevealed, votes, - - Stage(..), - allStages, - stageCycle, stageAvailable, - - Event(..), - - newGame, - - -- ** Manipulations - killPlayer, setPlayerRole, setPlayerAllegiance, - - -- ** Searches - getAdjacentAlivePlayers, getDevourEvent, getPassers, getPlayerVote, getAllowedVoters, - getPendingVoters, getVoteResult, - - -- ** Queries - isDefendersTurn, isGameOver, isScapegoatsTurn, isSeersTurn, isSunrise, isSunset, isVillagesTurn, - isWerewolvesTurn, isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn, - isFirstRound, - doesPlayerExist, -) where - -import Control.Lens - -import Data.List.Extra -import Data.Map (Map) -import qualified Data.Map as Map -import Data.Maybe -import Data.Text (Text) - -import Game.Werewolf.Internal.Player -import Game.Werewolf.Internal.Role hiding (name) - -import Prelude hiding (round) - --- | There are a few key pieces of information that a game always needs to hold. These are: --- --- * the @stage@, --- * the @round@ number, --- * the @players@ and --- * the @events@. --- --- Any further fields on the game are specific to one or more roles (and their respective turns!). --- Some of the additional fields are reset each round (e.g., the Seer's @see@) while others are --- kept around for the whole game (e.g., the Wild-child's @roleModel@). --- --- In order to advance a game's state, a 'Game.Werewolf.Command.Command' from a user needs to be received. Afterwards --- the following steps should be performed: --- --- 1. 'Game.Werewolf.Command.apply' the 'Game.Werewolf.Command.Command'. --- 2. run 'Game.Werewolf.Engine.checkStage'. --- 3. run 'Game.Werewolf.Engine.checkGameOver'. --- --- 'Game.Werewolf.Engine.checkStage' will perform any additional checks and manipulations to the --- game state before advancing the game's @stage@. It also runs any relevant @events@. --- 'Game.Werewolf.Engine.checkGameOver' will check to see if any of the win conditions are met and --- if so, advance the game's @stage@ to 'GameOver'. -data Game = Game - { _stage :: Stage - , _round :: Int - , _players :: [Player] - , _events :: [Event] - , _allowedVoters :: [Text] -- ^ Scapegoat - , _heal :: Bool -- ^ Witch - , _healUsed :: Bool -- ^ Witch - , _passes :: [Text] -- ^ Witch - , _poison :: Maybe Text -- ^ Witch - , _poisonUsed :: Bool -- ^ Witch - , _priorProtect :: Maybe Text -- ^ Defender - , _protect :: Maybe Text -- ^ Defender - , _roleModel :: Maybe Text -- ^ Wild-child - , _scapegoatBlamed :: Bool -- ^ Scapegoat - , _see :: Maybe Text -- ^ Seer - , _villageIdiotRevealed :: Bool -- ^ Village Idiot - , _votes :: Map Text Text -- ^ Villagers and Werewolves - } deriving (Eq, Read, Show) - --- | Most of these are fairly self-sufficient (the turn stages). 'Sunrise' and 'Sunset' are provided --- as meaningful breaks between the day and night as, for example, a 'VillagesTurn' may not always --- be available (curse that retched Scapegoat). --- --- 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 = GameOver | DefendersTurn | ScapegoatsTurn | SeersTurn | Sunrise | Sunset - | UrsussGrunt | VillagesTurn | WerewolvesTurn | WildChildsTurn | WitchsTurn - | WolfHoundsTurn - deriving (Eq, Read, Show) - --- | Events occur /after/ a stage is advanced. This is automatically handled in --- 'Game.Werewolf.Engine.checkStage', while an event's specific behaviour is defined by --- 'Game.Werewolf.Engine.eventAvailable' and 'Game.Werewolf.Engine.applyEvent'. --- --- For the most part events are used to allow something to happen on a stage different to when it --- was triggered. E.g., the devour event 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 - | PoisonEvent Text -- ^ Witch - deriving (Eq, Read, Show) - -makeLenses ''Game - --- | All of the stages in the order that they should occur. -allStages :: [Stage] -allStages = - [ VillagesTurn - , ScapegoatsTurn - , Sunset - , SeersTurn - , WildChildsTurn - , DefendersTurn - , WolfHoundsTurn - , WerewolvesTurn - , WitchsTurn - , Sunrise - , UrsussGrunt - , GameOver - ] - --- | An infinite cycle of all stages in the order that they should occur. -stageCycle :: [Stage] -stageCycle = cycle allStages - --- | Checks whether the stage is available for the given game. Most often this just involves --- checking if there is an applicable role alive, but sometimes it is more complex. --- --- One of the most 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 = any isDefender (filterAlive $ game ^. players) -stageAvailable _ GameOver = False -stageAvailable game ScapegoatsTurn = game ^. scapegoatBlamed -stageAvailable game SeersTurn = any isSeer (filterAlive $ game ^. players) -stageAvailable _ Sunrise = True -stageAvailable _ Sunset = True -stageAvailable game UrsussGrunt = any isBearTamer (filterAlive $ game ^. players) -stageAvailable game VillagesTurn = - (any isAngel (filterAlive $ game ^. players) - || not (isFirstRound game)) - && any isAlive (getAllowedVoters game) -stageAvailable game WerewolvesTurn = any isWerewolf (filterAlive $ game ^. players) -stageAvailable game WildChildsTurn = - any isWildChild (filterAlive $ game ^. players) - && isNothing (game ^. roleModel) -stageAvailable game WitchsTurn = - any isWitch (filterAlive $ game ^. players) - && (not (game ^. healUsed) || not (game ^. poisonUsed)) -stageAvailable game WolfHoundsTurn = any isWolfHound (filterAlive $ game ^. players) - --- | Creates a new game with the given players. No validations are performed here, those are left to --- 'Game.Werewolf.Engine.startGame'. -newGame :: [Player] -> Game -newGame players = game & stage .~ head (filter (stageAvailable game) stageCycle) - where - game = Game - { _stage = Sunset - , _round = 0 - , _players = players - , _events = [] - , _passes = [] - , _allowedVoters = map (view name) players - , _heal = False - , _healUsed = False - , _poison = Nothing - , _poisonUsed = False - , _priorProtect = Nothing - , _protect = Nothing - , _roleModel = Nothing - , _scapegoatBlamed = False - , _see = Nothing - , _villageIdiotRevealed = False - , _votes = Map.empty - } - --- | Kills the given player! This function should be used carefully as it doesn't clear any state --- that the player's role may use. If you're after just removing a player from a game for a test, --- try using a 'Game.Werewolf.Command.quitCommand' instead. -killPlayer :: Text -> Game -> Game -killPlayer name' game = game & players %~ map (\player -> if player ^. name == name' then player & state .~ Dead else player) - --- | Fudges the player's role by completely setting it to something new. This function is useful for --- roles such as the Angel where they become something else given some trigger. -setPlayerRole :: Text -> Role -> Game -> Game -setPlayerRole name' role' game = game & players %~ map (\player -> if player ^. name == name' then player & role .~ role' else player) - --- | Fudges the player's allegiance. This function is useful for roles such as the Wild-child where --- they align themselves differently given some trigger. -setPlayerAllegiance :: Text -> Allegiance -> Game -> Game -setPlayerAllegiance name' allegiance' game = game & players %~ map (\player -> if player ^. name == name' then player & role . allegiance .~ allegiance' else player) - -getAdjacentAlivePlayers :: Text -> Game -> [Player] -getAdjacentAlivePlayers name' game = adjacentAlivePlayers - where - players' = filterAlive $ game ^. players - index = fromJust $ findIndex ((name' ==) . view name) players' - - adjacentAlivePlayers - | index == 0 = last players' : take 2 players' - | otherwise = take 3 $ drop (index - 1) (cycle players') - --- | Gets all the @passes@ in a game (which is names only) and maps them to their player. -getPassers :: Game -> [Player] -getPassers game = map (`findByName_` players') passes' - where - players' = game ^. players - passes' = game ^. passes - --- | Gets a player's vote. -getPlayerVote :: Text -> Game -> Maybe Text -getPlayerVote playerName game = game ^. votes . at playerName - --- | Gets all the @allowedVoters@ in a game (which is names only) and maps them to their player. -getAllowedVoters :: Game -> [Player] -getAllowedVoters game = map (`findByName_` players') (game ^. allowedVoters) - where - players' = game ^. players - --- | Gets all alive players that have yet to vote. -getPendingVoters :: Game -> [Player] -getPendingVoters game = filter (flip Map.notMember votes' . view name) alivePlayers - where - votes' = game ^. votes - alivePlayers = filterAlive $ game ^. players - --- | Gets all players that had /the/ highest vote count. This could be 1 or more players depending --- on whether the votes were in conflict. -getVoteResult :: Game -> [Player] -getVoteResult game = map (`findByName_` players') result - where - players' = game ^. players - votees = Map.elems $ game ^. votes - result = last $ groupSortOn (\votee -> length $ elemIndices votee votees) (nub votees) - --- | Gets the devour event if it exists. -getDevourEvent :: Game -> Maybe Event -getDevourEvent game = listToMaybe [event | event@(DevourEvent _) <- game ^. events] - --- | @isDefendersTurn game = game ^. stage == DefendersTurn@ -isDefendersTurn :: Game -> Bool -isDefendersTurn game = game ^. stage == DefendersTurn - --- | @isGameOver game = game ^. stage == GameOver@ -isGameOver :: Game -> Bool -isGameOver game = game ^. stage == GameOver - --- | @isScapegoatsTurn game = game ^. stage == ScapegoatsTurn@ -isScapegoatsTurn :: Game -> Bool -isScapegoatsTurn game = game ^. stage == ScapegoatsTurn - --- | @isSeersTurn game = game ^. stage == SeersTurn@ -isSeersTurn :: Game -> Bool -isSeersTurn game = game ^. stage == SeersTurn - --- | @isSunrise game = game ^. stage == Sunrise@ -isSunrise :: Game -> Bool -isSunrise game = game ^. stage == Sunrise - --- | @isSunset game = game ^. stage == Sunset@ -isSunset :: Game -> Bool -isSunset game = game ^. stage == Sunset - --- | @isVillagesTurn game = game ^. stage == VillagesTurn@ -isVillagesTurn :: Game -> Bool -isVillagesTurn game = game ^. stage == VillagesTurn - --- | @isWerewolvesTurn game = game ^. stage == WerewolvesTurn@ -isWerewolvesTurn :: Game -> Bool -isWerewolvesTurn game = game ^. stage == WerewolvesTurn - --- | @isWildChildsTurn game = game ^. stage == WildChildsTurn@ -isWildChildsTurn :: Game -> Bool -isWildChildsTurn game = game ^. stage == WildChildsTurn - --- | @isWitchsTurn game = game ^. stage == WitchsTurn@ -isWitchsTurn :: Game -> Bool -isWitchsTurn game = game ^. stage == WitchsTurn - --- | @isWolfHoundsTurn game = game ^. stage == WolfHoundsTurn@ -isWolfHoundsTurn :: Game -> Bool -isWolfHoundsTurn game = game ^. stage == WolfHoundsTurn - --- | @isFirstRound game = game ^. round == 0@ -isFirstRound :: Game -> Bool -isFirstRound game = game ^. round == 0 - --- | Queries whether the player is in the game. -doesPlayerExist :: Text -> Game -> Bool -doesPlayerExist name = isJust . findByName name . view players diff --git a/src/Game/Werewolf/Internal/Player.hs b/src/Game/Werewolf/Internal/Player.hs deleted file mode 100644 --- a/src/Game/Werewolf/Internal/Player.hs +++ /dev/null @@ -1,180 +0,0 @@ -{-| -Module : Game.Werewolf.Internal.Player -Description : Simplistic player data structure with functions for searching, filtering and querying - lists of players. -Copyright : (c) Henry J. Wylde, 2016 -License : BSD3 -Maintainer : public@hjwylde.com - -Players are quite simple in themselves. They have a @name@, @role@ and @state@. Any complex -behaviour is handled in "Game.Werewolf.Command" and "Game.Werewolf.Engine". This module provides -utility functions for searching, filtering and querying lists of players based on these 3 -attributes. --} - -{-# LANGUAGE TemplateHaskell #-} - -module Game.Werewolf.Internal.Player ( - -- * Player - Player, name, role, state, - - State(..), - - newPlayer, - - -- ** Searches - findByName, findByName_, findByRole, findByRole_, - - -- ** Filters - filterByRole, - filterWerewolves, - filterAlive, filterDead, - - -- ** Queries - isAngel, isBearTamer, isDefender, isScapegoat, isSeer, isSimpleVillager, isSimpleWerewolf, - isVillageIdiot, isVillagerVillager, isWildChild, isWitch, isWolfHound, - isVillager, isWerewolf, - isAlive, isDead, -) where - -import Control.Lens - -import Data.Function -import Data.List -import Data.Maybe -import Data.Text (Text) - -import Game.Werewolf.Internal.Role hiding (name) - --- | A player has a @name@, @role@ and @state@. Any stateful information needed for a player's role --- is held on the 'Game' itself. --- --- N.B., player equality is defined on just the @name@ as a player's @role@ may change throughout --- the game. -data Player = Player - { _name :: Text - , _role :: Role - , _state :: State - } deriving (Read, Show) - --- | Surprise surprise, players may be dead or alive. -data State = Alive | Dead - deriving (Eq, Read, Show) - -makeLenses ''Player - -instance Eq Player where - (==) = (==) `on` view name - --- | Creates a new 'Alive' player. -newPlayer :: Text -> Role -> Player -newPlayer name role = Player name role Alive - --- | Attempts to find the first player in the list with the given name. -findByName :: Text -> [Player] -> Maybe Player -findByName name' = find ((name' ==) . view name) - --- | Finds the first player in the list with the given name. --- --- @findByName_ name = fromJust . findByName name@ -findByName_ :: Text -> [Player] -> Player -findByName_ name = fromJust . findByName name - --- | Attempts to find the first player in the list with the given role. -findByRole :: Role -> [Player] -> Maybe Player -findByRole role' = find ((role' ==) . view role) - --- | Finds the first player in the list with the given role. --- --- @findByRole_ role = fromJust . findByRole role@ -findByRole_ :: Role -> [Player] -> Player -findByRole_ role = fromJust . findByRole role - --- | Filters players by role. -filterByRole :: Role -> [Player] -> [Player] -filterByRole role' = filter ((role' ==) . view role) - --- | Filters players by allegiance, not role. --- If you're after filtering by role, try @filterByRole simpleWerewolfRole@. --- --- @filterWerewolves = filter isWerewolf@ -filterWerewolves :: [Player] -> [Player] -filterWerewolves = filter isWerewolf - --- | @filterAlive = filter isAlive@ -filterAlive :: [Player] -> [Player] -filterAlive = filter isAlive - --- | @filterDead = filter isDead@ -filterDead :: [Player] -> [Player] -filterDead = filter isDead - --- | @isAngel player = player ^. role == 'angelRole'@ -isAngel :: Player -> Bool -isAngel player = player ^. role == angelRole - --- | @isBearTamer player = player ^. role == 'bearTamerRole'@ -isBearTamer :: Player -> Bool -isBearTamer player = player ^. role == bearTamerRole - --- | @isDefender player = player ^. role == 'defenderRole'@ -isDefender :: Player -> Bool -isDefender player = player ^. role == defenderRole - --- | @isScapegoat player = player ^. role == 'scapegoatRole'@ -isScapegoat :: Player -> Bool -isScapegoat player = player ^. role == scapegoatRole - --- | @isSeer player = player ^. role == 'seerRole'@ -isSeer :: Player -> Bool -isSeer player = player ^. role == seerRole - --- | @isSimpleVillager player = player ^. role == 'simpleVillagerRole'@ -isSimpleVillager :: Player -> Bool -isSimpleVillager player = player ^. role == simpleVillagerRole - --- | @isSimpleWerewolf player = player ^. role == 'simpleWerewolfRole'@ -isSimpleWerewolf :: Player -> Bool -isSimpleWerewolf player = player ^. role == simpleWerewolfRole - --- | @isVillageIdiot player = player ^. role == 'villageIdiotRole'@ -isVillageIdiot :: Player -> Bool -isVillageIdiot player = player ^. role == villageIdiotRole - --- | @isVillagerVillager player = player ^. role == 'villagerVillagerRole'@ -isVillagerVillager :: Player -> Bool -isVillagerVillager player = player ^. role == villagerVillagerRole - --- | @isWildChild player = player ^. role == 'wildChildRole'@ -isWildChild :: Player -> Bool -isWildChild player = player ^. role == wildChildRole - --- | @isWitch player = player ^. role == 'witchRole'@ -isWitch :: Player -> Bool -isWitch player = player ^. role == witchRole - --- | @isWolfHound player = player ^. role == 'wolfHoundRole'@ -isWolfHound :: Player -> Bool -isWolfHound player = player ^. role == wolfHoundRole - --- | Queries a player's allegiance, not role. --- If you're after querying their role, try 'isSimpleVillager'. --- --- @isVillager player = player ^. role . allegiance == Villagers@ -isVillager :: Player -> Bool -isVillager player = player ^. role . allegiance == Villagers - --- | Queries a player's allegiance, not role. --- If you're after querying their role, try 'isSimpleWerewolf'. --- --- @isWerewolf player = player ^. role . allegiance == Werewolves@ -isWerewolf :: Player -> Bool -isWerewolf player = player ^. role . allegiance == Werewolves - --- | @isAlive player = player ^. state == Alive@ -isAlive :: Player -> Bool -isAlive player = player ^. state == Alive - --- | @isDead player = player ^. state == Dead@ -isDead :: Player -> Bool -isDead player = player ^. state == Dead diff --git a/src/Game/Werewolf/Internal/Role.hs b/src/Game/Werewolf/Internal/Role.hs deleted file mode 100644 --- a/src/Game/Werewolf/Internal/Role.hs +++ /dev/null @@ -1,380 +0,0 @@ -{-| -Module : Game.Werewolf.Internal.Role -Description : Simplistic role data structure and instances. - -Copyright : (c) Henry J. Wylde, 2016 -License : BSD3 -Maintainer : public@hjwylde.com - -The roles are split into four categories: - -* The Ambiguous. -* The Loners. -* The Villagers. -* The Werewolves. --} - -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} - -module Game.Werewolf.Internal.Role ( - -- * Role - Role, name, allegiance, balance, description, advice, - - Allegiance(..), - - -- ** Instances - allRoles, restrictedRoles, - allAllegiances, - - -- *** The Ambiguous - -- | The Ambiguous may change allegiance during the game. - wildChildRole, wolfHoundRole, - - -- *** The Loners - -- | The Loners have their own win condition. - angelRole, - - -- *** The Villagers - -- | The Villagers must lynch all of the Werewolves. - bearTamerRole, defenderRole, scapegoatRole, seerRole, simpleVillagerRole, villageIdiotRole, - villagerVillagerRole, witchRole, - - -- *** The Werewolves - -- | The Werewolves must devour all of the Villagers. - simpleWerewolfRole, -) where - -import Control.Lens - -import Data.Function -import Data.List -import Data.Text (Text) -import qualified Data.Text as T - -import Prelude hiding (all) - --- | Role definitions require only a few pieces of information. --- Most of the game logic behind a role is implemented in "Game.Werewolf.Command" and --- "Game.Werewolf.Engine". --- --- The @balance@ attribute on a role indicates the allegiance it favours. For example, a Simple --- Werewolf has a balance of -4 while the Seer has a balance of 2. A balance of 0 means it favours --- neither allegiance. --- --- N.B., role equality is defined on just the @name@ as a role's @allegiance@ may change --- throughout the game. -data Role = Role - { _name :: Text - , _allegiance :: Allegiance - , _balance :: Int - , _description :: Text - , _advice :: Text - } deriving (Read, Show) - --- | The Loner allegiances are seldom used, rather they are present for correctness. -data Allegiance = Angel | Villagers | Werewolves - deriving (Eq, Read, Show) - -makeLenses ''Role - -instance Eq Role where - (==) = (==) `on` view name - --- | A list containing all the roles defined in this file. -allRoles :: [Role] -allRoles = - [ angelRole - , bearTamerRole - , defenderRole - , scapegoatRole - , seerRole - , simpleVillagerRole - , villageIdiotRole - , simpleWerewolfRole - , villagerVillagerRole - , wildChildRole - , witchRole - , wolfHoundRole - ] - --- | A list containing roles that are restricted to a single instance per game. --- --- @restrictedRoles = allRoles \\\\ [simpleVillagerRole, simpleWerewolfRole]@ -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] - --- | /Abandoned in the woods by his parents at a young age, he was raised by wolves. As soon as he/ --- /learned how to walk on all fours, the Wild-child began to wander around Miller's Hollow. One/ --- /day, fascinated by an inhabitant of the village who was walking upright with grace and/ --- /presence, he made them his secret role model. He then decided to integrate himself into the/ --- /community of Miller's Hollow and entered, worried, in the village. The community was moved by/ --- /his frailty, adopted him, and welcomed him in their fold. What will become of him: honest/ --- /Villager or terrible Werewolf? For all of his life, the heart of the Wild-child will swing/ --- /between these two alternatives. May his model confirm him in his newfound humanity./ --- --- On the first night, the Wild-child may choose a player to become his role model. If during the --- game the chosen player is eliminated, the Wild-child becomes a Werewolf. He will then wake up --- the next night with his peers and will devour with them each night until the end of the game. --- However for as long as the Wild-child's role model is alive, he remains a Villager. -wildChildRole :: Role -wildChildRole = Role - { _name = "Wild-child" - , _allegiance = Villagers - , _balance = -1 - , _description = T.unwords - [ "Abandoned in the woods by his parents at a young age, he was raised by wolves." - , "As soon as he learned how to walk on all fours," - , "the Wild-child began to wander around Miller's Hollow." - , "One day, fascinated by an inhabitant of the village who was walking upright" - , "with grace and presence, he made them his secret role model." - , "He then decided to integrate himself into the community of Miller's Hollow and entered," - , "worried, in the village." - , "The community was moved by his frailty, adopted him, and welcomed him in their fold." - , "What will become of him: honest Villager or terrible Werewolf?" - , "For all of his life," - , "the heart of the Wild-child will swing between these two alternatives." - , "May his model confirm him in his newfound humanity." - ] - , _advice = T.unwords - [ "Nothing is keeping you from taking part in the elimination of your role model," - , "if you so wish..." - ] - } - --- | /All dogs know in the depths of their soul that their ancestors were wolves and that it's/ --- /mankind who has kept them in the state of childishness and fear, the faithful and generous/ --- /companions. In any case, only the Wolf-hound can decide if he'll obey his human and civilized/ --- /master or if he'll listen to the call of wild nature buried within him./ --- --- On the first night, he chooses if he wants to be a Simple Villager or Werewolf. The choice is --- final. -wolfHoundRole :: Role -wolfHoundRole = Role - { _name = "Wolf-hound" - , _allegiance = Villagers - , _balance = -1 - , _description = T.unwords - [ "All dogs know in the depths of their soul that their ancestors were wolves" - , "and that it's mankind who has kept them in the state of childishness and fear," - , "the faithful and generous companions." - , "In any case, only the Wolf-hound can decide if he'll obey his human and civilized master" - , "or if he'll listen to the call of wild nature buried within him." - ] - , _advice = - "The choice of being a Simple Villager or Werewolf is final, so decide carefully!" - } - --- | /The muddy life of a village infested with evil creatures repulses him; he wishes to believe/ --- /he's the victim of a terrible nightmare, in order to finally wake up in his comfortable bed./ --- --- When the Angel is in play, the game always begins with the village's debate followed by an --- elimination vote, and then the first night. --- --- The Angel wins if he manages to get eliminated on the first round (day or night). --- If he fails, then he becomes a Simple Villager for the rest of the game. -angelRole :: Role -angelRole = Role - { _name = "Angel" - , _allegiance = Angel - , _balance = 0 - , _description = T.unwords - [ "The muddy life of a village infested with evil creatures repulses him;" - , "he wishes to believe he's the victim of a terrible nightmare," - , "in order to finally wake up in his comfortable bed." - ] - , _advice = T.unwords - [ "It's going to take all your guile and wits to con the village into eliminating you." - , "Pretending to be a Werewolf is one tactic, but if it doesn't work then you may have just" - , "dug yourself a hole for the rest of the game..." - ] - } - --- | /Ah! How sweet it is, in my memory, the sound of chains slipping onto the cobblestones of the/ --- /"Three Road" plaza, accompanied by the grunting of Ursus. Ah! How long ago it was that Titan,/ --- /the Bear Tamer, would lead his companion in a ballet so gravious that we'd cry every summer/ --- /in Miller's Hollow. Ursus even had the oh-so-previous ability to detect lycanthropes hidden/ --- /near him./ --- --- Each morning, right after the revelation of any possible nocturnal victims, if at least one --- Werewolf is or ends up directly next to the Bear Tamer, then Ursus grunts to indicate danger to --- all of the other players. -bearTamerRole :: Role -bearTamerRole = Role - { _name = "Bear Tamer" - , _allegiance = Villagers - , _balance = 2 - , _description = T.unwords - [ "Ah! How sweet it is, in my memory, the sound of chains slipping onto the cobblestones" - , "of the \"Three Road\" plaza, accompanied by the grunting of Ursus." - , "Ah! How long ago it was that Titan, the Bear Tamer, would lead his companion in a ballet" - , "so gravious that we'd cry every summer in Miller's Hollow." - , "Ursus even had the oh-so-previous ability to detect lycanthropes hidden near him." - ] - , _advice = - "Aren't you lucky to have a companion with a strong nose. Just don't let him wander off!" - } - --- | /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. -defenderRole :: Role -defenderRole = Role - { _name = "Defender" - , _allegiance = Villagers - , _balance = 2 - , _description = - "This character can save the Villagers from the bite of the Werewolves." - , _advice = T.unwords - [ "Be careful: you can protect yourself," - , "but you're not allowed to protect the same player two nights in a row." - ] - } - --- | /It's sad to say, but in Miller's Hollow, when something doesn't go right it's always him who/ --- /unjustly suffers the consequences./ --- --- If the village's vote ends in a tie, it's the Scapegoat who is eliminated instead of no-one. --- --- In this event, the Scapegoat has one last task to complete: he must choose whom is permitted to --- vote or not on the next day. -scapegoatRole :: Role -scapegoatRole = Role - { _name = "Scapegoat" - , _allegiance = Villagers - , _balance = 1 - , _description = T.unwords - [ "It's sad to say, but in Miller's Hollow, when something doesn't go right" - , "it's always him who unjustly suffers the consequences." - ] - , _advice = T.unwords - [ "Cross your fingers that the votes don't end up tied." - , "If you do so happen to be that unlucky," - , "then be wary of whom you allow to vote on the next day." - , "If you choose only one player and the Werewolves devour them in the night," - , "then there will be no village vote." - ] - } - --- | /A fortunate teller by other names, with the ability to see into fellow townsfolk and/ --- /determine their allegiance./ --- --- Each night the Seer sees the allegiance of a player of her choice. -seerRole :: Role -seerRole = Role - { _name = "Seer" - , _allegiance = Villagers - , _balance = 2 - , _description = T.unwords - [ "A fortunate teller by other names, with the ability to see into fellow" - , "townsfolk and determine their allegiance." - ] - , _advice = T.unwords - [ "You should help the other Villagers," - , "but try to remain discreet so as to not arouse suspicion from any of the Werewolves." - ] - } - --- | /A simple, ordinary townsperson in every way. Their only weapons are the ability to analyze/ --- /behaviour to identify Werewolves, and the strength of their conviction to prevent the/ --- /execution of the innocents like themselves./ -simpleVillagerRole :: Role -simpleVillagerRole = Role - { _name = "Simple Villager" - , _allegiance = Villagers - , _balance = 1 - , _description = T.unwords - [ "A simple, ordinary townsperson in every way." - , "Their only weapons are the ability to analyze behaviour to identify Werewolves," - , "and the strength of their conviction to prevent" - , "the execution of the innocents like themselves." - ] - , _advice = - "Bluffing can be a good technique, but you had better be convincing about what you say." - } - --- | /What is a village without an idiot? He does pretty much nothing important, but he's so/ --- /charming that no one would want to hurt him./ --- --- If the village votes against the Village Idiot, his identity is revealed. At that moment the --- Villagers understand their mistake and immediately let him be. --- --- The Village Idiot continues to play but may no longer vote, as what would the vote of an idiot --- be worth? -villageIdiotRole :: Role -villageIdiotRole = Role - { _name = "Village Idiot" - , _allegiance = Villagers - , _balance = 0 - , _description = T.unwords - [ "What is a village without an idiot?" - , "He does pretty much nothing important," - , "but he's so charming that no one would want to hurt him." - ] - , _advice = - "Hah! As if advice would do you any good..." - } - --- | /This person has a soul as clear and transparent as the water from a mountain stream. They/ --- /will deserve the attentive ear of their peers and will make their word decisive in crucial/ --- /moments./ --- --- When the game begins, the village is told the identity of the Villager-Villager, thus ensuring --- certainty that its owner is truly an innocent Villager. -villagerVillagerRole :: Role -villagerVillagerRole = Role - { _name = "Villager-Villager" - , _allegiance = Villagers - , _balance = 2 - , _description = T.unwords - [ "This person has a soul as clear and transparent as the water from a mountain stream." - , "They will deserve the attentive ear of their peers" - , "and will make their word decisive in crucial moments." - ] - , _advice = "You'll make friends quickly, but be wary about whom you trust." - } - --- | /She knows how to brew two extremely powerful potions: a healing potion, to resurrect the/ --- /player devoured by the Werewolves, and a poison potion, used at night to eliminate a player./ --- --- The Witch is called after the Werewolves. She is allowed to use both potions in the same night --- and is also allowed to heal herself. -witchRole :: Role -witchRole = Role - { _name = "Witch" - , _allegiance = Villagers - , _balance = 3 - , _description = T.unwords - [ "She knows how to brew two extremely powerful potions:" - , "a healing potion, to resurrect the player devoured by the Werewolves," - , "and a poison potion, used at night to eliminate a player." - ] - , _advice = T.unwords - [ "Each potion may only be used once per game," - , "but there are no restrictions on using both of your potions in the same night." - ] - } - --- | /Each night they devour a Villager. During the day they try to hide their nocturnal identity/ --- /to avoid mob justice./ --- --- A Werewolf may never devour another Werewolf. -simpleWerewolfRole :: Role -simpleWerewolfRole = Role - { _name = "Simple Werewolf" - , _allegiance = Werewolves - , _balance = -4 - , _description = T.unwords - [ "Each night they devour a Villager." - , "During the day they try to hide their nocturnal identity to avoid mob justice." - ] - , _advice = - "Voting to lynch your partner can be a good way to deflect suspicion from yourself." - } diff --git a/src/Game/Werewolf/Messages.hs b/src/Game/Werewolf/Messages.hs --- a/src/Game/Werewolf/Messages.hs +++ b/src/Game/Werewolf/Messages.hs @@ -59,7 +59,7 @@ scapegoatLynchedMessage, villageIdiotLynchedMessage, -- ** Error messages - playerHasAlreadyVotedMessage, + playerHasAlreadyVotedMessage, playerCannotLynchVillageIdiotMessage, -- * Werewolves' turn messages playerMadeDevourVoteMessage, playerDevouredMessage, noPlayerDevouredMessage, @@ -89,37 +89,34 @@ import Control.Lens import Data.List.Extra -import Data.Maybe import Data.Text (Text) import qualified Data.Text as T -import Game.Werewolf.Internal.Game -import Game.Werewolf.Internal.Player -import Game.Werewolf.Internal.Role hiding (name) -import qualified Game.Werewolf.Internal.Role as Role +import Game.Werewolf.Game +import Game.Werewolf.Player import Game.Werewolf.Response +import Game.Werewolf.Role hiding (name) +import qualified Game.Werewolf.Role as Role newGameMessages :: Game -> [Message] newGameMessages game = concat - [ [newPlayersInGameMessage players'] - , [rolesInGameMessage $ map (view role) players'] + [ [newPlayersInGameMessage $ players' ^.. names] + , [rolesInGameMessage $ players' ^.. roles] , map newPlayerMessage players' , villagerVillagerMessages , stageMessages game ] where players' = game ^. players - villagerVillagerMessages = case findByRole villagerVillagerRole players' of + villagerVillagerMessages = case players' ^? villagerVillagers of Just villagerVillager -> [villagerVillagerMessage $ villagerVillager ^. name] _ -> [] -newPlayersInGameMessage :: [Player] -> Message -newPlayersInGameMessage players = publicMessage $ T.concat +newPlayersInGameMessage :: [Text] -> Message +newPlayersInGameMessage playerNames = publicMessage $ T.concat [ "A new game of werewolf is starting with " , T.intercalate ", " playerNames, "!" ] - where - playerNames = map (view name) players newPlayerMessage :: Player -> Message newPlayerMessage player = privateMessage (player ^. name) $ T.intercalate "\n" @@ -157,12 +154,12 @@ WolfHoundsTurn -> wolfHoundsTurnMessages wolfHoundsName where players' = game ^. players - defendersName = findByRole_ defenderRole players' ^. name - scapegoatsName = findByRole_ scapegoatRole players' ^. name - seersName = findByRole_ seerRole players' ^. name - aliveWerewolfNames = map (view name) . filterAlive $ filterWerewolves players' - wildChildsName = findByRole_ wildChildRole players' ^. name - wolfHoundsName = findByRole_ wolfHoundRole players' ^. name + defendersName = players' ^?! defenders . name + scapegoatsName = players' ^?! scapegoats . name + seersName = players' ^?! seers . name + aliveWerewolfNames = players' ^.. werewolves . alive . name + wildChildsName = players' ^?! wildChildren . name + wolfHoundsName = players' ^?! wolfHounds . name defendersTurnMessages :: Text -> [Message] defendersTurnMessages to = @@ -189,13 +186,13 @@ nightFallsMessage = publicMessage "Night falls, the village is asleep." firstVillagesTurnMessages :: [Message] -firstVillagesTurnMessages = - publicMessage (T.unwords - [ "Alas, again I regrettably yield advice: an angelic menace walks among you." - , "Do not cast your votes lightly," - , "for he will relish in this opportunity to be free from his terrible nightmare." - ]) - : villagesTurnMessages +firstVillagesTurnMessages = angelInPlayMessage : villagesTurnMessages + where + angelInPlayMessage = publicMessage $ T.unwords + [ "Alas, again I regrettably yield advice: an angelic menace walks among you." + , "Do not cast your votes lightly," + , "for he will relish in this opportunity to be free from his terrible nightmare." + ] villagesTurnMessages :: [Message] villagesTurnMessages = @@ -205,14 +202,15 @@ firstWerewolvesTurnMessages :: [Text] -> [Message] firstWerewolvesTurnMessages tos = - map (\to -> privateMessage to $ packMessage to) tos + [privateMessage to $ packMessage to | length tos > 1, to <- tos] ++ werewolvesTurnMessages tos where packMessage werewolfName = T.unwords [ "You feel restless, like an old curse is keeping you from sleep." , "It seems you're not the only one..." , packNames werewolfName - , "are also emerging from their homes." + , if length tos == 2 then "is" else "are", "also emerging from their" + , if length tos == 2 then "home." else "homes." ] packNames werewolfName = T.intercalate ", " (tos \\ [werewolfName]) @@ -236,22 +234,22 @@ , [passMessage] ] where - witchsName = findByRole_ witchRole (game ^. players) ^. name + witchsName = game ^?! players . witches . name wakeUpMessage = publicMessage "The Witch wakes up." passMessage = privateMessage witchsName "Type `pass` to end your turn." - devourMessages = case getDevourEvent game of - Just (DevourEvent targetName) -> + devourMessages = case game ^? events . traverse . _DevourEvent of + Just targetName -> [ privateMessage witchsName $ T.unwords ["You see", targetName, "sprawled outside bleeding uncontrollably."] ] - _ -> [] + _ -> [] healMessages | not (game ^. healUsed) - && isJust (getDevourEvent game) = [privateMessage witchsName "Would you like to `heal` them?"] - | otherwise = [] + && has (events . traverse . _DevourEvent) game = [privateMessage witchsName "Would you like to `heal` them?"] + | otherwise = [] poisonMessages - | not (game ^. poisonUsed) = [privateMessage witchsName "Would you like to `poison` anyone?"] - | otherwise = [] + | not (game ^. poisonUsed) = [privateMessage witchsName "Would you like to `poison` anyone?"] + | otherwise = [] wolfHoundsTurnMessages :: Text -> [Message] wolfHoundsTurnMessages to = @@ -261,27 +259,36 @@ gameOverMessages :: Game -> [Message] gameOverMessages game - | any isAngel (filterDead $ game ^. players) = - concat - [ [publicMessage "You should have heeded my warning, for now the Angel has been set free!"] - , [publicMessage "The game is over! The Angel has won."] - , [playerWonMessage $ angel ^. name] - , map (playerLostMessage . view name) (players' \\ [angel]) - ] - | length aliveAllegiances == 1 = do - let allegiance' = head aliveAllegiances - - concat - [ [publicMessage $ T.unwords ["The game is over! The", T.pack $ show allegiance', "have won."]] - , map (playerWonMessage . view name) (filter ((allegiance' ==) . view (role . allegiance)) players') - , map (playerLostMessage . view name) (filter ((allegiance' /=) . view (role . allegiance)) players') - ] - | otherwise = publicMessage "The game is over! Everyone died...":map (playerLostMessage . view name) players' + | hasAngelWon game = concat + [ [publicMessage "You should have heeded my warning, for now the Angel has been set free!"] + , [publicMessage "The game is over! The Angel has won."] + , playerWonMessages + , playerLostMessages + ] + | hasVillagersWon game = concat + [ [publicMessage "The game is over! The Villagers have won."] + , playerWonMessages + , playerLostMessages + ] + | hasWerewolvesWon game = concat + [ [publicMessage "The game is over! The Werewolves have won."] + , playerWonMessages + , playerLostMessages + ] + | otherwise = undefined where - players' = game ^. players - angel = findByRole_ angelRole players' - aliveAllegiances = nub $ map (view $ role . allegiance) (filterAlive players') + winningAllegiance + | hasAngelWon game = Angel + | hasVillagersWon game = Villagers + | hasWerewolvesWon game = Werewolves + | otherwise = undefined + winningPlayerNames = game ^.. players . traverse . filteredBy (role . allegiance) winningAllegiance . name + losingPlayerNames = game ^.. players . names \\ winningPlayerNames + + playerWonMessages = map playerWonMessage winningPlayerNames + playerLostMessages = map playerLostMessage losingPlayerNames + playerWonMessage :: Text -> Message playerWonMessage to = privateMessage to "Victory! You won!" @@ -289,16 +296,16 @@ playerLostMessage to = privateMessage to "Feck, you lost this time round..." playerQuitMessage :: Player -> Message -playerQuitMessage player = - publicMessage $ T.unwords [player ^. name, "the", player ^. role . Role.name, "has quit!"] +playerQuitMessage player = publicMessage $ T.unwords [playerName, "the", playerRole, "has quit!"] + where + playerName = player ^. name + playerRole = player ^. role . Role.name gameIsOverMessage :: Text -> Message gameIsOverMessage to = privateMessage to "The game is over!" playerDoesNotExistMessage :: Text -> Text -> Message -playerDoesNotExistMessage to name = privateMessage to $ T.unwords - [ "Player", name, "does not exist." - ] +playerDoesNotExistMessage to name = privateMessage to $ T.unwords ["Player", name, "does not exist."] playerCannotDoThatMessage :: Text -> Message playerCannotDoThatMessage to = privateMessage to "You cannot do that!" @@ -318,7 +325,7 @@ , T.intercalate " <-> " (map playerName (players ++ [head players])) ] where - playerName player = T.concat [player ^. name, if isDead player then " (dead)" else ""] + playerName player = T.concat [player ^. name, if is dead player then " (dead)" else ""] pingPlayerMessage :: Text -> Message pingPlayerMessage to = privateMessage to "Waiting on you..." @@ -359,34 +366,33 @@ ] where roleCounts = map (head &&& length) (groupSortOn (view Role.name) roles) - totalBalance = sum $ map (view balance) roles + totalBalance = sumOf (traverse . balance) roles playersInGameMessage :: Text -> [Player] -> Message playersInGameMessage to players = privateMessage to . T.intercalate "\n" $ - alivePlayersText : if null $ filterDead players then [] else [deadPlayersText] + alivePlayersText : [deadPlayersText | any (is dead) players] where alivePlayersText = T.concat [ "The following players are still alive: " - , T.intercalate ", " (map (view name) $ filterAlive players), "." + , T.intercalate ", " (players ^.. traverse . alive . name), "." ] deadPlayersText = T.concat [ "The following players are dead: " - , T.intercalate ", " (map (\player -> T.concat [player ^. name, " (", player ^. role . Role.name, ")"]) $ filterDead players), "." + , T.intercalate ", " (map playerNameWithRole (players ^.. traverse . dead)), "." ] + playerNameWithRole player = T.concat [player ^. name, " (", player ^. role . Role.name, ")"] -waitingOnMessage :: Maybe Text -> [Player] -> Message -waitingOnMessage mTo players = Message mTo $ T.concat +waitingOnMessage :: Maybe Text -> [Text] -> Message +waitingOnMessage mTo playerNames = Message mTo $ T.concat [ "Waiting on ", T.intercalate ", " playerNames, "..." ] - where - playerNames = map (view name) players angelJoinedVillagersMessage :: Message angelJoinedVillagersMessage = publicMessage $ T.unwords [ "You hear the Angel wrought with anger off in the distance." , "He failed to attract the discriminatory vote of the village" , "or the devouring vindictiveness of the lycanthropes." - , "Now he is stuck here, doomed forever to live out a mortal life as a Simple Villager." + , "Now he is stuck here, doomed forever to live out a mortal life as a Villager." ] ursusGruntsMessage :: Message @@ -428,14 +434,13 @@ playerLynchedMessage :: Player -> Message playerLynchedMessage player - | isWerewolf player - && not (isWildChild player) = publicMessage $ T.concat + | is simpleWerewolf player = publicMessage $ T.concat [ playerName, " is tied up to a pyre and set alight." , " As they scream their body starts to contort and writhe, transforming into " , article playerRole, " ", playerRole ^. Role.name, "." , " Thankfully they go limp before breaking free of their restraints." ] - | otherwise = publicMessage $ T.concat + | otherwise = publicMessage $ T.concat [ playerName, " is tied up to a pyre and set alight." , " Eventually the screams start to die and with their last breath," , " they reveal themselves as " @@ -460,7 +465,7 @@ villageIdiotLynchedMessage :: Text -> Message villageIdiotLynchedMessage name = publicMessage $ T.concat - [ "Just as the townsfolk tie ", name, " up to the pyre, a voice in the crowd yells out." + [ "Just as the townsfolk tie", name, "up to the pyre, a voice in the crowd yells out." , " \"We can't burn ", name, "! He's that oaf, you know, John's boy!\"" , " The Village Idiot is quickly untied and apologised to." ] @@ -468,6 +473,9 @@ playerHasAlreadyVotedMessage :: Text -> Message playerHasAlreadyVotedMessage to = privateMessage to "You've already voted!" +playerCannotLynchVillageIdiotMessage :: Text -> Message +playerCannotLynchVillageIdiotMessage to = privateMessage to "You cannot lynch the Village Idiot!" + playerMadeDevourVoteMessage :: Text -> Text -> Text -> Message playerMadeDevourVoteMessage to voterName targetName = privateMessage to $ T.concat [ voterName, " voted to devour ", targetName, "." @@ -514,9 +522,11 @@ playerPoisonedMessage :: Player -> Message playerPoisonedMessage player = publicMessage $ T.unwords [ "Upon further discovery, it looks like the Witch struck in the night." - , player ^. name, "the", player ^. role . Role.name - , "is lying in their bed, poisoned, drooling over the side." + , playerName, "the", playerRole, "is hanging over the side of their bed, poisoned." ] + where + playerName = player ^. name + playerRole = player ^. role . Role.name playerHasAlreadyHealedMessage :: Text -> Message playerHasAlreadyHealedMessage to = privateMessage to "You've already healed someone!" 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 @@ -1,19 +1,340 @@ {-| Module : Game.Werewolf.Player -Description : Simplistic player data structure. +Description : Simplistic player data structure with functions for searching, filtering and querying + lists of players. Copyright : (c) Henry J. Wylde, 2016 License : BSD3 Maintainer : public@hjwylde.com -Player functions are defined in "Game.Werewolf.Internal.Player". This module just re-exports the -functions relevant to the public interface. +Players are quite simple in themselves. They have a 'name', 'role' and 'state'. Any complex +behaviour is handled in "Game.Werewolf.Command" and "Game.Werewolf.Engine". -} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TemplateHaskell #-} + module Game.Werewolf.Player ( -- * Player - Player, name, role, state, + Player, + name, role, state, State(..), + _Alive, _Dead, + + newPlayer, + + -- ** Traversals + angel, bearTamer, defender, scapegoat, seer, simpleVillager, simpleWerewolf, villageIdiot, + 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, bearTamers, defenders, scapegoats, seers, simpleVillagers, simpleWerewolves, + villageIdiots, villagerVillagers, wildChildren, witches, wolfHounds, + villagers, werewolves, + alive, dead, + + -- * Utility functions + is, isn't, filteredBy, ) where -import Game.Werewolf.Internal.Player +import Control.Lens hiding (isn't) + +import Data.Function +import Data.Text (Text) + +import Game.Werewolf.Role hiding (name) + +-- | A player has a 'name', 'role' and 'state'. Any stateful information needed for a player's +-- @role@ is held on the 'Game' itself. +-- +-- N.B., player equality is defined on just the 'name'. +data Player = Player + { _name :: Text + , _role :: Role + , _state :: State + } deriving (Read, Show) + +-- | Surprise surprise, players may be 'Dead' or 'Alive'. +data State = Alive | Dead + deriving (Eq, Read, Show) + +makeLenses ''Player + +instance Eq Player where + (==) = (==) `on` view name + +makePrisms ''State + +-- | Creates a new 'Alive' player. +newPlayer :: Text -> Role -> Player +newPlayer name role = Player name role Alive + +-- | The traversal of 'Player's with an 'angelRole'. +-- +-- @ +-- 'angel' = 'role' . 'only' 'angelRole' +-- @ +angel :: Traversal' Player () +angel = role . only angelRole + +-- | The traversal of 'Player's with a 'bearTamerRole'. +-- +-- @ +-- 'bearTamer' = 'role' . 'only' 'bearTamerRole' +-- @ +bearTamer :: Traversal' Player () +bearTamer = role . only bearTamerRole + +-- | 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 'scapegoatRole'. +-- +-- @ +-- 'scapegoat' = 'role' . 'only' 'scapegoatRole' +-- @ +scapegoat :: Traversal' Player () +scapegoat = role . only scapegoatRole + +-- | The traversal of 'Player's with a 'seerRole'. +-- +-- @ +-- 'seer' = 'role' . 'only' 'seerRole' +-- @ +seer :: Traversal' Player () +seer = role . only seerRole + +-- | The traversal of 'Player's with a 'simpleVillagerRole'. +-- +-- @ +-- 'simpleVillager' = 'role' . 'only' 'simpleVillagerRole' +-- @ +simpleVillager :: Traversal' Player () +simpleVillager = role . only simpleVillagerRole + +-- | The traversal of 'Player's with a 'simpleWerewolfRole'. +-- +-- @ +-- 'simpleWerewolf' = 'role' . 'only' 'simpleWerewolfRole' +-- @ +simpleWerewolf :: Traversal' Player () +simpleWerewolf = role . only simpleWerewolfRole + +-- | The traversal of 'Player's with a 'villageIdiotRole'. +-- +-- @ +-- 'villageIdiot' = 'role' . 'only' 'villageIdiotRole' +-- @ +villageIdiot :: Traversal' Player () +villageIdiot = role . only villageIdiotRole + +-- | The traversal of 'Player's with a 'villagerVillagerRole'. +-- +-- @ +-- 'villagerVillager' = 'role' . 'only' 'villagerVillagerRole' +-- @ +villagerVillager :: Traversal' Player () +villagerVillager = role . only villagerVillagerRole + +-- | The traversal of 'Player's with a 'wildChildRole'. +-- +-- @ +-- 'wildChild' = 'role' . 'only' 'wildChildRole' +-- @ +wildChild :: Traversal' Player () +wildChild = role . only wildChildRole + +-- | The traversal of 'Player's with a 'witchRole'. +-- +-- @ +-- 'witch' = 'role' . 'only' 'witchRole' +-- @ +witch :: Traversal' Player () +witch = role . only witchRole + +-- | The traversal of 'Player's with a 'wolfHoundRole'. +-- +-- @ +-- 'wolfHound' = 'role' . 'only' 'wolfHoundRole' +-- @ +wolfHound :: Traversal' Player () +wolfHound = role . only wolfHoundRole + +-- | The traversal of 'Player's aligned with the 'Villagers'. +-- +-- @ +-- 'villager' = 'role' . 'allegiance' . '_Villagers' +-- @ +villager :: Traversal' Player () +villager = role . allegiance . _Villagers + +-- | The traversal of 'Player's aligned with the 'Werewolves'. +-- +-- @ +-- 'werewolf' = 'role' . 'allegiance' . '_Werewolves' +-- @ +werewolf :: Traversal' Player () +werewolf = role . allegiance . _Werewolves + +-- | This 'Traversal' provides the traversal of 'Player' names. +-- +-- @ +-- 'names' = 'traverse' . 'name' +-- @ +names :: Traversable t => Traversal' (t Player) Text +names = traverse . name + +-- | This 'Traversal' provides the traversal of 'Player' roles. +-- +-- @ +-- 'roles' = 'traverse' . 'role' +-- @ +roles :: Traversable t => Traversal' (t Player) Role +roles = traverse . role + +-- | This 'Traversal' provides the traversal of 'Player' states. +-- +-- @ +-- 'states' = 'traverse' . 'state' +-- @ +states :: Traversable t => Traversal' (t Player) State +states = traverse . state + +-- | This 'Traversal' provides the traversal of 'angel' 'Player's. +-- +-- @ +-- 'angels' = 'traverse' . 'filtered' ('is' 'angel') +-- @ +angels :: Traversable t => Traversal' (t Player) Player +angels = traverse . filtered (is angel) + +-- | This 'Traversal' provides the traversal of 'bearTamer' 'Player's. +-- +-- @ +-- 'bearTamers' = 'traverse' . 'filtered' ('is' 'bearTamer') +-- @ +bearTamers :: Traversable t => Traversal' (t Player) Player +bearTamers = traverse . filtered (is bearTamer) + +-- | 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 'scapegoat' 'Player's. +-- +-- @ +-- 'scapegoats' = 'traverse' . 'filtered' ('is' 'scapegoat') +-- @ +scapegoats :: Traversable t => Traversal' (t Player) Player +scapegoats = traverse . filtered (is scapegoat) + +-- | This 'Traversal' provides the traversal of 'seer' 'Player's. +-- +-- @ +-- 'seers' = 'traverse' . 'filtered' ('is' 'seer') +-- @ +seers :: Traversable t => Traversal' (t Player) Player +seers = traverse . filtered (is seer) + +-- | This 'Traversal' provides the traversal of 'simpleVillager' 'Player's. +-- +-- @ +-- 'simpleVillagers' = 'traverse' . 'filtered' ('is' 'simpleVillager') +-- @ +simpleVillagers :: Traversable t => Traversal' (t Player) Player +simpleVillagers = traverse . filtered (is simpleVillager) + +-- | This 'Traversal' provides the traversal of 'simpleWerewolf' 'Player's. +-- +-- @ +-- 'simpleWerewolves' = 'traverse' . 'filtered' ('is' 'simpleWerewolf') +-- @ +simpleWerewolves :: Traversable t => Traversal' (t Player) Player +simpleWerewolves = traverse . filtered (is simpleWerewolf) + +-- | This 'Traversal' provides the traversal of 'villageIdiot' 'Player's. +-- +-- @ +-- 'villageIdiots' = 'traverse' . 'filtered' ('is' 'villageIdiot') +-- @ +villageIdiots :: Traversable t => Traversal' (t Player) Player +villageIdiots = traverse . filtered (is villageIdiot) + +-- | This 'Traversal' provides the traversal of 'villagerVillager' 'Player's. +-- +-- @ +-- 'villagerVillagers' = 'traverse' . 'filtered' ('is' 'villagerVillager') +-- @ +villagerVillagers :: Traversable t => Traversal' (t Player) Player +villagerVillagers = traverse . filtered (is villagerVillager) + +-- | This 'Traversal' provides the traversal of 'wildChild' 'Player's. +-- +-- @ +-- 'wildChildren' = 'traverse' . 'filtered' ('is' 'wildChild') +-- @ +wildChildren :: Traversable t => Traversal' (t Player) Player +wildChildren = traverse . filtered (is wildChild) + +-- | This 'Traversal' provides the traversal of 'witch' 'Player's. +-- +-- @ +-- 'witches' = 'traverse' . 'filtered' ('is' 'witch') +-- @ +witches :: Traversable t => Traversal' (t Player) Player +witches = traverse . filtered (is witch) + +-- | This 'Traversal' provides the traversal of 'wolfHound' 'Player's. +-- +-- @ +-- 'wolfHounds' = 'traverse' . 'filtered' ('is' 'wolfHound') +-- @ +wolfHounds :: Traversable t => Traversal' (t Player) Player +wolfHounds = traverse . filtered (is wolfHound) + +-- | This 'Traversal' provides the traversal of 'villager' 'Player's. +-- +-- @ +-- 'villagers' = 'traverse' . 'filtered' ('is' 'villager') +-- @ +villagers :: Traversable t => Traversal' (t Player) Player +villagers = traverse . filtered (is villager) + +-- | This 'Traversal' provides the traversal of 'werewolf' 'Player's. +-- +-- @ +-- 'werewolves' = 'traverse' . 'filtered' ('is' 'werewolf') +-- @ +werewolves :: Traversable t => Traversal' (t Player) Player +werewolves = traverse . filtered (is werewolf) + +-- | This 'Traversal' provides the traversal of 'Alive' 'Player's. +-- +-- @ +-- 'alive' = 'filtered' ('has' $ 'state' . '_Alive') +-- @ +alive :: Traversal' Player Player +alive = filtered (has $ state . _Alive) + +-- | This 'Traversal' provides the traversal of 'Dead' 'Player's. +-- +-- @ +-- 'dead' = 'filtered' ('has' $ 'state' . '_Dead') +-- @ +dead :: Traversal' Player Player +dead = filtered (has $ state . _Dead) 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 @@ -6,18 +6,397 @@ License : BSD3 Maintainer : public@hjwylde.com -Role instances are defined in "Game.Werewolf.Internal.Role". This module just re-exports the -functions relevant to the public interface. +Roles are split into four categories: + +* The Ambiguous. +* The Loners. +* The Villagers. +* The Werewolves. -} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TemplateHaskell #-} + module Game.Werewolf.Role ( -- * Role - Role, name, allegiance, balance, description, advice, + Role, + name, allegiance, balance, description, advice, Allegiance(..), + _Angel, _Villagers, _Werewolves, -- ** Instances allRoles, restrictedRoles, + allAllegiances, + + -- *** The Ambiguous + -- | The Ambiguous may change allegiance during the game. + wildChildRole, wolfHoundRole, + + -- *** The Loners + -- | The Loners have their own win condition. + angelRole, + + -- *** The Villagers + -- | The Villagers must lynch all of the Werewolves. + bearTamerRole, defenderRole, scapegoatRole, seerRole, simpleVillagerRole, villageIdiotRole, + villagerVillagerRole, witchRole, + + -- *** The Werewolves + -- | The Werewolves must devour all of the Villagers. + simpleWerewolfRole, + + -- * Utility functions + is, isn't, filteredBy, ) where -import Game.Werewolf.Internal.Role +import Control.Lens hiding (isn't) + +import Data.Function +import Data.List +import Data.Monoid +import Data.Text (Text) +import qualified Data.Text as T + +-- | Role definitions require only a few pieces of information. +-- Most of the game logic behind a role is implemented in "Game.Werewolf.Command" and +-- "Game.Werewolf.Engine". +-- +-- The @balance@ attribute on a role indicates the allegiance it favours. For example, a Simple +-- Werewolf has a balance of -4 while the Seer has a balance of 2. A balance of 0 means it favours +-- neither allegiance. +-- +-- N.B., role equality is defined on just the 'name' as a role's 'allegiance' may change +-- throughout the game. +data Role = Role + { _name :: Text + , _allegiance :: Allegiance + , _balance :: Int + , _description :: Text + , _advice :: Text + } deriving (Read, Show) + +-- | The Loner allegiances are seldom used, rather they are present for correctness. +data Allegiance = Angel | Villagers | Werewolves + deriving (Eq, Read, Show) + +makeLenses ''Role + +instance Eq Role where + (==) = (==) `on` view name + +makePrisms ''Allegiance + +-- | A list containing all the roles defined in this file. +allRoles :: [Role] +allRoles = + [ angelRole + , bearTamerRole + , defenderRole + , scapegoatRole + , seerRole + , simpleVillagerRole + , villageIdiotRole + , simpleWerewolfRole + , villagerVillagerRole + , wildChildRole + , witchRole + , wolfHoundRole + ] + +-- | A list containing roles that are restricted to a single instance per 'Game'. +-- +-- @ +-- 'restrictedRoles' = 'allRoles' \\\\ ['simpleVillagerRole', 'simpleWerewolfRole'] +-- @ +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] + +-- | /Abandoned in the woods by his parents at a young age, he was raised by wolves. As soon as he/ +-- /learned how to walk on all fours, the Wild-child began to wander around Miller's Hollow. One/ +-- /day, fascinated by an inhabitant of the village who was walking upright with grace and/ +-- /presence, he made them his secret role model. He then decided to integrate himself into the/ +-- /community of Miller's Hollow and entered, worried, in the village. The community was moved by/ +-- /his frailty, adopted him, and welcomed him in their fold. What will become of him: honest/ +-- /Villager or terrible Werewolf? For all of his life, the heart of the Wild-child will swing/ +-- /between these two alternatives. May his model confirm him in his newfound humanity./ +-- +-- On the first night, the Wild-child may choose a player to become his role model. If during the +-- game the chosen player is eliminated, the Wild-child becomes a Werewolf. He will then wake up +-- the next night with his peers and will devour with them each night until the end of the game. +-- However for as long as the Wild-child's role model is alive, he remains a Villager. +wildChildRole :: Role +wildChildRole = Role + { _name = "Wild-child" + , _allegiance = Villagers + , _balance = -1 + , _description = T.unwords + [ "Abandoned in the woods by his parents at a young age, he was raised by wolves." + , "As soon as he learned how to walk on all fours," + , "the Wild-child began to wander around Miller's Hollow." + , "One day, fascinated by an inhabitant of the village who was walking upright" + , "with grace and presence, he made them his secret role model." + , "He then decided to integrate himself into the community of Miller's Hollow and entered," + , "worried, in the village." + , "The community was moved by his frailty, adopted him, and welcomed him in their fold." + , "What will become of him: honest Villager or terrible Werewolf?" + , "For all of his life," + , "the heart of the Wild-child will swing between these two alternatives." + , "May his model confirm him in his newfound humanity." + ] + , _advice = T.unwords + [ "Nothing is keeping you from taking part in the elimination of your role model," + , "if you so wish..." + ] + } + +-- | /All dogs know in the depths of their soul that their ancestors were wolves and that it's/ +-- /mankind who has kept them in the state of childishness and fear, the faithful and generous/ +-- /companions. In any case, only the Wolf-hound can decide if he'll obey his human and civilized/ +-- /master or if he'll listen to the call of wild nature buried within him./ +-- +-- On the first night, he chooses if he wants to be a Simple Villager or Werewolf. The choice is +-- final. +wolfHoundRole :: Role +wolfHoundRole = Role + { _name = "Wolf-hound" + , _allegiance = Villagers + , _balance = -1 + , _description = T.unwords + [ "All dogs know in the depths of their soul that their ancestors were wolves" + , "and that it's mankind who has kept them in the state of childishness and fear," + , "the faithful and generous companions." + , "In any case, only the Wolf-hound can decide if he'll obey his human and civilized master" + , "or if he'll listen to the call of wild nature buried within him." + ] + , _advice = + "The choice of being a Simple Villager or Werewolf is final, so decide carefully!" + } + +-- | /The muddy life of a village infested with evil creatures repulses him; he wishes to believe/ +-- /he's the victim of a terrible nightmare, in order to finally wake up in his comfortable bed./ +-- +-- When the Angel is in play, the game always begins with the village's debate followed by an +-- elimination vote, and then the first night. +-- +-- The Angel wins if he manages to get eliminated on the first round (day or night). +-- If he fails, then he becomes a Simple Villager for the rest of the game. +angelRole :: Role +angelRole = Role + { _name = "Angel" + , _allegiance = Angel + , _balance = 0 + , _description = T.unwords + [ "The muddy life of a village infested with evil creatures repulses him;" + , "he wishes to believe he's the victim of a terrible nightmare," + , "in order to finally wake up in his comfortable bed." + ] + , _advice = T.unwords + [ "It's going to take all your guile and wits to con the village into eliminating you." + , "Pretending to be a Werewolf is one tactic, but if it doesn't work then you may have just" + , "dug yourself a hole for the rest of the game..." + ] + } + +-- | /Ah! How sweet it is, in my memory, the sound of chains slipping onto the cobblestones of the/ +-- /"Three Road" plaza, accompanied by the grunting of Ursus. Ah! How long ago it was that Titan,/ +-- /the Bear Tamer, would lead his companion in a ballet so gravious that we'd cry every summer/ +-- /in Miller's Hollow. Ursus even had the oh-so-previous ability to detect lycanthropes hidden/ +-- /near him./ +-- +-- Each morning, right after the revelation of any possible nocturnal victims, if at least one +-- Werewolf is or ends up directly next to the Bear Tamer, then Ursus grunts to indicate danger to +-- all of the other players. +bearTamerRole :: Role +bearTamerRole = Role + { _name = "Bear Tamer" + , _allegiance = Villagers + , _balance = 2 + , _description = T.unwords + [ "Ah! How sweet it is, in my memory, the sound of chains slipping onto the cobblestones" + , "of the \"Three Road\" plaza, accompanied by the grunting of Ursus." + , "Ah! How long ago it was that Titan, the Bear Tamer, would lead his companion in a ballet" + , "so gravious that we'd cry every summer in Miller's Hollow." + , "Ursus even had the oh-so-previous ability to detect lycanthropes hidden near him." + ] + , _advice = + "Aren't you lucky to have a companion with a strong nose. Just don't let him wander off!" + } + +-- | /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. +defenderRole :: Role +defenderRole = Role + { _name = "Defender" + , _allegiance = Villagers + , _balance = 2 + , _description = + "This character can save the Villagers from the bite of the Werewolves." + , _advice = T.unwords + [ "Be careful: you can protect yourself," + , "but you're not allowed to protect the same player two nights in a row." + ] + } + +-- | /It's sad to say, but in Miller's Hollow, when something doesn't go right it's always him who/ +-- /unjustly suffers the consequences./ +-- +-- If the village's vote ends in a tie, it's the Scapegoat who is eliminated instead of no-one. +-- +-- In this event, the Scapegoat has one last task to complete: he must choose whom is permitted to +-- vote or not on the next day. +scapegoatRole :: Role +scapegoatRole = Role + { _name = "Scapegoat" + , _allegiance = Villagers + , _balance = 1 + , _description = T.unwords + [ "It's sad to say, but in Miller's Hollow, when something doesn't go right" + , "it's always him who unjustly suffers the consequences." + ] + , _advice = T.unwords + [ "Cross your fingers that the votes don't end up tied." + , "If you do so happen to be that unlucky," + , "then be wary of whom you allow to vote on the next day." + , "If you choose only one player and the Werewolves devour them in the night," + , "then there will be no village vote." + ] + } + +-- | /A fortunate teller by other names, with the ability to see into fellow townsfolk and/ +-- /determine their allegiance./ +-- +-- Each night the Seer sees the allegiance of a player of her choice. +seerRole :: Role +seerRole = Role + { _name = "Seer" + , _allegiance = Villagers + , _balance = 2 + , _description = T.unwords + [ "A fortunate teller by other names, with the ability to see into fellow" + , "townsfolk and determine their allegiance." + ] + , _advice = T.unwords + [ "You should help the other Villagers," + , "but try to remain discreet so as to not arouse suspicion from any of the Werewolves." + ] + } + +-- | /A simple, ordinary townsperson in every way. Their only weapons are the ability to analyze/ +-- /behaviour to identify Werewolves, and the strength of their conviction to prevent the/ +-- /execution of the innocents like themselves./ +simpleVillagerRole :: Role +simpleVillagerRole = Role + { _name = "Simple Villager" + , _allegiance = Villagers + , _balance = 1 + , _description = T.unwords + [ "A simple, ordinary townsperson in every way." + , "Their only weapons are the ability to analyze behaviour to identify Werewolves," + , "and the strength of their conviction to prevent" + , "the execution of the innocents like themselves." + ] + , _advice = + "Bluffing can be a good technique, but you had better be convincing about what you say." + } + +-- | /What is a village without an idiot? He does pretty much nothing important, but he's so/ +-- /charming that no one would want to hurt him./ +-- +-- If the village votes against the Village Idiot, his identity is revealed. At that moment the +-- Villagers understand their mistake and immediately let him be. +-- +-- The Village Idiot continues to play but may no longer vote, as what would the vote of an idiot +-- be worth? +villageIdiotRole :: Role +villageIdiotRole = Role + { _name = "Village Idiot" + , _allegiance = Villagers + , _balance = 0 + , _description = T.unwords + [ "What is a village without an idiot?" + , "He does pretty much nothing important," + , "but he's so charming that no one would want to hurt him." + ] + , _advice = + "Hah! As if advice would do you any good..." + } + +-- | /This person has a soul as clear and transparent as the water from a mountain stream. They/ +-- /will deserve the attentive ear of their peers and will make their word decisive in crucial/ +-- /moments./ +-- +-- When the game begins, the village is told the identity of the Villager-Villager, thus ensuring +-- certainty that its owner is truly an innocent Villager. +villagerVillagerRole :: Role +villagerVillagerRole = Role + { _name = "Villager-Villager" + , _allegiance = Villagers + , _balance = 2 + , _description = T.unwords + [ "This person has a soul as clear and transparent as the water from a mountain stream." + , "They will deserve the attentive ear of their peers" + , "and will make their word decisive in crucial moments." + ] + , _advice = "You'll make friends quickly, but be wary about whom you trust." + } + +-- | /She knows how to brew two extremely powerful potions: a healing potion, to resurrect the/ +-- /player devoured by the Werewolves, and a poison potion, used at night to eliminate a player./ +-- +-- The Witch is called after the Werewolves. She is allowed to use both potions in the same night +-- and is also allowed to heal herself. +witchRole :: Role +witchRole = Role + { _name = "Witch" + , _allegiance = Villagers + , _balance = 3 + , _description = T.unwords + [ "She knows how to brew two extremely powerful potions:" + , "a healing potion, to resurrect the player devoured by the Werewolves," + , "and a poison potion, used at night to eliminate a player." + ] + , _advice = T.unwords + [ "Each potion may only be used once per game," + , "but there are no restrictions on using both of your potions in the same night." + ] + } + +-- | /Each night they devour a Villager. During the day they try to hide their nocturnal identity/ +-- /to avoid mob justice./ +-- +-- A Werewolf may never devour another Werewolf. +simpleWerewolfRole :: Role +simpleWerewolfRole = Role + { _name = "Simple Werewolf" + , _allegiance = Werewolves + , _balance = -4 + , _description = T.unwords + [ "Each night they devour a Villager." + , "During the day they try to hide their nocturnal identity to avoid mob justice." + ] + , _advice = + "Voting to lynch your partner can be a good way to deflect suspicion from yourself." + } + +-- | The counter-part to 'isn't', but more general as it takes a 'Getting' instead. +is :: Getting Any s a -> s -> Bool +is query = has query + +-- | A re-write of 'Control.Lens.Prism.isn't' to be more general by taking a 'Getting' instead. +isn't :: Getting All s a -> s -> Bool +isn't query = hasn't query + +-- | A companion to 'filtered' that, rather than using a predicate, filters on the given lens for +-- matches. +filteredBy :: Eq b => Lens' a b -> b -> Traversal' a a +filteredBy lens value = filtered ((value ==) . view lens) diff --git a/src/Game/Werewolf/Util.hs b/src/Game/Werewolf/Util.hs new file mode 100644 --- /dev/null +++ b/src/Game/Werewolf/Util.hs @@ -0,0 +1,167 @@ +{-| +Module : Game.Werewolf.Util +Description : Utility functions for working in a ('MonadState' 'Game') environment. + +Copyright : (c) Henry J. Wylde, 2016 +License : BSD3 +Maintainer : public@hjwylde.com + +Utility functions for woking in a ('MonadState' 'Game') environment. +-} + +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE Rank2Types #-} + +module Game.Werewolf.Util ( + -- * Game + + -- ** Manipulations + killPlayer, setPlayerAllegiance, + + -- ** Searches + findPlayerBy_, getAdjacentAlivePlayers, getPassers, getPlayerVote, + getAllowedVoters, getPendingVoters, getVoteResult, + + -- ** Queries + isDefendersTurn, isGameOver, isScapegoatsTurn, isSeersTurn, isSunrise, isVillagesTurn, + isWerewolvesTurn, isWildChildsTurn, isWitchsTurn, isWolfHoundsTurn, + hasAnyoneWon, hasAngelWon, hasVillagersWon, hasWerewolvesWon, + + -- * Player + + -- ** Queries + doesPlayerExist, + isPlayerDefender, isPlayerScapegoat, isPlayerSeer, isPlayerVillageIdiot, isPlayerWildChild, + isPlayerWitch, isPlayerWolfHound, + isPlayerWerewolf, + isPlayerAlive, isPlayerDead, +) where + +import Control.Lens hiding (cons) +import Control.Monad.Extra +import Control.Monad.State hiding (state) + +import Data.List +import Data.Maybe +import Data.Text (Text) + +import Game.Werewolf.Game hiding (doesPlayerExist, getAllowedVoters, getPendingVoters, + getVoteResult, hasAngelWon, hasAnyoneWon, hasVillagersWon, + hasWerewolvesWon, killPlayer) +import qualified Game.Werewolf.Game as Game +import Game.Werewolf.Player +import Game.Werewolf.Role hiding (name) + +import Prelude hiding (round) + +killPlayer :: MonadState Game m => Text -> m () +killPlayer name = modify $ Game.killPlayer name + +-- | Fudges the player's allegiance. This function is useful for roles such as the Wild-child where +-- they align themselves differently given some trigger. +setPlayerAllegiance :: MonadState Game m => Text -> Allegiance -> m () +setPlayerAllegiance name' allegiance' = modify $ players . traverse . filteredBy name name' . role . allegiance .~ allegiance' + +findPlayerBy_ :: (Eq a, MonadState Game m) => Lens' Player a -> a -> m Player +findPlayerBy_ lens value = fromJust <$> preuse (players . traverse . filteredBy lens value) + +getAdjacentAlivePlayers :: MonadState Game m => Text -> m [Player] +getAdjacentAlivePlayers name' = do + alivePlayers <- toListOf (players . traverse . alive) <$> get + let index = fromJust $ elemIndex name' (alivePlayers ^.. names) + + return $ adjacentElements index alivePlayers + where + adjacentElements 0 list = last list : take 2 list + adjacentElements index list = take 3 $ drop (index - 1) (cycle list) + +getPassers :: MonadState Game m => m [Player] +getPassers = mapM (findPlayerBy_ name) =<< use passes + +getPlayerVote :: MonadState Game m => Text -> m (Maybe Text) +getPlayerVote playerName = use $ votes . at playerName + +getAllowedVoters :: MonadState Game m => m [Player] +getAllowedVoters = gets Game.getAllowedVoters + +getPendingVoters :: MonadState Game m => m [Player] +getPendingVoters = gets Game.getPendingVoters + +getVoteResult :: MonadState Game m => m [Player] +getVoteResult = gets Game.getVoteResult + +isDefendersTurn :: MonadState Game m => m Bool +isDefendersTurn = has (stage . _DefendersTurn) <$> get + +isGameOver :: MonadState Game m => m Bool +isGameOver = has (stage . _GameOver) <$> get + +isScapegoatsTurn :: MonadState Game m => m Bool +isScapegoatsTurn = has (stage . _ScapegoatsTurn) <$> get + +isSeersTurn :: MonadState Game m => m Bool +isSeersTurn = has (stage . _SeersTurn) <$> get + +isSunrise :: MonadState Game m => m Bool +isSunrise = has (stage . _Sunrise) <$> get + +isVillagesTurn :: MonadState Game m => m Bool +isVillagesTurn = has (stage . _VillagesTurn) <$> get + +isWerewolvesTurn :: MonadState Game m => m Bool +isWerewolvesTurn = has (stage . _WerewolvesTurn) <$> get + +isWildChildsTurn :: MonadState Game m => m Bool +isWildChildsTurn = has (stage . _WildChildsTurn) <$> get + +isWitchsTurn :: MonadState Game m => m Bool +isWitchsTurn = has (stage . _WitchsTurn) <$> get + +isWolfHoundsTurn :: MonadState Game m => m Bool +isWolfHoundsTurn = has (stage . _WolfHoundsTurn) <$> get + +hasAnyoneWon :: MonadState Game m => m Bool +hasAnyoneWon = gets Game.hasAnyoneWon + +hasAngelWon :: MonadState Game m => m Bool +hasAngelWon = gets Game.hasAngelWon + +hasVillagersWon :: MonadState Game m => m Bool +hasVillagersWon = gets Game.hasVillagersWon + +hasWerewolvesWon :: MonadState Game m => m Bool +hasWerewolvesWon = gets Game.hasWerewolvesWon + +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' + +isPlayerScapegoat :: MonadState Game m => Text -> m Bool +isPlayerScapegoat name' = is scapegoat <$> findPlayerBy_ name name' + +isPlayerSeer :: MonadState Game m => Text -> m Bool +isPlayerSeer name' = is seer <$> findPlayerBy_ name name' + +isPlayerVillageIdiot :: MonadState Game m => Text -> m Bool +isPlayerVillageIdiot name' = is villageIdiot <$> findPlayerBy_ name name' + +isPlayerWildChild :: MonadState Game m => Text -> m Bool +isPlayerWildChild name' = is wildChild <$> findPlayerBy_ name name' + +isPlayerWitch :: MonadState Game m => Text -> m Bool +isPlayerWitch name' = is witch <$> findPlayerBy_ name name' + +isPlayerWolfHound :: MonadState Game m => Text -> m Bool +isPlayerWolfHound name' = is wolfHound <$> findPlayerBy_ name name' + +isPlayerWerewolf :: MonadState Game m => Text -> m Bool +isPlayerWerewolf name' = is werewolf <$> findPlayerBy_ name name' + +isPlayerAlive :: MonadState Game m => Text -> m Bool +isPlayerAlive name' = is alive <$> findPlayerBy_ name name' + +isPlayerDead :: MonadState Game m => Text -> m Bool +isPlayerDead name' = is dead <$> findPlayerBy_ name name' diff --git a/test/app/Main.hs b/test/app/Main.hs --- a/test/app/Main.hs +++ b/test/app/Main.hs @@ -5,8 +5,6 @@ Maintainer : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-} - module Main ( -- * Main main 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 @@ -5,7 +5,6 @@ Maintainer : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Game.Werewolf.Test.Arbitrary ( @@ -17,12 +16,11 @@ GameAtSunrise(..), GameAtVillagesTurn(..), GameAtWerewolvesTurn(..), GameAtWildChildsTurn(..), GameAtWitchsTurn(..), GameAtWolfHoundsTurn(..), GameOnSecondRound(..), - GameWithAllowedVoters(..), GameWithDeadPlayers(..), GameWithDevourEvent(..), - GameWithDevourVotes(..), GameWithHeal(..), GameWithLynchVotes(..), + GameWithAllegianceChosen(..), GameWithAllowedVoters(..), GameWithDeadPlayers(..), + GameWithDevourEvent(..), GameWithDevourVotes(..), GameWithHeal(..), GameWithLynchVotes(..), GameWithOneAllegianceAlive(..), GameWithPoison(..), GameWithProtect(..), GameWithProtectAndDevourVotes(..), GameWithRoleModel(..), GameWithRoleModelAtVillagesTurn(..), GameWithScapegoatBlamed(..), GameWithSee(..), GameWithVillageIdiotRevealedAtVillagesTurn(..), - GameWithZeroAllegiancesAlive(..), -- ** Player arbitraryPlayerSet, @@ -40,7 +38,7 @@ arbitraryPlayer, arbitraryWerewolf, ) where -import Control.Lens hiding (elements) +import Control.Lens hiding (elements, isn't) import Data.List.Extra import Data.Maybe @@ -48,10 +46,10 @@ import qualified Data.Text as T import Game.Werewolf.Command -import Game.Werewolf.Engine (checkStage) -import Game.Werewolf.Internal.Game -import Game.Werewolf.Internal.Player -import Game.Werewolf.Internal.Role hiding (name) +import Game.Werewolf.Engine (checkStage) +import Game.Werewolf.Game +import Game.Werewolf.Player +import Game.Werewolf.Role hiding (name) import Game.Werewolf.Test.Util import Prelude hiding (round) @@ -66,7 +64,7 @@ return $ game & stage .~ stage' instance Arbitrary Stage where - arbitrary = elements $ allStages \\ [GameOver, Sunrise, Sunset] + arbitrary = elements . nub $ allStages \\ [GameOver, Sunrise, Sunset] instance Arbitrary Player where arbitrary = newPlayer <$> arbitrary <*> arbitrary @@ -188,6 +186,16 @@ return $ GameOnSecondRound (game & round .~ 1) +newtype GameWithAllegianceChosen = GameWithAllegianceChosen Game + deriving (Eq, Show) + +instance Arbitrary GameWithAllegianceChosen where + arbitrary = do + (GameAtWolfHoundsTurn game) <- arbitrary + (Blind command) <- arbitraryChooseAllegianceCommand game + + return $ GameWithAllegianceChosen (run_ (apply command) game) + newtype GameWithAllowedVoters = GameWithAllowedVoters Game deriving (Eq, Show) @@ -205,7 +213,7 @@ arbitrary = do game <- arbitrary (NonEmpty players') <- NonEmpty <$> sublistOf (game ^. players) - let game' = foldr killPlayer game (map (view name) players') + let game' = foldr killPlayer game (players' ^.. names) return $ GameWithDeadPlayers (run_ checkStage game') @@ -253,9 +261,9 @@ instance Arbitrary GameWithOneAllegianceAlive where arbitrary = do game <- arbitrary - allegiance' <- arbitrary - let players' = filter ((allegiance' /=) . view (role . allegiance)) (game ^. players) - let game' = foldr killPlayer game (map (view name) players') + allegiance' <- elements [Villagers, Werewolves] + let playerNames = game ^.. players . traverse . filteredBy (role . allegiance) allegiance' . name + let game' = foldr killPlayer game (game ^.. players . names \\ playerNames) return $ GameWithOneAllegianceAlive game' @@ -297,21 +305,10 @@ instance Arbitrary GameWithProtectAndDevourVotes where arbitrary = do - (GameWithProtectAndWolfHoundChoice game) <- arbitrary - let game' = run_ checkStage game - - GameWithProtectAndDevourVotes <$> runArbitraryCommands (length $ game' ^. players) game' - -newtype GameWithProtectAndWolfHoundChoice = GameWithProtectAndWolfHoundChoice Game - deriving (Eq, Show) - -instance Arbitrary GameWithProtectAndWolfHoundChoice where - arbitrary = do (GameWithProtect game) <- arbitrary let game' = run_ checkStage game - (Blind command) <- arbitraryChooseAllegianceCommand game' - return $ GameWithProtectAndWolfHoundChoice (run_ (apply command) game') + GameWithProtectAndDevourVotes <$> runArbitraryCommands (length $ game' ^. players) game' newtype GameWithRoleModel = GameWithRoleModel Game deriving (Eq, Show) @@ -338,7 +335,8 @@ instance Arbitrary GameWithScapegoatBlamed where arbitrary = do - (GameWithLynchVotes game) <- suchThat arbitrary $ \(GameWithLynchVotes game) -> length (getVoteResult game) > 1 + (GameWithLynchVotes game) <- suchThat arbitrary $ \(GameWithLynchVotes game) -> + length (getVoteResult game) > 1 return $ GameWithScapegoatBlamed game @@ -358,9 +356,9 @@ instance Arbitrary GameWithVillageIdiotRevealed where arbitrary = do - game <- arbitrary - let villageIdiot = findByRole_ villageIdiotRole (game ^. players) - let game' = game & villageIdiotRevealed .~ True & allowedVoters %~ delete (villageIdiot ^. name) + game <- arbitrary + let villageIdiotsName = game ^?! players . villageIdiots . name + let game' = game & villageIdiotRevealed .~ True & allowedVoters %~ delete villageIdiotsName return $ GameWithVillageIdiotRevealed game' @@ -373,27 +371,17 @@ return $ GameWithVillageIdiotRevealedAtVillagesTurn (game & stage .~ VillagesTurn) -newtype GameWithZeroAllegiancesAlive = GameWithZeroAllegiancesAlive Game - deriving (Eq, Show) - -instance Arbitrary GameWithZeroAllegiancesAlive where - arbitrary = do - game <- arbitrary - let game' = foldr killPlayer game (map (view name) (game ^. players)) - - return $ GameWithZeroAllegiancesAlive game' - arbitraryPlayerSet :: Gen [Player] arbitraryPlayerSet = do - n <- choose (14, 24) + n <- choose (14, 24) players <- nubOn (view name) <$> infiniteList - let playersWithRestrictedRole = map (\role -> head $ filterByRole role players) restrictedRoles + let playersWithRestrictedRole = map (\role' -> players ^?! traverse . filteredBy role role') restrictedRoles - let simpleWerewolves = take (n `quot` 6 + 1) $ filter isSimpleWerewolf players - let simpleVillagers = take (n - length restrictedRoles - length simpleWerewolves) $ filter isSimpleVillager players + let simpleWerewolves' = players ^.. taking (n `quot` 5 + 1) simpleWerewolves + let simpleVillagers' = players ^.. taking (n - length restrictedRoles - length simpleWerewolves') simpleVillagers - return $ playersWithRestrictedRole ++ simpleVillagers ++ simpleWerewolves + return $ playersWithRestrictedRole ++ simpleVillagers' ++ simpleWerewolves' arbitraryCommand :: Game -> Gen (Blind Command) arbitraryCommand game = case game ^. stage of @@ -416,51 +404,51 @@ arbitraryChooseAllegianceCommand :: Game -> Gen (Blind Command) arbitraryChooseAllegianceCommand game = do - let wolfHound = findByRole_ wolfHoundRole (game ^. players) - allegianceName <- elements $ map (T.pack . show) [Villagers, Werewolves] + let wolfHoundsName = game ^?! players . wolfHounds . name + allegianceName <- elements $ map (T.pack . show) [Villagers, Werewolves] - return . Blind $ chooseAllegianceCommand (wolfHound ^. name) allegianceName + return . Blind $ chooseAllegianceCommand wolfHoundsName allegianceName arbitraryChoosePlayerCommand :: Game -> Gen (Blind Command) arbitraryChoosePlayerCommand game = do - let wildChild = findByRole_ wildChildRole (game ^. players) + let wildChild = game ^?! players . wildChildren target <- suchThat (arbitraryPlayer game) (wildChild /=) return . Blind $ choosePlayerCommand (wildChild ^. name) (target ^. name) arbitraryChoosePlayersCommand :: Game -> Gen (Blind Command) arbitraryChoosePlayersCommand game = do - let scapegoat = findByRole_ scapegoatRole (game ^. players) - (NonEmpty players') <- NonEmpty <$> sublistOf (filterAlive $ game ^. players) + let scapegoatsName = game ^?! players . scapegoats . name + (NonEmpty players') <- NonEmpty <$> sublistOf (game ^.. players . traverse . alive) - return . Blind $ choosePlayersCommand (scapegoat ^. name) (map (view name) players') + return . Blind $ choosePlayersCommand scapegoatsName (players' ^.. names) arbitraryHealCommand :: Game -> Gen (Blind Command) arbitraryHealCommand game = do - let witch = findByRole_ witchRole (game ^. players) + let witchsName = game ^?! players . witches . name - return $ if game ^. healUsed - then Blind noopCommand - else seq (fromJust $ getDevourEvent game) (Blind $ healCommand (witch ^. name)) + return . Blind $ if game ^. healUsed + then noopCommand + else healCommand witchsName arbitraryPassCommand :: Game -> Gen (Blind Command) arbitraryPassCommand game = do - let witch = findByRole_ witchRole (game ^. players) + let witchsName = game ^?! players . witches . name - return . Blind $ passCommand (witch ^. name) + return . Blind $ passCommand witchsName arbitraryPoisonCommand :: Game -> Gen (Blind Command) arbitraryPoisonCommand game = do - let witch = findByRole_ witchRole (game ^. players) - target <- arbitraryPlayer game + let witchsName = game ^?! players . witches . name + target <- arbitraryPlayer game return $ if isJust (game ^. poison) then Blind noopCommand - else Blind $ poisonCommand (witch ^. name) (target ^. name) + else Blind $ poisonCommand witchsName (target ^. name) arbitraryProtectCommand :: Game -> Gen (Blind Command) arbitraryProtectCommand game = do - let defender = findByRole_ defenderRole (game ^. players) + let defender = game ^?! players . defenders -- TODO (hjw): add suchThat (/= priorProtect) target <- suchThat (arbitraryPlayer game) (defender /=) @@ -470,41 +458,41 @@ arbitraryQuitCommand :: Game -> Gen (Blind Command) arbitraryQuitCommand game = do - let applicableCallers = filterAlive $ game ^. players + let applicableCallerNames = game ^.. players . traverse . alive . name - if null applicableCallers + if null applicableCallerNames then return $ Blind noopCommand - else elements applicableCallers >>= \caller -> - return . Blind $ quitCommand (caller ^. name) + else elements applicableCallerNames >>= \callersName -> + return . Blind $ quitCommand callersName arbitrarySeeCommand :: Game -> Gen (Blind Command) arbitrarySeeCommand game = do - let seer = findByRole_ seerRole (game ^. players) - target <- arbitraryPlayer game + let seersName = game ^?! players . seers . name + target <- arbitraryPlayer game return $ if isJust (game ^. see) then Blind noopCommand - else Blind $ seeCommand (seer ^. name) (target ^. name) + else Blind $ seeCommand seersName (target ^. name) arbitraryVoteDevourCommand :: Game -> Gen (Blind Command) arbitraryVoteDevourCommand game = do - let applicableCallers = filterWerewolves $ getPendingVoters game - target <- suchThat (arbitraryPlayer game) $ not . isWerewolf + let applicableCallerNames = getPendingVoters game ^.. werewolves . name + target <- suchThat (arbitraryPlayer game) $ isn't werewolf - if null applicableCallers + if null applicableCallerNames then return $ Blind noopCommand - else elements applicableCallers >>= \caller -> - return . Blind $ voteDevourCommand (caller ^. name) (target ^. name) + else elements applicableCallerNames >>= \callerName -> + return . Blind $ voteDevourCommand callerName (target ^. name) arbitraryVoteLynchCommand :: Game -> Gen (Blind Command) arbitraryVoteLynchCommand game = do - let applicableCallers = getAllowedVoters game `intersect` getPendingVoters game - target <- arbitraryPlayer game + let applicableCallerNames = (game ^. allowedVoters) `intersect` (getPendingVoters game ^.. names) + target <- arbitraryPlayer game - if null applicableCallers + if null applicableCallerNames then return $ Blind noopCommand - else elements applicableCallers >>= \caller -> - return . Blind $ voteLynchCommand (caller ^. name) (target ^. name) + else elements applicableCallerNames >>= \callerName -> + return . Blind $ voteLynchCommand callerName (target ^. name) runArbitraryCommands :: Int -> Game -> Gen Game runArbitraryCommands n = iterateM n $ \game -> do @@ -517,7 +505,7 @@ iterateM n f a = f a >>= iterateM (n - 1) f arbitraryPlayer :: Game -> Gen Player -arbitraryPlayer = elements . filterAlive . view players +arbitraryPlayer game = elements $ game ^.. players . traverse . alive arbitraryWerewolf :: Game -> Gen Player -arbitraryWerewolf = elements . filterAlive . filterWerewolves . view players +arbitraryWerewolf game = elements $ game ^.. players . werewolves . alive diff --git a/test/src/Game/Werewolf/Test/Command.hs b/test/src/Game/Werewolf/Test/Command.hs --- a/test/src/Game/Werewolf/Test/Command.hs +++ b/test/src/Game/Werewolf/Test/Command.hs @@ -5,7 +5,6 @@ Maintainer : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-} {-# LANGUAGE OverloadedStrings #-} module Game.Werewolf.Test.Command ( @@ -13,7 +12,7 @@ allCommandTests, ) where -import Control.Lens hiding (elements) +import Control.Lens hiding (elements, isn't) import Data.Either.Extra import qualified Data.Map as Map @@ -22,10 +21,10 @@ import qualified Data.Text as T import Game.Werewolf.Command -import Game.Werewolf.Engine (checkStage) -import Game.Werewolf.Internal.Game -import Game.Werewolf.Internal.Player -import Game.Werewolf.Internal.Role hiding (name) +import Game.Werewolf.Engine (checkStage) +import Game.Werewolf.Game +import Game.Werewolf.Player +import Game.Werewolf.Role hiding (name) import Game.Werewolf.Test.Arbitrary import Game.Werewolf.Test.Util @@ -40,7 +39,7 @@ , testProperty "choose allegiance command errors when not wolf-hound's turn" prop_chooseAllegianceCommandErrorsWhenNotWolfHoundsTurn , testProperty "choose allegiance command errors when caller not wolf-hound" prop_chooseAllegianceCommandErrorsWhenCallerNotWolfHound , testProperty "choose allegiance command errors when allegiance does not exist" prop_chooseAllegianceCommandErrorsWhenAllegianceDoesNotExist - , testProperty "choose allegiance command sets caller's role" prop_chooseAllegianceCommandSetsCallersRole + , testProperty "choose allegiance command sets allegiance chosen" prop_chooseAllegianceCommandSetsAllegianceChosen , testProperty "choose player command errors when game is over" prop_choosePlayerCommandErrorsWhenGameIsOver , testProperty "choose player command errors when caller does not exist" prop_choosePlayerCommandErrorsWhenCallerDoesNotExist @@ -102,20 +101,21 @@ , testProperty "protect command sets prior protect" prop_protectCommandSetsPriorProtect , testProperty "protect command sets protect" prop_protectCommandSetsProtect - , testProperty "quit command errors when game is over" prop_quitCommandErrorsWhenGameIsOver - , testProperty "quit command errors when caller does not exist" prop_quitCommandErrorsWhenCallerDoesNotExist - , testProperty "quit command errors when caller is dead" prop_quitCommandErrorsWhenCallerIsDead - , testProperty "quit command kills player" prop_quitCommandKillsPlayer - , testProperty "quit command clears heal when caller is witch" prop_quitCommandClearsHealWhenCallerIsWitch - , 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 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 - , testProperty "quit command sets angel's role when caller is angel" prop_quitCommandSetsAngelsRoleWhenCallerIsAngel + , testProperty "quit command errors when game is over" prop_quitCommandErrorsWhenGameIsOver + , testProperty "quit command errors when caller does not exist" prop_quitCommandErrorsWhenCallerDoesNotExist + , testProperty "quit command errors when caller is dead" prop_quitCommandErrorsWhenCallerIsDead + , testProperty "quit command kills player" prop_quitCommandKillsPlayer + , testProperty "quit command clears allegiance chosen when caller is wolf-hound" prop_quitCommandClearsAllegianceChosenWhenCallerIsWolfHound + , testProperty "quit command clears heal when caller is witch" prop_quitCommandClearsHealWhenCallerIsWitch + , 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 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 + , testProperty "quit command sets angel's allegiance when caller is angel" prop_quitCommandSetsAngelsAllegianceWhenCallerIsAngel , testProperty "see command errors when game is over" prop_seeCommandErrorsWhenGameIsOver , testProperty "see command errors when caller does not exist" prop_seeCommandErrorsWhenCallerDoesNotExist @@ -146,6 +146,7 @@ , testProperty "vote lynch command errors when caller has voted" prop_voteLynchCommandErrorsWhenCallerHasVoted , testProperty "vote lynch command errors when caller is not in allowed voters" prop_voteLynchCommandErrorsWhenCallerIsNotInAllowedVoters , testProperty "vote lynch command errors when caller is known village idiot" prop_voteLynchCommandErrorsWhenCallerIsKnownVillageIdiot + , testProperty "vote lynch command errors when target is known village idiot" prop_voteLynchCommandErrorsWhenTargetIsKnownVillageIdiot , testProperty "vote lynch command updates votes" prop_voteLynchCommandUpdatesVotes ] @@ -162,7 +163,7 @@ prop_chooseAllegianceCommandErrorsWhenCallerIsDead :: GameAtWolfHoundsTurn -> Allegiance -> Property prop_chooseAllegianceCommandErrorsWhenCallerIsDead (GameAtWolfHoundsTurn game) allegiance = do - let wolfHound = findByRole_ wolfHoundRole (game ^. players) + let wolfHound = game ^?! players . wolfHounds let game' = killPlayer (wolfHound ^. name) game let command = chooseAllegianceCommand (wolfHound ^. name) (T.pack $ show allegiance) @@ -170,38 +171,33 @@ prop_chooseAllegianceCommandErrorsWhenNotWolfHoundsTurn :: Game -> Property prop_chooseAllegianceCommandErrorsWhenNotWolfHoundsTurn game = - not (isWolfHoundsTurn game) + hasn't (stage . _WolfHoundsTurn) game ==> forAll (arbitraryChooseAllegianceCommand game) $ verbose_runCommandErrors game . getBlind prop_chooseAllegianceCommandErrorsWhenCallerNotWolfHound :: GameAtWolfHoundsTurn -> Allegiance -> Property prop_chooseAllegianceCommandErrorsWhenCallerNotWolfHound (GameAtWolfHoundsTurn game) allegiance = - forAll (suchThat (arbitraryPlayer game) (not . isWolfHound)) $ \caller -> do + forAll (suchThat (arbitraryPlayer game) (isn't wolfHound)) $ \caller -> do let command = chooseAllegianceCommand (caller ^. name) (T.pack $ show allegiance) verbose_runCommandErrors game command prop_chooseAllegianceCommandErrorsWhenAllegianceDoesNotExist :: GameAtWolfHoundsTurn -> Text -> Property prop_chooseAllegianceCommandErrorsWhenAllegianceDoesNotExist (GameAtWolfHoundsTurn game) allegiance = do - let wolfHound = findByRole_ wolfHoundRole (game ^. players) + let wolfHound = game ^?! players . wolfHounds let command = chooseAllegianceCommand (wolfHound ^. name) allegiance allegiance `notElem` ["Villagers", "Werewolves"] ==> verbose_runCommandErrors game command -prop_chooseAllegianceCommandSetsCallersRole :: GameAtWolfHoundsTurn -> Property -prop_chooseAllegianceCommandSetsCallersRole (GameAtWolfHoundsTurn game) = do - let wolfHound = findByRole_ wolfHoundRole (game ^. players) +prop_chooseAllegianceCommandSetsAllegianceChosen :: GameAtWolfHoundsTurn -> Property +prop_chooseAllegianceCommandSetsAllegianceChosen (GameAtWolfHoundsTurn game) = do + let wolfHoundsName = game ^?! players . wolfHounds . name forAll (elements [Villagers, Werewolves]) $ \allegiance' -> do - let command = chooseAllegianceCommand (wolfHound ^. name) (T.pack $ show allegiance') + let command = chooseAllegianceCommand wolfHoundsName (T.pack $ show allegiance') let game' = run_ (apply command) game - findByName_ (wolfHound ^. name) (game' ^. players) ^. role === roleForAllegiance allegiance' - where - roleForAllegiance allegiance = case allegiance of - Villagers -> simpleVillagerRole - Werewolves -> simpleWerewolfRole - _ -> undefined + fromJust (game' ^. allegianceChosen) === allegiance' prop_choosePlayerCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property prop_choosePlayerCommandErrorsWhenGameIsOver (GameAtGameOver game) = @@ -217,7 +213,7 @@ prop_choosePlayerCommandErrorsWhenTargetDoesNotExist :: GameAtWildChildsTurn -> Player -> Property prop_choosePlayerCommandErrorsWhenTargetDoesNotExist (GameAtWildChildsTurn game) target = do - let wildChild = findByRole_ wildChildRole (game ^. players) + let wildChild = game ^?! players . wildChildren let command = choosePlayerCommand (wildChild ^. name) (target ^. name) not (doesPlayerExist (target ^. name) game) @@ -225,7 +221,7 @@ prop_choosePlayerCommandErrorsWhenCallerIsDead :: GameAtWildChildsTurn -> Property prop_choosePlayerCommandErrorsWhenCallerIsDead (GameAtWildChildsTurn game) = do - let wildChild = findByRole_ wildChildRole (game ^. players) + let wildChild = game ^?! players . wildChildren let game' = killPlayer (wildChild ^. name) game forAll (arbitraryPlayer game') $ \target -> do @@ -235,7 +231,7 @@ prop_choosePlayerCommandErrorsWhenTargetIsDead :: GameAtWildChildsTurn -> Property prop_choosePlayerCommandErrorsWhenTargetIsDead (GameAtWildChildsTurn game) = do - let wildChild = findByRole_ wildChildRole (game ^. players) + let wildChild = game ^?! players . wildChildren forAll (arbitraryPlayer game) $ \target -> do let game' = killPlayer (target ^. name) game @@ -245,19 +241,19 @@ prop_choosePlayerCommandErrorsWhenTargetIsCaller :: GameAtWildChildsTurn -> Property prop_choosePlayerCommandErrorsWhenTargetIsCaller (GameAtWildChildsTurn game) = do - let wildChild = findByRole_ wildChildRole (game ^. players) + let wildChild = game ^?! players . wildChildren let command = choosePlayerCommand (wildChild ^. name) (wildChild ^. name) verbose_runCommandErrors game command prop_choosePlayerCommandErrorsWhenNotWildChildsTurn :: Game -> Property prop_choosePlayerCommandErrorsWhenNotWildChildsTurn game = - not (isWildChildsTurn game) + hasn't (stage . _WildChildsTurn) game ==> forAll (arbitraryChoosePlayerCommand game) $ verbose_runCommandErrors game . getBlind prop_choosePlayerCommandErrorsWhenCallerNotWildChild :: GameAtWildChildsTurn -> Property prop_choosePlayerCommandErrorsWhenCallerNotWildChild (GameAtWildChildsTurn game) = - forAll (suchThat (arbitraryPlayer game) (not . isWildChild)) $ \caller -> + forAll (suchThat (arbitraryPlayer game) (isn't wildChild)) $ \caller -> forAll (arbitraryPlayer game) $ \target -> do let command = choosePlayerCommand (caller ^. name) (target ^. name) @@ -265,9 +261,9 @@ prop_choosePlayerCommandSetsRoleModel :: GameAtWildChildsTurn -> Property prop_choosePlayerCommandSetsRoleModel (GameAtWildChildsTurn game) = do - let wildChild = findByRole_ wildChildRole (game ^. players) + let wildChild = game ^?! players . wildChildren - forAll (suchThat (arbitraryPlayer game) (not . isWildChild)) $ \target -> do + forAll (suchThat (arbitraryPlayer game) (wildChild /=)) $ \target -> do let command = choosePlayerCommand (wildChild ^. name) (target ^. name) let game' = run_ (apply command) game @@ -279,15 +275,15 @@ prop_choosePlayersCommandErrorsWhenCallerDoesNotExist :: GameAtScapegoatsTurn -> Player -> Property prop_choosePlayersCommandErrorsWhenCallerDoesNotExist (GameAtScapegoatsTurn game) caller = - forAll (NonEmpty <$> sublistOf (filterAlive $ game ^. players)) $ \(NonEmpty targets) -> do - let command = choosePlayersCommand (caller ^. name) (map (view name) targets) + forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) -> do + let command = choosePlayersCommand (caller ^. name) (targets ^.. names) not (doesPlayerExist (caller ^. name) game) ==> verbose_runCommandErrors game command prop_choosePlayersCommandErrorsWhenAnyTargetDoesNotExist :: GameAtScapegoatsTurn -> Player -> Property prop_choosePlayersCommandErrorsWhenAnyTargetDoesNotExist (GameAtScapegoatsTurn game) target = do - let scapegoat = findByRole_ scapegoatRole (game ^. players) + let scapegoat = game ^?! players . scapegoats let command = choosePlayersCommand (scapegoat ^. name) [target ^. name] not (doesPlayerExist (target ^. name) game) @@ -295,37 +291,37 @@ prop_choosePlayersCommandErrorsWhenAnyTargetIsDead :: GameAtScapegoatsTurn -> Property prop_choosePlayersCommandErrorsWhenAnyTargetIsDead (GameAtScapegoatsTurn game) = do - let scapegoat = findByRole_ scapegoatRole (game ^. players) + let scapegoat = game ^?! players . scapegoats - forAll (NonEmpty <$> sublistOf (filterAlive $ game ^. players)) $ \(NonEmpty targets) -> + forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) -> forAll (elements targets) $ \target -> do let game' = killPlayer (target ^. name) game - let command = choosePlayersCommand (scapegoat ^. name) (map (view name) targets) + let command = choosePlayersCommand (scapegoat ^. name) (targets ^.. names) verbose_runCommandErrors game' command prop_choosePlayersCommandErrorsWhenNotScapegoatsTurn :: Game -> Property prop_choosePlayersCommandErrorsWhenNotScapegoatsTurn game = - not (isScapegoatsTurn game) + hasn't (stage . _ScapegoatsTurn) game ==> forAll (arbitraryChoosePlayersCommand game) $ verbose_runCommandErrors game . getBlind prop_choosePlayersCommandErrorsWhenCallerNotScapegoat :: GameAtScapegoatsTurn -> Property prop_choosePlayersCommandErrorsWhenCallerNotScapegoat (GameAtScapegoatsTurn game) = - forAll (suchThat (arbitraryPlayer game) (not . isScapegoat)) $ \caller -> - forAll (NonEmpty <$> sublistOf (filterAlive $ game ^. players)) $ \(NonEmpty targets) -> do - let command = choosePlayersCommand (caller ^. name) (map (view name) targets) + forAll (suchThat (arbitraryPlayer game) (isn't scapegoat)) $ \caller -> + forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) -> do + let command = choosePlayersCommand (caller ^. name) (targets ^.. names) verbose_runCommandErrors game command prop_choosePlayersCommandSetsAllowedVoters :: GameAtScapegoatsTurn -> Property prop_choosePlayersCommandSetsAllowedVoters (GameAtScapegoatsTurn game) = do - let scapegoat = findByRole_ scapegoatRole (game ^. players) + let scapegoat = game ^?! players . scapegoats - forAll (NonEmpty <$> sublistOf (filterAlive $ game ^. players)) $ \(NonEmpty targets) -> do - let command = choosePlayersCommand (scapegoat ^. name) (map (view name) targets) + forAll (NonEmpty <$> sublistOf (game ^.. players . traverse . alive)) $ \(NonEmpty targets) -> do + let command = choosePlayersCommand (scapegoat ^. name) (targets ^.. names) let game' = run_ (apply command) game - game' ^. allowedVoters === map (view name) targets + game' ^. allowedVoters === targets ^.. names prop_choosePlayersCommandResetsScapegoatBlamed :: GameAtScapegoatsTurn -> Property prop_choosePlayersCommandResetsScapegoatBlamed (GameAtScapegoatsTurn game) = do @@ -334,7 +330,7 @@ prop_healCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property prop_healCommandErrorsWhenGameIsOver (GameAtGameOver game) = do - let witch = findByRole_ witchRole (game ^. players) + let witch = game ^?! players . witches let command = healCommand $ witch ^. name verbose_runCommandErrors game command @@ -354,28 +350,29 @@ prop_healCommandErrorsWhenNoTargetIsDevoured :: GameAtWitchsTurn -> Property prop_healCommandErrorsWhenNoTargetIsDevoured (GameAtWitchsTurn game) = do - let witch = findByRole_ witchRole (game ^. players) + let witch = game ^?! players . witches let command = healCommand $ witch ^. name verbose_runCommandErrors game command prop_healCommandErrorsWhenNotWitchsTurn :: Game -> Property prop_healCommandErrorsWhenNotWitchsTurn game = do - let witch = findByRole_ witchRole (game ^. players) + let witch = game ^?! players . witches let command = healCommand $ witch ^. name - not (isWitchsTurn game) ==> verbose_runCommandErrors game command + hasn't (stage . _WitchsTurn) game + ==> verbose_runCommandErrors game command prop_healCommandErrorsWhenCallerHasHealed :: GameWithHeal -> Property prop_healCommandErrorsWhenCallerHasHealed (GameWithHeal game) = do - let witch = findByRole_ witchRole (game ^. players) + let witch = game ^?! players . witches let command = healCommand $ witch ^. name verbose_runCommandErrors game command prop_healCommandErrorsWhenCallerNotWitch :: GameWithDevourEvent -> Property prop_healCommandErrorsWhenCallerNotWitch (GameWithDevourEvent game) = - forAll (suchThat (arbitraryPlayer game) (not . isWitch)) $ \caller -> do + forAll (suchThat (arbitraryPlayer game) (isn't witch)) $ \caller -> do let command = healCommand (caller ^. name) verbose_runCommandErrors game command @@ -409,7 +406,7 @@ prop_passCommandErrorsWhenNotWitchsTurn :: Game -> Property prop_passCommandErrorsWhenNotWitchsTurn game = - not (isWitchsTurn game) + hasn't (stage . _WitchsTurn) game ==> forAll (arbitraryPassCommand game) $ verbose_runCommandErrors game . getBlind prop_passCommandUpdatesPasses :: GameAtWitchsTurn -> Property @@ -433,7 +430,7 @@ prop_poisonCommandErrorsWhenTargetDoesNotExist :: GameAtWitchsTurn -> Player -> Property prop_poisonCommandErrorsWhenTargetDoesNotExist (GameAtWitchsTurn game) target = do - let witch = findByRole_ witchRole (game ^. players) + let witch = game ^?! players . witches let command = poisonCommand (witch ^. name) (target ^. name) not (doesPlayerExist (target ^. name) game) @@ -441,7 +438,7 @@ prop_poisonCommandErrorsWhenCallerIsDead :: GameAtWitchsTurn -> Property prop_poisonCommandErrorsWhenCallerIsDead (GameAtWitchsTurn game) = do - let witch = findByRole_ witchRole (game ^. players) + let witch = game ^?! players . witches forAll (arbitraryPlayer game) $ \target -> do let game' = killPlayer (witch ^. name) game @@ -451,7 +448,7 @@ prop_poisonCommandErrorsWhenTargetIsDead :: GameAtWitchsTurn -> Property prop_poisonCommandErrorsWhenTargetIsDead (GameAtWitchsTurn game) = do - let witch = findByRole_ witchRole (game ^. players) + let witch = game ^?! players . witches forAll (arbitraryPlayer game) $ \target -> do let game' = killPlayer (target ^. name) game @@ -461,21 +458,20 @@ prop_poisonCommandErrorsWhenTargetIsDevoured :: GameWithDevourEvent -> Property prop_poisonCommandErrorsWhenTargetIsDevoured (GameWithDevourEvent game) = do - let (DevourEvent targetName) = fromJust $ getDevourEvent game - - let witch = findByRole_ witchRole (game ^. players) - let command = poisonCommand (witch ^. name) targetName + let witchsName = game ^?! players . witches . name + let targetName = game ^?! events . traverse . _DevourEvent + let command = poisonCommand witchsName targetName verbose_runCommandErrors game command prop_poisonCommandErrorsWhenNotWitchsTurn :: Game -> Property prop_poisonCommandErrorsWhenNotWitchsTurn game = - not (isWitchsTurn game) + hasn't (stage . _WitchsTurn) game ==> forAll (arbitraryPoisonCommand game) $ verbose_runCommandErrors game . getBlind prop_poisonCommandErrorsWhenCallerHasPoisoned :: GameWithPoison -> Property prop_poisonCommandErrorsWhenCallerHasPoisoned (GameWithPoison game) = do - let witch = findByRole_ witchRole (game ^. players) + let witch = game ^?! players . witches forAll (arbitraryPlayer game) $ \target -> do let command = poisonCommand (witch ^. name) (target ^. name) @@ -484,7 +480,7 @@ prop_poisonCommandErrorsWhenCallerNotWitch :: GameAtWitchsTurn -> Property prop_poisonCommandErrorsWhenCallerNotWitch (GameAtWitchsTurn game) = - forAll (suchThat (arbitraryPlayer game) (not . isWitch)) $ \caller -> + forAll (suchThat (arbitraryPlayer game) (isn't witch)) $ \caller -> forAll (arbitraryPlayer game) $ \target -> do let command = poisonCommand (caller ^. name) (target ^. name) @@ -514,7 +510,7 @@ prop_protectCommandErrorsWhenTargetDoesNotExist :: GameAtDefendersTurn -> Player -> Property prop_protectCommandErrorsWhenTargetDoesNotExist (GameAtDefendersTurn game) target = do - let defender = findByRole_ defenderRole (game ^. players) + let defender = game ^?! players . defenders let command = protectCommand (defender ^. name) (target ^. name) not (doesPlayerExist (target ^. name) game) @@ -522,7 +518,7 @@ prop_protectCommandErrorsWhenCallerIsDead :: GameAtDefendersTurn -> Property prop_protectCommandErrorsWhenCallerIsDead (GameAtDefendersTurn game) = do - let defender = findByRole_ defenderRole (game ^. players) + let defender = game ^?! players . defenders let game' = killPlayer (defender ^. name) game forAll (arbitraryPlayer game') $ \target -> do @@ -532,7 +528,7 @@ prop_protectCommandErrorsWhenTargetIsDead :: GameAtDefendersTurn -> Property prop_protectCommandErrorsWhenTargetIsDead (GameAtDefendersTurn game) = do - let defender = findByRole_ defenderRole (game ^. players) + let defender = game ^?! players . defenders forAll (arbitraryPlayer game) $ \target -> do let game' = killPlayer (target ^. name) game @@ -542,12 +538,12 @@ prop_protectCommandErrorsWhenNotDefendersTurn :: Game -> Property prop_protectCommandErrorsWhenNotDefendersTurn game = - not (isDefendersTurn game) + hasn't (stage . _DefendersTurn) game ==> forAll (arbitraryProtectCommand game) $ verbose_runCommandErrors game . getBlind prop_protectCommandErrorsWhenCallerNotDefender :: GameAtDefendersTurn -> Property prop_protectCommandErrorsWhenCallerNotDefender (GameAtDefendersTurn game) = - forAll (suchThat (arbitraryPlayer game) (not . isDefender)) $ \caller -> + forAll (suchThat (arbitraryPlayer game) (isn't defender)) $ \caller -> forAll (arbitraryPlayer game) $ \target -> do let command = protectCommand (caller ^. name) (target ^. name) @@ -557,7 +553,7 @@ prop_protectCommandErrorsWhenTargetIsPriorProtect (GameWithProtect game) = do let game' = game & protect .~ Nothing - let defender = findByRole_ defenderRole (game' ^. players) + let defender = game ^?! players . defenders let command = protectCommand (defender ^. name) (fromJust $ game' ^. priorProtect) verbose_runCommandErrors game' command @@ -591,50 +587,57 @@ prop_quitCommandKillsPlayer :: Game -> Property prop_quitCommandKillsPlayer game = - not (isGameOver game) + hasn't (stage . _GameOver) game ==> forAll (arbitraryQuitCommand game) $ \(Blind command) -> do let game' = run_ (apply command) game - length (filterDead $ game' ^. players) == 1 + length (game' ^.. players . traverse . dead) == 1 +prop_quitCommandClearsAllegianceChosenWhenCallerIsWolfHound :: GameWithAllegianceChosen -> Bool +prop_quitCommandClearsAllegianceChosenWhenCallerIsWolfHound (GameWithAllegianceChosen game) = do + let wolfHoundsName = game ^?! players . wolfHounds . name + let command = quitCommand wolfHoundsName + + isNothing $ run_ (apply command) game ^. allegianceChosen + prop_quitCommandClearsHealWhenCallerIsWitch :: GameWithHeal -> Bool prop_quitCommandClearsHealWhenCallerIsWitch (GameWithHeal game) = do - let witch = findByRole_ witchRole (game ^. players) + let witch = game ^?! players . witches let command = quitCommand (witch ^. name) not $ run_ (apply command) game ^. heal prop_quitCommandClearsHealUsedWhenCallerIsWitch :: GameWithHeal -> Bool prop_quitCommandClearsHealUsedWhenCallerIsWitch (GameWithHeal game) = do - let witch = findByRole_ witchRole (game ^. players) + let witch = game ^?! players . witches let command = quitCommand (witch ^. name) not $ run_ (apply command) game ^. healUsed prop_quitCommandClearsPoisonWhenCallerIsWitch :: GameWithPoison -> Bool prop_quitCommandClearsPoisonWhenCallerIsWitch (GameWithPoison game) = do - let witch = findByRole_ witchRole (game ^. players) + let witch = game ^?! players . witches let command = quitCommand (witch ^. name) isNothing $ run_ (apply command) game ^. poison prop_quitCommandClearsPoisonUsedWhenCallerIsWitch :: GameWithPoison -> Bool prop_quitCommandClearsPoisonUsedWhenCallerIsWitch (GameWithPoison game) = do - let witch = findByRole_ witchRole (game ^. players) + let witch = game ^?! players . witches let command = quitCommand (witch ^. name) not $ run_ (apply command) game ^. poisonUsed prop_quitCommandClearsPriorProtectWhenCallerIsDefender :: GameWithProtect -> Bool prop_quitCommandClearsPriorProtectWhenCallerIsDefender (GameWithProtect game) = do - let defender = findByRole_ defenderRole (game ^. players) + let defender = game ^?! players . defenders let command = quitCommand (defender ^. name) isNothing $ run_ (apply command) game ^. priorProtect prop_quitCommandClearsProtectWhenCallerIsDefender :: GameWithProtect -> Bool prop_quitCommandClearsProtectWhenCallerIsDefender (GameWithProtect game) = do - let defender = findByRole_ defenderRole (game ^. players) + let defender = game ^?! players . defenders let command = quitCommand (defender ^. name) isNothing $ run_ (apply command) game ^. protect @@ -655,17 +658,18 @@ prop_quitCommandClearsRoleModelWhenCallerIsWildChild :: GameWithRoleModel -> Bool prop_quitCommandClearsRoleModelWhenCallerIsWildChild (GameWithRoleModel game) = do - let wildChild = findByRole_ wildChildRole (game ^. players) + let wildChild = game ^?! players . wildChildren let command = quitCommand (wildChild ^. name) isNothing $ run_ (apply command) game ^. roleModel -prop_quitCommandSetsAngelsRoleWhenCallerIsAngel :: Game -> Bool -prop_quitCommandSetsAngelsRoleWhenCallerIsAngel game = do - let angel = findByRole_ angelRole (game ^. players) - let command = quitCommand (angel ^. name) +prop_quitCommandSetsAngelsAllegianceWhenCallerIsAngel :: Game -> Bool +prop_quitCommandSetsAngelsAllegianceWhenCallerIsAngel game = do + let angelsName = game ^?! players . angels . name + let command = quitCommand angelsName + let game' = run_ (apply command) game - isSimpleVillager $ findByName_ (angel ^. name) (run_ (apply command) game ^. players) + is villager $ game' ^?! players . angels prop_seeCommandErrorsWhenGameIsOver :: GameAtGameOver -> Property prop_seeCommandErrorsWhenGameIsOver (GameAtGameOver game) = @@ -681,7 +685,7 @@ prop_seeCommandErrorsWhenTargetDoesNotExist :: GameAtSeersTurn -> Player -> Property prop_seeCommandErrorsWhenTargetDoesNotExist (GameAtSeersTurn game) target = do - let seer = findByRole_ seerRole (game ^. players) + let seer = game ^?! players . seers let command = seeCommand (seer ^. name) (target ^. name) not (doesPlayerExist (target ^. name) game) @@ -689,7 +693,7 @@ prop_seeCommandErrorsWhenCallerIsDead :: GameAtSeersTurn -> Property prop_seeCommandErrorsWhenCallerIsDead (GameAtSeersTurn game) = do - let seer = findByRole_ seerRole (game ^. players) + let seer = game ^?! players . seers let game' = killPlayer (seer ^. name) game forAll (arbitraryPlayer game') $ \target -> do @@ -699,7 +703,7 @@ prop_seeCommandErrorsWhenTargetIsDead :: GameAtSeersTurn -> Property prop_seeCommandErrorsWhenTargetIsDead (GameAtSeersTurn game) = do - let seer = findByRole_ seerRole (game ^. players) + let seer = game ^?! players . seers forAll (arbitraryPlayer game) $ \target -> do let game' = killPlayer (target ^. name) game @@ -709,12 +713,12 @@ prop_seeCommandErrorsWhenNotSeersTurn :: Game -> Property prop_seeCommandErrorsWhenNotSeersTurn game = - not (isSeersTurn game) + hasn't (stage . _SeersTurn) game ==> forAll (arbitrarySeeCommand game) $ verbose_runCommandErrors game . getBlind prop_seeCommandErrorsWhenCallerNotSeer :: GameAtSeersTurn -> Property prop_seeCommandErrorsWhenCallerNotSeer (GameAtSeersTurn game) = - forAll (suchThat (arbitraryPlayer game) (not . isSeer)) $ \caller -> + forAll (suchThat (arbitraryPlayer game) (isn't seer)) $ \caller -> forAll (arbitraryPlayer game) $ \target -> do let command = seeCommand (caller ^. name) (target ^. name) @@ -765,12 +769,12 @@ prop_voteDevourCommandErrorsWhenNotWerewolvesTurn :: Game -> Property prop_voteDevourCommandErrorsWhenNotWerewolvesTurn game = - not (isWerewolvesTurn game) + hasn't (stage . _WerewolvesTurn) game ==> forAll (arbitraryVoteDevourCommand game) $ verbose_runCommandErrors game . getBlind prop_voteDevourCommandErrorsWhenCallerNotWerewolf :: GameAtWerewolvesTurn -> Property prop_voteDevourCommandErrorsWhenCallerNotWerewolf (GameAtWerewolvesTurn game) = - forAll (suchThat (arbitraryPlayer game) (not . isWerewolf)) $ \caller -> + forAll (suchThat (arbitraryPlayer game) (isn't werewolf)) $ \caller -> forAll (arbitraryPlayer game) $ \target -> do let command = voteDevourCommand (caller ^. name) (target ^. name) @@ -779,7 +783,7 @@ prop_voteDevourCommandErrorsWhenCallerHasVoted :: GameWithDevourVotes -> Property prop_voteDevourCommandErrorsWhenCallerHasVoted (GameWithDevourVotes game) = forAll (arbitraryWerewolf game) $ \caller -> - forAll (suchThat (arbitraryPlayer game) (not . isWerewolf)) $ \target -> do + forAll (suchThat (arbitraryPlayer game) (isn't werewolf)) $ \target -> do let command = voteDevourCommand (caller ^. name) (target ^. name) verbose_runCommandErrors game command @@ -837,7 +841,7 @@ prop_voteLynchCommandErrorsWhenNotVillagesTurn :: Game -> Property prop_voteLynchCommandErrorsWhenNotVillagesTurn game = - not (isVillagesTurn game) + hasn't (stage . _VillagesTurn) game ==> forAll (arbitraryVoteLynchCommand game) $ verbose_runCommandErrors game . getBlind prop_voteLynchCommandErrorsWhenCallerHasVoted :: GameWithLynchVotes -> Property @@ -865,7 +869,16 @@ verbose_runCommandErrors game command where - caller = findByRole_ villageIdiotRole (game ^. players) + caller = game ^?! players . villageIdiots + +prop_voteLynchCommandErrorsWhenTargetIsKnownVillageIdiot :: GameWithVillageIdiotRevealedAtVillagesTurn -> Property +prop_voteLynchCommandErrorsWhenTargetIsKnownVillageIdiot (GameWithVillageIdiotRevealedAtVillagesTurn game) = + forAll (arbitraryPlayer game) $ \caller -> do + let command = voteLynchCommand (caller ^. name) (target ^. name) + + verbose_runCommandErrors game command + where + target = game ^?! players . villageIdiots prop_voteLynchCommandUpdatesVotes :: GameAtVillagesTurn -> Property prop_voteLynchCommandUpdatesVotes (GameAtVillagesTurn game) = 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 @@ -5,7 +5,6 @@ Maintainer : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-} {-# LANGUAGE OverloadedStrings #-} module Game.Werewolf.Test.Engine ( @@ -13,7 +12,7 @@ allEngineTests, ) where -import Control.Lens hiding (elements) +import Control.Lens hiding (elements, isn't) import Control.Monad.Except import Control.Monad.Writer @@ -21,25 +20,18 @@ import Data.List.Extra import qualified Data.Map as Map import Data.Maybe -import Data.Text (Text) -import Game.Werewolf.Command -import Game.Werewolf.Engine hiding (doesPlayerExist, getDevourEvent, - getVoteResult, isDefendersTurn, isGameOver, - isScapegoatsTurn, isSeersTurn, isVillagesTurn, - isWerewolvesTurn, isWildChildsTurn, isWitchsTurn, - isWolfHoundsTurn, killPlayer) -import Game.Werewolf.Internal.Game -import Game.Werewolf.Internal.Player -import Game.Werewolf.Internal.Role hiding (name) -import qualified Game.Werewolf.Internal.Role as Role -import Game.Werewolf.Test.Arbitrary -import Game.Werewolf.Test.Util +import Game.Werewolf.Command +import Game.Werewolf.Engine +import Game.Werewolf.Game +import Game.Werewolf.Player +import Game.Werewolf.Role hiding (name) +import Game.Werewolf.Test.Arbitrary +import Game.Werewolf.Test.Util import Prelude hiding (round) import Test.QuickCheck -import Test.QuickCheck.Monadic import Test.Tasty import Test.Tasty.QuickCheck @@ -54,11 +46,11 @@ , testProperty "check stage skips wolf-hound's turn when no wolf-hound" prop_checkStageSkipsWolfHoundsTurnWhenNoWolfHound , testProperty "check stage does nothing when game over" prop_checkStageDoesNothingWhenGameOver - , testProperty "check defender's turn advances to wolf-hound's turn" prop_checkDefendersTurnAdvancesToWolfHoundsTurn + , 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 scapegoat's turn advances to seer's turn" prop_checkScapegoatsTurnAdvancesToSeersTurn + , testProperty "check scapegoat's turn advances to wolf-hound's turn" prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn , testProperty "check scapegoat's turn does nothing while scapegoat blamed" prop_checkScapegoatsTurnDoesNothingWhileScapegoatBlamed , testProperty "check seer's turn advances to wild-child's turn" prop_checkSeersTurnAdvancesToWildChildsTurn @@ -66,8 +58,8 @@ , testProperty "check seer's turn resets sees" prop_checkSeersTurnResetsSee , testProperty "check seer's turn does nothing unless seen" prop_checkSeersTurnDoesNothingUnlessSeen - , testProperty "check sunrise increments round" prop_checkSunriseIncrementsRound - , testProperty "check sunrise sets angel's role" prop_checkSunriseSetsAngelsRole + , testProperty "check sunrise increments round" prop_checkSunriseIncrementsRound + , testProperty "check sunrise sets angel's allegiance" prop_checkSunriseSetsAngelsAllegiance , testProperty "check sunset sets wild-child's allegiance when role model dead" prop_checkSunsetSetsWildChildsAllegianceWhenRoleModelDead @@ -103,116 +95,111 @@ , testProperty "check witch's turn resets poison" prop_checkWitchsTurnResetsPoison , testProperty "check witch's turn clears passes" prop_checkWitchsTurnClearsPasses - , testProperty "check wolf-hound's turn advances to werewolves' turn" prop_checkWolfHoundsTurnAdvancesToWerewolvesTurn - , testProperty "check wolf-hound's turn advances when no wolf-hound" prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound - , testProperty "check wolf-hound's turn does nothing unless chosen" prop_checkWolfHoundsTurnDoesNothingUnlessChosen + , testProperty "check wolf-hound's turn advances to seer's turn" prop_checkWolfHoundsTurnAdvancesToSeersTurn + , testProperty "check wolf-hound's turn advances when no wolf-hound" prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound + , testProperty "check wolf-hound's turn sets wolf-hound's allegiance" prop_checkWolfHoundsTurnSetsWolfHoundsAllegiance + , testProperty "check wolf-hound's turn does nothing unless allegiance chosen" prop_checkWolfHoundsTurnDoesNothingUnlessAllegianceChosen - , testProperty "check game over advances stage when zero allegiances alive" prop_checkGameOverAdvancesStageWhenZeroAllegiancesAlive - , testProperty "check game over advances stage when one allegiance alive" prop_checkGameOverAdvancesStageWhenOneAllegianceAlive + , testProperty "check game over advances stage when one allegiance alive" prop_checkGameOverAdvancesStageWhenOneAllegianceAlive -- TODO (hjw): pending --, testProperty "check game over does nothing when at least two allegiances alive" prop_checkGameOverDoesNothingWhenAtLeastTwoAllegiancesAlive - , testProperty "check game over advances stage when second round and angel dead" prop_checkGameOverAdvancesStageWhenSecondRoundAndAngelDead + , testProperty "check game over advances stage when after first round and angel dead" prop_checkGameOverAdvancesStageWhenAfterFirstRoundAndAngelDead + , testProperty "check game over does nothing when angel dead but aligned with villagers" prop_checkGameOverDoesNothingWhenAngelDeadButAlignedWithVillagers , testProperty "start game uses given players" prop_startGameUsesGivenPlayers , testProperty "start game errors unless unique player names" prop_startGameErrorsUnlessUniquePlayerNames , testProperty "start game errors when less than 7 players" prop_startGameErrorsWhenLessThan7Players , testProperty "start game errors when more than 24 players" prop_startGameErrorsWhenMoreThan24Players , testProperty "start game errors when more than 1 of a restricted role" prop_startGameErrorsWhenMoreThan1OfARestrictedRole - - , testProperty "create players uses given player names" prop_createPlayersUsesGivenPlayerNames - , testProperty "create players uses given roles" prop_createPlayersUsesGivenRoles - , testProperty "create players creates alive players" prop_createPlayersCreatesAlivePlayers - - , testProperty "pad roles returns n roles" prop_padRolesReturnsNRoles - , testProperty "pad roles uses given roles" prop_padRolesUsesGivenRoles - , testProperty "pad roles proportions allegiances" prop_padRolesProportionsAllegiances ] prop_checkStageSkipsDefendersTurnWhenNoDefender :: GameWithRoleModel -> Bool prop_checkStageSkipsDefendersTurnWhenNoDefender (GameWithRoleModel game) = - isWolfHoundsTurn $ run_ checkStage game' + hasn't (stage . _DefendersTurn) game' where - defendersName = findByRole_ defenderRole (game ^. players) ^. name - game' = killPlayer defendersName game + defendersName = game ^?! players . defenders . name + game' = run_ (apply (quitCommand defendersName) >> checkStage) game -prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat :: GameAtScapegoatsTurn -> Bool -prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat (GameAtScapegoatsTurn game) = - isScapegoatsTurn $ run_ checkStage game +prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat :: GameWithLynchVotes -> Bool +prop_checkStageSkipsScapegoatsTurnWhenNoScapegoat (GameWithLynchVotes game) = + hasn't (stage . _ScapegoatsTurn) game' + where + scapegoatsName = game ^?! players . scapegoats . name + game' = run_ (apply (quitCommand scapegoatsName) >> checkStage) game -prop_checkStageSkipsSeersTurnWhenNoSeer :: GameWithLynchVotes -> Property +prop_checkStageSkipsSeersTurnWhenNoSeer :: GameWithLynchVotes -> Bool prop_checkStageSkipsSeersTurnWhenNoSeer (GameWithLynchVotes game) = - isAlive (findByRole_ angelRole $ run_ checkStage game' ^. players) - ==> isScapegoatsTurn game' || isWildChildsTurn game' || isDefendersTurn game' + hasn't (stage . _SeersTurn) game' where - seersName = findByRole_ seerRole (game ^. players) ^. name + seersName = game ^?! players . seers . name game' = run_ (apply (quitCommand seersName) >> checkStage) game prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty :: GameAtWitchsTurn -> Property prop_checkStageSkipsVillagesTurnWhenAllowedVotersEmpty (GameAtWitchsTurn game) = forAll (arbitraryPassCommand game') $ \(Blind passCommand) -> do - isSeersTurn $ run_ (apply passCommand >> checkStage) game' + hasn't (stage . _VillagesTurn) (run_ (apply passCommand >> checkStage) game') where game' = game & allowedVoters .~ [] prop_checkStageSkipsWildChildsTurnWhenNoWildChild :: GameWithSee -> Bool prop_checkStageSkipsWildChildsTurnWhenNoWildChild (GameWithSee game) = - isDefendersTurn $ run_ checkStage game' + hasn't (stage . _WildChildsTurn) game' where - wildChildsName = findByRole_ wildChildRole (game ^. players) ^. name - game' = killPlayer wildChildsName game + wildChildsName = game ^?! players . wildChildren . name + game' = run_ (apply (quitCommand wildChildsName) >> checkStage) game prop_checkStageSkipsWitchsTurnWhenNoWitch :: GameWithDevourVotes -> Property prop_checkStageSkipsWitchsTurnWhenNoWitch (GameWithDevourVotes game) = - isNothing (findByRole angelRole $ run_ checkStage game' ^. players) - ==> isVillagesTurn $ run_ checkStage game' + null (run_ checkStage game' ^.. players . angels . dead) + ==> hasn't (stage . _WitchsTurn) game' where - witchsName = findByRole_ witchRole (game ^. players) ^. name - game' = killPlayer witchsName game + witchsName = game ^?! players . witches . name + game' = run_ (apply (quitCommand witchsName) >> checkStage) game prop_checkStageSkipsWolfHoundsTurnWhenNoWolfHound :: GameWithProtect -> Bool prop_checkStageSkipsWolfHoundsTurnWhenNoWolfHound (GameWithProtect game) = - isWerewolvesTurn $ run_ checkStage game' + hasn't (stage . _WolfHoundsTurn) game' where - wolfHoundsName = findByRole_ wolfHoundRole (game ^. players) ^. name - game' = killPlayer wolfHoundsName game + wolfHoundsName = game ^?! players . wolfHounds . name + game' = run_ (apply (quitCommand wolfHoundsName) >> checkStage) game prop_checkStageDoesNothingWhenGameOver :: GameAtGameOver -> Property prop_checkStageDoesNothingWhenGameOver (GameAtGameOver game) = run_ checkStage game === game -prop_checkDefendersTurnAdvancesToWolfHoundsTurn :: GameWithProtect -> Bool -prop_checkDefendersTurnAdvancesToWolfHoundsTurn (GameWithProtect game) = - isWolfHoundsTurn $ run_ 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 = findByRole_ defenderRole (game ^. players) + let defender = game ^?! players . defenders let command = quitCommand $ defender ^. name - not . isDefendersTurn $ run_ (apply command >> checkStage) game + hasn't (stage . _DefendersTurn) (run_ (apply command >> checkStage) game) prop_checkDefendersTurnDoesNothingUnlessProtected :: GameAtDefendersTurn -> Bool prop_checkDefendersTurnDoesNothingUnlessProtected (GameAtDefendersTurn game) = - isDefendersTurn $ run_ checkStage game + has (stage . _DefendersTurn) (run_ checkStage game) -prop_checkScapegoatsTurnAdvancesToSeersTurn :: GameWithAllowedVoters -> Bool -prop_checkScapegoatsTurnAdvancesToSeersTurn (GameWithAllowedVoters game) = - isSeersTurn $ run_ checkStage game +prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn :: GameWithAllowedVoters -> Bool +prop_checkScapegoatsTurnAdvancesToWolfHoundsTurn (GameWithAllowedVoters game) = + has (stage . _WolfHoundsTurn) (run_ checkStage game) prop_checkScapegoatsTurnDoesNothingWhileScapegoatBlamed :: GameAtScapegoatsTurn -> Bool prop_checkScapegoatsTurnDoesNothingWhileScapegoatBlamed (GameAtScapegoatsTurn game) = - isScapegoatsTurn $ run_ checkStage game + has (stage . _ScapegoatsTurn) (run_ checkStage game) prop_checkSeersTurnAdvancesToWildChildsTurn :: GameWithSee -> Bool prop_checkSeersTurnAdvancesToWildChildsTurn (GameWithSee game) = - isWildChildsTurn $ run_ checkStage game + has (stage . _WildChildsTurn) (run_ checkStage game) prop_checkSeersTurnAdvancesWhenNoSeer :: GameAtSeersTurn -> Bool prop_checkSeersTurnAdvancesWhenNoSeer (GameAtSeersTurn game) = do - let seer = findByRole_ seerRole (game ^. players) + let seer = game ^?! players . seers let command = quitCommand $ seer ^. name - not . isSeersTurn $ run_ (apply command >> checkStage) game + hasn't (stage . _SeersTurn) (run_ (apply command >> checkStage) game) prop_checkSeersTurnResetsSee :: GameWithSee -> Bool prop_checkSeersTurnResetsSee (GameWithSee game) = @@ -220,37 +207,36 @@ prop_checkSeersTurnDoesNothingUnlessSeen :: GameAtSeersTurn -> Bool prop_checkSeersTurnDoesNothingUnlessSeen (GameAtSeersTurn game) = - isSeersTurn $ run_ checkStage game + has (stage . _SeersTurn) (run_ checkStage game) prop_checkSunriseIncrementsRound :: GameAtSunrise -> Property prop_checkSunriseIncrementsRound (GameAtSunrise game) = run_ checkStage game ^. round === game ^. round + 1 -prop_checkSunriseSetsAngelsRole :: GameAtSunrise -> Bool -prop_checkSunriseSetsAngelsRole (GameAtSunrise game) = do - let angel = findByRole_ angelRole (game ^. players) +prop_checkSunriseSetsAngelsAllegiance :: GameAtSunrise -> Bool +prop_checkSunriseSetsAngelsAllegiance (GameAtSunrise game) = do let game' = run_ checkStage game - isSimpleVillager $ findByName_ (angel ^. name) (game' ^. players) + is villager $ game' ^?! players . angels prop_checkSunsetSetsWildChildsAllegianceWhenRoleModelDead :: GameWithRoleModelAtVillagesTurn -> Property prop_checkSunsetSetsWildChildsAllegianceWhenRoleModelDead (GameWithRoleModelAtVillagesTurn game) = do let game' = foldr (\player -> run_ (apply $ voteLynchCommand (player ^. name) (roleModel' ^. name))) game (game ^. players) - not (isAngel roleModel' || isVillageIdiot roleModel') - ==> isWerewolf $ findByRole_ wildChildRole (run_ checkStage game' ^. players) + isn't angel roleModel' && isn't villageIdiot roleModel' + ==> is werewolf $ run_ checkStage game' ^?! players . wildChildren where - roleModel' = findByName_ (fromJust $ game ^. roleModel) (game ^. players) + roleModel' = game ^?! players . traverse . filteredBy name (fromJust $ game ^. roleModel) prop_checkVillagesTurnAdvancesToScapegoatsTurn :: GameWithScapegoatBlamed -> Bool prop_checkVillagesTurnAdvancesToScapegoatsTurn (GameWithScapegoatBlamed game) = - isScapegoatsTurn $ run_ checkStage game + has (stage . _ScapegoatsTurn) (run_ checkStage game) prop_checkVillagesTurnLynchesOnePlayerWhenConsensus :: GameWithLynchVotes -> Property prop_checkVillagesTurnLynchesOnePlayerWhenConsensus (GameWithLynchVotes game) = length (getVoteResult game) == 1 - && not (isVillageIdiot target) - ==> length (filterDead $ run_ checkStage game ^. players) == 1 + && isn't villageIdiot target + ==> length (run_ checkStage game ^.. players . traverse . dead) == 1 where target = head $ getVoteResult game @@ -258,24 +244,24 @@ prop_checkVillagesTurnLynchesNoOneWhenTargetIsVillageIdiot (GameAtVillagesTurn game) = do let game' = foldr (\player -> run_ (apply $ voteLynchCommand (player ^. name) (villageIdiot ^. name))) game (game ^. players) - null . filterDead $ run_ checkStage game' ^. players + none (is dead) (run_ checkStage game' ^. players) where - villageIdiot = findByRole_ villageIdiotRole (game ^. players) + villageIdiot = game ^?! players . villageIdiots -- TODO (hjw): tidy this test prop_checkVillagesTurnLynchesNoOneWhenConflictedAndNoScapegoats :: Game -> Property prop_checkVillagesTurnLynchesNoOneWhenConflictedAndNoScapegoats game = forAll (runArbitraryCommands n game') $ \game'' -> length (getVoteResult game'') > 1 - ==> length (filterDead $ run_ checkStage game'' ^. players) == length (filterDead $ game' ^. players) + ==> run_ checkStage game'' ^. players == game' ^. players where - scapegoatsName = findByRole_ scapegoatRole (game ^. players) ^. name + scapegoatsName = game ^?! players . scapegoats . name game' = killPlayer scapegoatsName game & stage .~ VillagesTurn n = length $ game' ^. players prop_checkVillagesTurnLynchesScapegoatWhenConflicted :: GameAtScapegoatsTurn -> Bool prop_checkVillagesTurnLynchesScapegoatWhenConflicted (GameAtScapegoatsTurn game) = - isDead . findByRole_ scapegoatRole $ run_ checkStage game ^. players + is dead $ run_ checkStage game ^?! players . scapegoats prop_checkVillagesTurnResetsVotes :: GameWithLynchVotes -> Bool prop_checkVillagesTurnResetsVotes (GameWithLynchVotes game) = @@ -283,45 +269,45 @@ prop_checkVillagesTurnSetsAllowedVoters :: GameWithLynchVotes -> Property prop_checkVillagesTurnSetsAllowedVoters (GameWithLynchVotes game) = - game' ^. allowedVoters === map (view name) expectedAllowedVoters + game' ^. allowedVoters === expectedAllowedVoters ^.. names where game' = run_ checkStage game expectedAllowedVoters - | game' ^. villageIdiotRevealed = filter (not . isVillageIdiot) $ game' ^. players - | otherwise = filterAlive $ game' ^. players + | game' ^. villageIdiotRevealed = filter (isn't villageIdiot) $ game' ^. players + | otherwise = game' ^.. players . traverse . alive prop_checkVillagesTurnDoesNothingUnlessAllVoted :: GameAtVillagesTurn -> Property prop_checkVillagesTurnDoesNothingUnlessAllVoted (GameAtVillagesTurn game) = forAll (runArbitraryCommands n game) $ \game' -> - isVillagesTurn $ run_ checkStage game' + has (stage . _VillagesTurn) (run_ checkStage game') where n = length (game ^. players) - 1 prop_checkWerewolvesTurnAdvancesToWitchsTurn :: GameWithDevourVotes -> Property prop_checkWerewolvesTurnAdvancesToWitchsTurn (GameWithDevourVotes game) = length (getVoteResult game) == 1 - ==> isWitchsTurn $ run_ checkStage game + ==> has (stage . _WitchsTurn) (run_ checkStage game) prop_checkWerewolvesTurnSkipsWitchsTurnWhenHealedAndPoisoned :: GameWithDevourVotes -> Bool prop_checkWerewolvesTurnSkipsWitchsTurnWhenHealedAndPoisoned (GameWithDevourVotes game) = - not . isWitchsTurn $ run_ checkStage game' + hasn't (stage . _WitchsTurn) (run_ checkStage game') where game' = game & healUsed .~ True & poisonUsed .~ True prop_checkWerewolvesTurnKillsOnePlayerWhenConsensus :: GameWithDevourVotes -> Property prop_checkWerewolvesTurnKillsOnePlayerWhenConsensus (GameWithDevourVotes game) = length (getVoteResult game) == 1 - ==> isJust . getDevourEvent $ run_ checkStage game + ==> has (events . traverse . _DevourEvent) (run_ checkStage game) prop_checkWerewolvesTurnKillsNoOneWhenConflicted :: GameWithDevourVotes -> Property prop_checkWerewolvesTurnKillsNoOneWhenConflicted (GameWithDevourVotes game) = length (getVoteResult game) > 1 - ==> isNothing . getDevourEvent $ run_ checkStage game + ==> hasn't (events . traverse . _DevourEvent) (run_ checkStage game) prop_checkWerewolvesTurnKillsNoOneWhenTargetDefended :: GameWithProtectAndDevourVotes -> Property prop_checkWerewolvesTurnKillsNoOneWhenTargetDefended (GameWithProtectAndDevourVotes game) = length (getVoteResult game) == 1 - ==> isNothing . getDevourEvent $ run_ checkStage game' + ==> hasn't (events . traverse . _DevourEvent) (run_ checkStage game') where target = head $ getVoteResult game game' = game & protect .~ Just (target ^. name) @@ -337,56 +323,56 @@ prop_checkWerewolvesTurnDoesNothingUnlessAllVoted :: GameAtWerewolvesTurn -> Property prop_checkWerewolvesTurnDoesNothingUnlessAllVoted (GameAtWerewolvesTurn game) = forAll (runArbitraryCommands n game) $ \game' -> - isWerewolvesTurn $ run_ checkStage game' + has (stage . _WerewolvesTurn) (run_ checkStage game') where - n = length (filterWerewolves $ game ^. players) - 1 + n = length (game ^.. players . werewolves) - 1 prop_checkWildChildsTurnAdvancesToDefendersTurn :: GameAtWildChildsTurn -> Property prop_checkWildChildsTurnAdvancesToDefendersTurn (GameAtWildChildsTurn game) = forAll (arbitraryChoosePlayerCommand game) $ \(Blind command) -> - isDefendersTurn $ run_ (apply command >> checkStage) game + has (stage . _DefendersTurn) (run_ (apply command >> checkStage) game) prop_checkWildChildsTurnAdvancesWhenNoWildChild :: GameAtWildChildsTurn -> Bool prop_checkWildChildsTurnAdvancesWhenNoWildChild (GameAtWildChildsTurn game) = do - let wildChild = findByRole_ wildChildRole (game ^. players) + let wildChild = game ^?! players . wildChildren let command = quitCommand $ wildChild ^. name - not . isWildChildsTurn $ run_ (apply command >> checkStage) game + hasn't (stage . _WildChildsTurn) (run_ (apply command >> checkStage) game) prop_checkWildChildsTurnDoesNothingUnlessRoleModelChosen :: GameAtWildChildsTurn -> Bool prop_checkWildChildsTurnDoesNothingUnlessRoleModelChosen (GameAtWildChildsTurn game) = - isWildChildsTurn $ run_ checkStage game + has (stage . _WildChildsTurn) (run_ checkStage game) prop_checkWitchsTurnAdvancesToVillagesTurn :: GameAtWitchsTurn -> Property prop_checkWitchsTurnAdvancesToVillagesTurn (GameAtWitchsTurn game) = forAll (arbitraryPassCommand game) $ \(Blind command) -> - isVillagesTurn $ run_ (apply command >> checkStage) game + has (stage . _VillagesTurn) (run_ (apply command >> checkStage) game) prop_checkWitchsTurnAdvancesWhenNoWitch :: GameAtWitchsTurn -> Bool prop_checkWitchsTurnAdvancesWhenNoWitch (GameAtWitchsTurn game) = do - let witch = findByRole_ witchRole (game ^. players) + let witch = game ^?! players . witches let command = quitCommand $ witch ^. name - not . isWitchsTurn $ run_ (apply command >> checkStage) game + hasn't (stage . _WitchsTurn) (run_ (apply command >> checkStage) game) prop_checkWitchsTurnHealsDevoureeWhenHealed :: GameWithHeal -> Property prop_checkWitchsTurnHealsDevoureeWhenHealed (GameWithHeal game) = forAll (arbitraryPassCommand game) $ \(Blind command) -> - null . filterDead $ run_ (apply command >> checkStage) game ^. players + none (is dead) (run_ (apply command >> checkStage) game ^. players) prop_checkWitchsTurnKillsOnePlayerWhenPoisoned :: GameWithPoison -> Property prop_checkWitchsTurnKillsOnePlayerWhenPoisoned (GameWithPoison game) = forAll (arbitraryPassCommand game) $ \(Blind command) -> - length (filterDead $ run_ (apply command >> checkStage) game ^. players) == 1 + length (run_ (apply command >> checkStage) game ^.. players . traverse . dead) == 1 prop_checkWitchsTurnDoesNothingWhenPassed :: GameAtWitchsTurn -> Property prop_checkWitchsTurnDoesNothingWhenPassed (GameAtWitchsTurn game) = forAll (arbitraryPassCommand game) $ \(Blind command) -> - null . filterDead $ run_ (apply command >> checkStage) game ^. players + none (is dead) $ run_ (apply command >> checkStage) game ^. players prop_checkWitchsTurnDoesNothingUnlessActionedOrPassed :: GameAtWitchsTurn -> Bool prop_checkWitchsTurnDoesNothingUnlessActionedOrPassed (GameAtWitchsTurn game) = - isWitchsTurn $ run_ checkStage game + has (stage . _WitchsTurn) (run_ checkStage game) prop_checkWitchsTurnResetsHeal :: GameWithHeal -> Property prop_checkWitchsTurnResetsHeal (GameWithHeal game) = @@ -403,46 +389,55 @@ forAll (arbitraryPassCommand game) $ \(Blind command) -> null $ run_ (apply command >> checkStage) game ^. passes -prop_checkWolfHoundsTurnAdvancesToWerewolvesTurn :: GameAtWolfHoundsTurn -> Property -prop_checkWolfHoundsTurnAdvancesToWerewolvesTurn (GameAtWolfHoundsTurn game) = +prop_checkWolfHoundsTurnAdvancesToSeersTurn :: GameAtWolfHoundsTurn -> Property +prop_checkWolfHoundsTurnAdvancesToSeersTurn (GameAtWolfHoundsTurn game) = forAll (arbitraryChooseAllegianceCommand game) $ \(Blind command) -> - isWerewolvesTurn $ run_ (apply command >> checkStage) game + has (stage . _SeersTurn) (run_ (apply command >> checkStage) game) prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound :: GameAtWolfHoundsTurn -> Bool prop_checkWolfHoundsTurnAdvancesWhenNoWolfHound (GameAtWolfHoundsTurn game) = do - let wolfHound = findByRole_ wolfHoundRole (game ^. players) + let wolfHound = game ^?! players . wolfHounds let command = quitCommand $ wolfHound ^. name - not . isWolfHoundsTurn $ run_ (apply command >> checkStage) game + hasn't (stage . _WolfHoundsTurn) (run_ (apply command >> checkStage) game) -prop_checkWolfHoundsTurnDoesNothingUnlessChosen :: GameAtWolfHoundsTurn -> Bool -prop_checkWolfHoundsTurnDoesNothingUnlessChosen (GameAtWolfHoundsTurn game) = - isWolfHoundsTurn $ run_ checkStage game +prop_checkWolfHoundsTurnSetsWolfHoundsAllegiance :: GameWithAllegianceChosen -> Property +prop_checkWolfHoundsTurnSetsWolfHoundsAllegiance (GameWithAllegianceChosen game) = + game' ^?! players . wolfHounds . role . allegiance === fromJust (game' ^. allegianceChosen) + where + game' = run_ checkStage game -prop_checkGameOverAdvancesStageWhenZeroAllegiancesAlive :: GameWithZeroAllegiancesAlive -> Bool -prop_checkGameOverAdvancesStageWhenZeroAllegiancesAlive (GameWithZeroAllegiancesAlive game) = - isGameOver $ run_ checkGameOver game +prop_checkWolfHoundsTurnDoesNothingUnlessAllegianceChosen :: GameAtWolfHoundsTurn -> Bool +prop_checkWolfHoundsTurnDoesNothingUnlessAllegianceChosen (GameAtWolfHoundsTurn game) = + has (stage . _WolfHoundsTurn) (run_ checkStage game) prop_checkGameOverAdvancesStageWhenOneAllegianceAlive :: GameWithOneAllegianceAlive -> Property prop_checkGameOverAdvancesStageWhenOneAllegianceAlive (GameWithOneAllegianceAlive game) = - forAll (sublistOf . filterAlive $ game ^. players) $ \players' -> do - let game' = foldr killPlayer game (map (view name) players') + forAll (sublistOf $ game ^.. players . traverse . alive) $ \players' -> do + let game' = foldr killPlayer game (players' ^.. names) - isGameOver $ run_ checkGameOver game' + has (stage . _GameOver) $ run_ checkGameOver game' -- TODO (hjw): pending --prop_checkGameOverDoesNothingWhenAtLeastTwoAllegiancesAlive :: GameWithDeadPlayers -> Property --prop_checkGameOverDoesNothingWhenAtLeastTwoAllegiancesAlive (GameWithDeadPlayers game) = -- length (nub . map (view $ role . allegiance) . filterAlive $ game ^. players) > 1 --- ==> not . isGameOver $ run_ checkGameOver game +-- ==> not . is gameOver $ run_ checkGameOver game -prop_checkGameOverAdvancesStageWhenSecondRoundAndAngelDead :: GameOnSecondRound -> Bool -prop_checkGameOverAdvancesStageWhenSecondRoundAndAngelDead (GameOnSecondRound game) = do - let angel = findByRole_ angelRole (game ^. players) - let game' = killPlayer (angel ^. name) game +prop_checkGameOverAdvancesStageWhenAfterFirstRoundAndAngelDead :: GameOnSecondRound -> Bool +prop_checkGameOverAdvancesStageWhenAfterFirstRoundAndAngelDead (GameOnSecondRound game) = do + let angelsName = game ^?! players . angels . name + let game' = killPlayer angelsName game - isGameOver $ run_ checkGameOver game' + has (stage . _GameOver) $ run_ checkGameOver game' +prop_checkGameOverDoesNothingWhenAngelDeadButAlignedWithVillagers :: GameOnSecondRound -> Bool +prop_checkGameOverDoesNothingWhenAngelDeadButAlignedWithVillagers (GameOnSecondRound game) = do + let angelsName = game ^?! players . angels . name + let game' = killPlayer angelsName game & players . traverse . filteredBy name angelsName . role . allegiance .~ Villagers + + hasn't (stage . _GameOver) $ run_ checkGameOver game' + prop_startGameUsesGivenPlayers :: Property prop_startGameUsesGivenPlayers = forAll arbitraryPlayerSet $ \players' -> @@ -468,44 +463,5 @@ prop_startGameErrorsWhenMoreThan1OfARestrictedRole :: [Player] -> Property prop_startGameErrorsWhenMoreThan1OfARestrictedRole players = - any (\role -> length (filterByRole role players) > 1) restrictedRoles + any (\role' -> length (players ^.. traverse . filteredBy role role') > 1) restrictedRoles ==> isLeft . runExcept . runWriterT $ startGame "" players - -prop_createPlayersUsesGivenPlayerNames :: [Text] -> [Role] -> Property -prop_createPlayersUsesGivenPlayerNames playerNames extraRoles = monadicIO $ do - players <- createPlayers playerNames (padRoles extraRoles (length playerNames)) - - return $ playerNames == map (view name) players - -prop_createPlayersUsesGivenRoles :: [Text] -> [Role] -> Property -prop_createPlayersUsesGivenRoles playerNames extraRoles = monadicIO $ do - let roles = padRoles extraRoles (length playerNames) - - players <- createPlayers playerNames roles - - return $ roles == map (view role) players - -prop_createPlayersCreatesAlivePlayers :: [Text] -> [Role] -> Property -prop_createPlayersCreatesAlivePlayers playerNames extraRoles = monadicIO $ do - players <- createPlayers playerNames (padRoles extraRoles (length playerNames)) - - return $ all isAlive players - -prop_padRolesReturnsNRoles :: [Role] -> Int -> Property -prop_padRolesReturnsNRoles extraRoles n = monadicIO $ do - let roles = padRoles extraRoles n - - return $ length roles == n - -prop_padRolesUsesGivenRoles :: [Role] -> Int -> Property -prop_padRolesUsesGivenRoles extraRoles n = monadicIO $ do - let roles = padRoles extraRoles n - - return $ extraRoles `isSubsequenceOf` roles - -prop_padRolesProportionsAllegiances :: [Role] -> Int -> Property -prop_padRolesProportionsAllegiances extraRoles n = monadicIO $ do - let roles = padRoles extraRoles n - let werewolvesCount = length . elemIndices Role.Werewolves $ map (view allegiance) roles - - return $ werewolvesCount == n `quot` 5 + 1 diff --git a/test/src/Game/Werewolf/Test/Game.hs b/test/src/Game/Werewolf/Test/Game.hs --- a/test/src/Game/Werewolf/Test/Game.hs +++ b/test/src/Game/Werewolf/Test/Game.hs @@ -5,8 +5,6 @@ Maintainer : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-} - module Game.Werewolf.Test.Game ( -- * Tests allGameTests, @@ -14,12 +12,11 @@ import Control.Lens -import qualified Data.Map as Map -import Data.Maybe +import Data.Maybe -import Game.Werewolf.Internal.Game -import Game.Werewolf.Internal.Player -import Game.Werewolf.Test.Arbitrary () +import Game.Werewolf.Game +import Game.Werewolf.Player +import Game.Werewolf.Test.Arbitrary () import Prelude hiding (round) @@ -49,25 +46,25 @@ prop_newGameStartsAtVillagesTurnWhenAngelInPlay :: [Player] -> Property prop_newGameStartsAtVillagesTurnWhenAngelInPlay players = - any isAngel players - ==> isVillagesTurn (newGame players) + has angels players + ==> has (stage . _VillagesTurn) (newGame players) prop_newGameStartsAtSunsetWhenNoAngelInPlay :: [Player] -> Property prop_newGameStartsAtSunsetWhenNoAngelInPlay players = - none isAngel players - ==> isSunset (newGame players) + hasn't angels players + ==> has (stage . _Sunset) (newGame players) prop_newGameStartsOnFirstRound :: [Player] -> Bool prop_newGameStartsOnFirstRound players = isFirstRound $ newGame players prop_newGameStartsWithEventsEmpty :: [Player] -> Bool -prop_newGameStartsWithEventsEmpty players = null $ newGame players ^. events +prop_newGameStartsWithEventsEmpty players = has (events . _Empty) (newGame players) prop_newGameStartsWithPassesEmpty :: [Player] -> Bool -prop_newGameStartsWithPassesEmpty players = null $ newGame players ^. passes +prop_newGameStartsWithPassesEmpty players = has (passes . _Empty) (newGame players) prop_newGameStartsWithAllowedVotersFull :: [Player] -> Property -prop_newGameStartsWithAllowedVotersFull players = newGame players ^. allowedVoters === map (view name) players +prop_newGameStartsWithAllowedVotersFull players = newGame players ^. allowedVoters === players ^.. names prop_newGameStartsWithHealFalse :: [Player] -> Bool prop_newGameStartsWithHealFalse players = not $ newGame players ^. heal @@ -98,7 +95,7 @@ not $ newGame players ^. villageIdiotRevealed prop_newGameStartsWithVotesEmpty :: [Player] -> Bool -prop_newGameStartsWithVotesEmpty players = Map.null $ newGame players ^. votes +prop_newGameStartsWithVotesEmpty players = has (votes . _Empty) (newGame players) prop_newGameUsesGivenPlayers :: [Player] -> Bool prop_newGameUsesGivenPlayers players' = newGame players' ^. players == players' diff --git a/test/src/Game/Werewolf/Test/Player.hs b/test/src/Game/Werewolf/Test/Player.hs --- a/test/src/Game/Werewolf/Test/Player.hs +++ b/test/src/Game/Werewolf/Test/Player.hs @@ -5,8 +5,6 @@ Maintainer : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-} - module Game.Werewolf.Test.Player ( -- * Tests allPlayerTests, @@ -16,9 +14,9 @@ import Data.Text -import Game.Werewolf.Internal.Player +import Game.Werewolf.Player import Game.Werewolf.Role -import Game.Werewolf.Test.Arbitrary () +import Game.Werewolf.Test.Arbitrary () import Test.Tasty import Test.Tasty.QuickCheck diff --git a/test/src/Game/Werewolf/Test/Util.hs b/test/src/Game/Werewolf/Test/Util.hs --- a/test/src/Game/Werewolf/Test/Util.hs +++ b/test/src/Game/Werewolf/Test/Util.hs @@ -5,8 +5,6 @@ Maintainer : public@hjwylde.com -} -{-# OPTIONS_HADDOCK hide, prune #-} - module Game.Werewolf.Test.Util ( -- * Utility functions run, run_, diff --git a/werewolf.cabal b/werewolf.cabal --- a/werewolf.cabal +++ b/werewolf.cabal @@ -1,5 +1,5 @@ name: werewolf -version: 0.4.6.1 +version: 0.4.7.0 author: Henry J. Wylde maintainer: public@hjwylde.com @@ -28,29 +28,32 @@ hs-source-dirs: app/ ghc-options: -threaded -with-rtsopts=-N other-modules: - Werewolf.Commands.Choose, - Werewolf.Commands.Circle, - Werewolf.Commands.End, - Werewolf.Commands.Heal, - Werewolf.Commands.Help, - Werewolf.Commands.Interpret, - Werewolf.Commands.Pass, - Werewolf.Commands.Ping, - Werewolf.Commands.Poison, - Werewolf.Commands.Protect, - Werewolf.Commands.Quit, - Werewolf.Commands.See, - Werewolf.Commands.Start, - Werewolf.Commands.Status, - Werewolf.Commands.Version, - Werewolf.Commands.Vote, - Werewolf.Messages, - Werewolf.Options, - Werewolf.Version, + Werewolf.Commands.Choose + Werewolf.Commands.Circle + Werewolf.Commands.End + Werewolf.Commands.Heal + Werewolf.Commands.Help + Werewolf.Commands.Interpret + Werewolf.Commands.Pass + Werewolf.Commands.Ping + Werewolf.Commands.Poison + Werewolf.Commands.Protect + Werewolf.Commands.Quit + Werewolf.Commands.See + Werewolf.Commands.Start + Werewolf.Commands.Status + Werewolf.Commands.Version + Werewolf.Commands.Vote + Werewolf.Game + Werewolf.Messages + Werewolf.Options + Werewolf.Version Paths_werewolf default-language: Haskell2010 other-extensions: + FlexibleContexts, + MultiParamTypeClasses, OverloadedStrings build-depends: aeson >= 0.8 && < 0.11, @@ -70,18 +73,16 @@ library hs-source-dirs: src/ exposed-modules: - Game.Werewolf, - Game.Werewolf.Command, - Game.Werewolf.Engine, - Game.Werewolf.Game, - Game.Werewolf.Internal.Game, - Game.Werewolf.Internal.Player, - Game.Werewolf.Internal.Role, - Game.Werewolf.Player, - Game.Werewolf.Response, + Game.Werewolf + Game.Werewolf.Command + Game.Werewolf.Engine + Game.Werewolf.Game + Game.Werewolf.Player + Game.Werewolf.Response Game.Werewolf.Role other-modules: Game.Werewolf.Messages + Game.Werewolf.Util default-language: Haskell2010 other-extensions: @@ -90,7 +91,7 @@ FlexibleContexts, MultiParamTypeClasses, OverloadedStrings, - RankNTypes, + Rank2Types, TemplateHaskell build-depends: aeson >= 0.8 && < 0.11, @@ -100,9 +101,7 @@ extra == 1.4.*, filepath == 1.4.*, lens >= 4.12 && < 4.14, - MonadRandom == 0.4.*, mtl == 2.2.*, - random-shuffle, text == 1.2.*, transformers == 0.4.*